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 Qunhandled_file_name_directory
;
137 Lisp_Object Qfile_name_as_directory
;
138 Lisp_Object Qcopy_file
;
139 Lisp_Object Qmake_directory
;
140 Lisp_Object Qdelete_directory
;
141 Lisp_Object Qdelete_file
;
142 Lisp_Object Qrename_file
;
143 Lisp_Object Qadd_name_to_file
;
144 Lisp_Object Qmake_symbolic_link
;
145 Lisp_Object Qfile_exists_p
;
146 Lisp_Object Qfile_executable_p
;
147 Lisp_Object Qfile_readable_p
;
148 Lisp_Object Qfile_symlink_p
;
149 Lisp_Object Qfile_writable_p
;
150 Lisp_Object Qfile_directory_p
;
151 Lisp_Object Qfile_accessible_directory_p
;
152 Lisp_Object Qfile_modes
;
153 Lisp_Object Qset_file_modes
;
154 Lisp_Object Qfile_newer_than_file_p
;
155 Lisp_Object Qinsert_file_contents
;
156 Lisp_Object Qwrite_region
;
157 Lisp_Object Qverify_visited_file_modtime
;
159 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 1, 1, 0,
160 "Return FILENAME's handler function, if its syntax is handled specially.\n\
161 Otherwise, return nil.\n\
162 A file name is handled if one of the regular expressions in\n\
163 `file-name-handler-alist' matches it.")
165 Lisp_Object filename
;
167 /* This function must not munge the match data. */
170 for (chain
= Vfile_name_handler_alist
; XTYPE (chain
) == Lisp_Cons
;
171 chain
= XCONS (chain
)->cdr
)
174 elt
= XCONS (chain
)->car
;
175 if (XTYPE (elt
) == Lisp_Cons
)
178 string
= XCONS (elt
)->car
;
179 if (XTYPE (string
) == Lisp_String
180 && fast_string_match (string
, filename
) >= 0)
181 return XCONS (elt
)->cdr
;
189 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
191 "Return the directory component in file name NAME.\n\
192 Return nil if NAME does not include a directory.\n\
193 Otherwise return a directory spec.\n\
194 Given a Unix syntax file name, returns a string ending in slash;\n\
195 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
199 register unsigned char *beg
;
200 register unsigned char *p
;
203 CHECK_STRING (file
, 0);
205 /* If the file name has special constructs in it,
206 call the corresponding file handler. */
207 handler
= Ffind_file_name_handler (file
);
209 return call2 (handler
, Qfile_name_directory
, file
);
211 beg
= XSTRING (file
)->data
;
212 p
= beg
+ XSTRING (file
)->size
;
214 while (p
!= beg
&& p
[-1] != '/'
216 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
222 return make_string (beg
, p
- beg
);
225 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
227 "Return file name NAME sans its directory.\n\
228 For example, in a Unix-syntax file name,\n\
229 this is everything after the last slash,\n\
230 or the entire name if it contains no slash.")
234 register unsigned char *beg
, *p
, *end
;
237 CHECK_STRING (file
, 0);
239 /* If the file name has special constructs in it,
240 call the corresponding file handler. */
241 handler
= Ffind_file_name_handler (file
);
243 return call2 (handler
, Qfile_name_nondirectory
, file
);
245 beg
= XSTRING (file
)->data
;
246 end
= p
= beg
+ XSTRING (file
)->size
;
248 while (p
!= beg
&& p
[-1] != '/'
250 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
254 return make_string (p
, end
- p
);
257 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
, Sunhandled_file_name_directory
, 1, 1, 0,
258 "Return a directly usable directory name somehow associated with FILENAME.\n\
259 A `directly usable' directory name is one that may be used without the\n\
260 intervention of any file handler.\n\
261 If FILENAME is a directly usable file itself, return\n\
262 (file-name-directory FILENAME).\n\
263 The `call-process' and `start-process' functions use this function to\n\
264 get a current directory to run processes in.")
266 Lisp_Object filename
;
270 /* If the file name has special constructs in it,
271 call the corresponding file handler. */
272 handler
= Ffind_file_name_handler (filename
);
274 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
276 return Ffile_name_directory (filename
);
281 file_name_as_directory (out
, in
)
284 int size
= strlen (in
) - 1;
289 /* Is it already a directory string? */
290 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
292 /* Is it a VMS directory file name? If so, hack VMS syntax. */
293 else if (! index (in
, '/')
294 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
295 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
296 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
297 || ! strncmp (&in
[size
- 5], ".dir", 4))
298 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
299 && in
[size
] == '1')))
301 register char *p
, *dot
;
305 dir:x.dir --> dir:[x]
306 dir:[x]y.dir --> dir:[x.y] */
308 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
311 strncpy (out
, in
, p
- in
);
330 dot
= index (p
, '.');
333 /* blindly remove any extension */
334 size
= strlen (out
) + (dot
- p
);
335 strncat (out
, p
, dot
- p
);
346 /* For Unix syntax, Append a slash if necessary */
347 if (out
[size
] != '/')
353 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
354 Sfile_name_as_directory
, 1, 1, 0,
355 "Return a string representing file FILENAME interpreted as a directory.\n\
356 This operation exists because a directory is also a file, but its name as\n\
357 a directory is different from its name as a file.\n\
358 The result can be used as the value of `default-directory'\n\
359 or passed as second argument to `expand-file-name'.\n\
360 For a Unix-syntax file name, just appends a slash.\n\
361 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
368 CHECK_STRING (file
, 0);
372 /* If the file name has special constructs in it,
373 call the corresponding file handler. */
374 handler
= Ffind_file_name_handler (file
);
376 return call2 (handler
, Qfile_name_as_directory
, file
);
378 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
379 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
383 * Convert from directory name to filename.
385 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
386 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
387 * On UNIX, it's simple: just make sure there is a terminating /
389 * Value is nonzero if the string output is different from the input.
392 directory_file_name (src
, dst
)
400 struct FAB fab
= cc$rms_fab
;
401 struct NAM nam
= cc$rms_nam
;
402 char esa
[NAM$C_MAXRSS
];
407 if (! index (src
, '/')
408 && (src
[slen
- 1] == ']'
409 || src
[slen
- 1] == ':'
410 || src
[slen
- 1] == '>'))
412 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
414 fab
.fab$b_fns
= slen
;
415 fab
.fab$l_nam
= &nam
;
416 fab
.fab$l_fop
= FAB$M_NAM
;
419 nam
.nam$b_ess
= sizeof esa
;
420 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
422 /* We call SYS$PARSE to handle such things as [--] for us. */
423 if (SYS$
PARSE(&fab
, 0, 0) == RMS$_NORMAL
)
425 slen
= nam
.nam$b_esl
;
426 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
431 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
433 /* what about when we have logical_name:???? */
434 if (src
[slen
- 1] == ':')
435 { /* Xlate logical name and see what we get */
436 ptr
= strcpy (dst
, src
); /* upper case for getenv */
439 if ('a' <= *ptr
&& *ptr
<= 'z')
443 dst
[slen
- 1] = 0; /* remove colon */
444 if (!(src
= egetenv (dst
)))
446 /* should we jump to the beginning of this procedure?
447 Good points: allows us to use logical names that xlate
449 Bad points: can be a problem if we just translated to a device
451 For now, I'll punt and always expect VMS names, and hope for
454 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
455 { /* no recursion here! */
461 { /* not a directory spec */
466 bracket
= src
[slen
- 1];
468 /* If bracket is ']' or '>', bracket - 2 is the corresponding
470 ptr
= index (src
, bracket
- 2);
472 { /* no opening bracket */
476 if (!(rptr
= rindex (src
, '.')))
479 strncpy (dst
, src
, slen
);
483 dst
[slen
++] = bracket
;
488 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
489 then translate the device and recurse. */
490 if (dst
[slen
- 1] == ':'
491 && dst
[slen
- 2] != ':' /* skip decnet nodes */
492 && strcmp(src
+ slen
, "[000000]") == 0)
494 dst
[slen
- 1] = '\0';
495 if ((ptr
= egetenv (dst
))
496 && (rlen
= strlen (ptr
) - 1) > 0
497 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
498 && ptr
[rlen
- 1] == '.')
500 char * buf
= (char *) alloca (strlen (ptr
) + 1);
504 return directory_file_name (buf
, dst
);
509 strcat (dst
, "[000000]");
513 rlen
= strlen (rptr
) - 1;
514 strncat (dst
, rptr
, rlen
);
515 dst
[slen
+ rlen
] = '\0';
516 strcat (dst
, ".DIR.1");
520 /* Process as Unix format: just remove any final slash.
521 But leave "/" unchanged; do not change it to "". */
523 if (slen
> 1 && dst
[slen
- 1] == '/')
528 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
530 "Returns the file name of the directory named DIR.\n\
531 This is the name of the file that holds the data for the directory DIR.\n\
532 This operation exists because a directory is also a file, but its name as\n\
533 a directory is different from its name as a file.\n\
534 In Unix-syntax, this function just removes the final slash.\n\
535 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
536 it returns a file name such as \"[X]Y.DIR.1\".")
538 Lisp_Object directory
;
543 CHECK_STRING (directory
, 0);
545 if (NILP (directory
))
548 /* If the file name has special constructs in it,
549 call the corresponding file handler. */
550 handler
= Ffind_file_name_handler (directory
);
552 return call2 (handler
, Qdirectory_file_name
, directory
);
555 /* 20 extra chars is insufficient for VMS, since we might perform a
556 logical name translation. an equivalence string can be up to 255
557 chars long, so grab that much extra space... - sss */
558 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
560 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
562 directory_file_name (XSTRING (directory
)->data
, buf
);
563 return build_string (buf
);
566 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
567 "Generate temporary file name (string) starting with PREFIX (a string).\n\
568 The Emacs process number forms part of the result,\n\
569 so there is no danger of generating a name being used by another process.")
574 val
= concat2 (prefix
, build_string ("XXXXXX"));
575 mktemp (XSTRING (val
)->data
);
579 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
580 "Convert FILENAME to absolute, and canonicalize it.\n\
581 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
582 (does not start with slash); if DEFAULT is nil or missing,\n\
583 the current buffer's value of default-directory is used.\n\
584 Path components that are `.' are removed, and \n\
585 path components followed by `..' are removed, along with the `..' itself;\n\
586 note that these simplifications are done without checking the resulting\n\
587 paths in the file system.\n\
588 An initial `~/' expands to your home directory.\n\
589 An initial `~USER/' expands to USER's home directory.\n\
590 See also the function `substitute-in-file-name'.")
592 Lisp_Object name
, defalt
;
596 register unsigned char *newdir
, *p
, *o
;
598 unsigned char *target
;
602 unsigned char * colon
= 0;
603 unsigned char * close
= 0;
604 unsigned char * slash
= 0;
605 unsigned char * brack
= 0;
606 int lbrack
= 0, rbrack
= 0;
611 CHECK_STRING (name
, 0);
613 /* If the file name has special constructs in it,
614 call the corresponding file handler. */
615 handler
= Ffind_file_name_handler (name
);
617 return call3 (handler
, Qexpand_file_name
, name
, defalt
);
620 /* Filenames on VMS are always upper case. */
621 name
= Fupcase (name
);
624 nm
= XSTRING (name
)->data
;
626 /* If nm is absolute, flush ...// and detect /./ and /../.
627 If no /./ or /../ we can return right away. */
639 /* Since we know the path is absolute, we can assume that each
640 element starts with a "/". */
642 /* "//" anywhere isn't necessarily hairy; we just start afresh
643 with the second slash. */
644 if (p
[0] == '/' && p
[1] == '/'
646 /* // at start of filename is meaningful on Apollo system */
652 /* "~" is hairy as the start of any path element. */
653 if (p
[0] == '/' && p
[1] == '~')
654 nm
= p
+ 1, lose
= 1;
656 /* "." and ".." are hairy. */
661 || (p
[2] == '.' && (p
[3] == '/'
668 /* if dev:[dir]/, move nm to / */
669 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
670 nm
= (brack
? brack
+ 1 : colon
+ 1);
679 /* VMS pre V4.4,convert '-'s in filenames. */
680 if (lbrack
== rbrack
)
682 if (dots
< 2) /* this is to allow negative version numbers */
687 if (lbrack
> rbrack
&&
688 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
689 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
695 /* count open brackets, reset close bracket pointer */
696 if (p
[0] == '[' || p
[0] == '<')
698 /* count close brackets, set close bracket pointer */
699 if (p
[0] == ']' || p
[0] == '>')
701 /* detect ][ or >< */
702 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
704 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
705 nm
= p
+ 1, lose
= 1;
706 if (p
[0] == ':' && (colon
|| slash
))
707 /* if dev1:[dir]dev2:, move nm to dev2: */
713 /* if /pathname/dev:, move nm to dev: */
716 /* if node::dev:, move colon following dev */
717 else if (colon
&& colon
[-1] == ':')
719 /* if dev1:dev2:, move nm to dev2: */
720 else if (colon
&& colon
[-1] != ':')
725 if (p
[0] == ':' && !colon
)
731 if (lbrack
== rbrack
)
734 else if (p
[0] == '.')
743 return build_string (sys_translate_unix (nm
));
745 if (nm
== XSTRING (name
)->data
)
747 return build_string (nm
);
751 /* Now determine directory to start with and put it in newdir */
755 if (nm
[0] == '~') /* prefix ~ */
761 || nm
[1] == 0) /* ~ by itself */
763 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
764 newdir
= (unsigned char *) "";
767 nm
++; /* Don't leave the slash in nm. */
770 else /* ~user/filename */
772 for (p
= nm
; *p
&& (*p
!= '/'
777 o
= (unsigned char *) alloca (p
- nm
+ 1);
778 bcopy ((char *) nm
, o
, p
- nm
);
781 pw
= (struct passwd
*) getpwnam (o
+ 1);
784 newdir
= (unsigned char *) pw
-> pw_dir
;
786 nm
= p
+ 1; /* skip the terminator */
792 /* If we don't find a user of that name, leave the name
793 unchanged; don't move nm forward to p. */
804 defalt
= current_buffer
->directory
;
805 CHECK_STRING (defalt
, 1);
806 newdir
= XSTRING (defalt
)->data
;
811 /* Get rid of any slash at the end of newdir. */
812 int length
= strlen (newdir
);
813 if (newdir
[length
- 1] == '/')
815 unsigned char *temp
= (unsigned char *) alloca (length
);
816 bcopy (newdir
, temp
, length
- 1);
817 temp
[length
- 1] = 0;
825 /* Now concatenate the directory and name to new space in the stack frame */
826 tlen
+= strlen (nm
) + 1;
827 target
= (unsigned char *) alloca (tlen
);
833 if (nm
[0] == 0 || nm
[0] == '/')
834 strcpy (target
, newdir
);
837 file_name_as_directory (target
, newdir
);
842 if (index (target
, '/'))
843 strcpy (target
, sys_translate_unix (target
));
846 /* Now canonicalize by removing /. and /foo/.. if they appear. */
854 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
860 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
861 /* brackets are offset from each other by 2 */
864 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
865 /* convert [foo][bar] to [bar] */
866 while (o
[-1] != '[' && o
[-1] != '<')
868 else if (*p
== '-' && *o
!= '.')
871 else if (p
[0] == '-' && o
[-1] == '.' &&
872 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
873 /* flush .foo.- ; leave - if stopped by '[' or '<' */
877 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
878 if (p
[1] == '.') /* foo.-.bar ==> bar*/
880 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
882 /* else [foo.-] ==> [-] */
888 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
889 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
899 else if (!strncmp (p
, "//", 2)
901 /* // at start of filename is meaningful in Apollo system */
914 /* If "/." is the entire filename, keep the "/". Otherwise,
915 just delete the whole "/.". */
916 if (o
== target
&& p
[2] == '\0')
920 else if (!strncmp (p
, "/..", 3)
921 /* `/../' is the "superroot" on certain file systems. */
923 && (p
[3] == '/' || p
[3] == 0))
925 while (o
!= target
&& *--o
!= '/')
928 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
932 if (o
== target
&& *o
== '/')
943 return make_string (target
, o
- target
);
946 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'.
947 DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
948 "Convert FILENAME to absolute, and canonicalize it.\n\
949 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
950 (does not start with slash); if DEFAULT is nil or missing,\n\
951 the current buffer's value of default-directory is used.\n\
952 Filenames containing `.' or `..' as components are simplified;\n\
953 initial `~/' expands to your home directory.\n\
954 See also the function `substitute-in-file-name'.")
956 Lisp_Object name, defalt;
960 register unsigned char *newdir, *p, *o;
962 unsigned char *target;
966 unsigned char * colon = 0;
967 unsigned char * close = 0;
968 unsigned char * slash = 0;
969 unsigned char * brack = 0;
970 int lbrack = 0, rbrack = 0;
974 CHECK_STRING (name
, 0);
977 /* Filenames on VMS are always upper case. */
978 name
= Fupcase (name
);
981 nm
= XSTRING (name
)->data
;
983 /* If nm is absolute, flush ...// and detect /./ and /../.
984 If no /./ or /../ we can return right away. */
996 if (p
[0] == '/' && p
[1] == '/'
998 /* // at start of filename is meaningful on Apollo system */
1003 if (p
[0] == '/' && p
[1] == '~')
1004 nm
= p
+ 1, lose
= 1;
1005 if (p
[0] == '/' && p
[1] == '.'
1006 && (p
[2] == '/' || p
[2] == 0
1007 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1013 /* if dev:[dir]/, move nm to / */
1014 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1015 nm
= (brack
? brack
+ 1 : colon
+ 1);
1016 lbrack
= rbrack
= 0;
1024 /* VMS pre V4.4,convert '-'s in filenames. */
1025 if (lbrack
== rbrack
)
1027 if (dots
< 2) /* this is to allow negative version numbers */
1032 if (lbrack
> rbrack
&&
1033 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1034 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1040 /* count open brackets, reset close bracket pointer */
1041 if (p
[0] == '[' || p
[0] == '<')
1042 lbrack
++, brack
= 0;
1043 /* count close brackets, set close bracket pointer */
1044 if (p
[0] == ']' || p
[0] == '>')
1045 rbrack
++, brack
= p
;
1046 /* detect ][ or >< */
1047 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1049 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1050 nm
= p
+ 1, lose
= 1;
1051 if (p
[0] == ':' && (colon
|| slash
))
1052 /* if dev1:[dir]dev2:, move nm to dev2: */
1058 /* if /pathname/dev:, move nm to dev: */
1061 /* if node::dev:, move colon following dev */
1062 else if (colon
&& colon
[-1] == ':')
1064 /* if dev1:dev2:, move nm to dev2: */
1065 else if (colon
&& colon
[-1] != ':')
1070 if (p
[0] == ':' && !colon
)
1076 if (lbrack
== rbrack
)
1079 else if (p
[0] == '.')
1087 if (index (nm
, '/'))
1088 return build_string (sys_translate_unix (nm
));
1090 if (nm
== XSTRING (name
)->data
)
1092 return build_string (nm
);
1096 /* Now determine directory to start with and put it in NEWDIR */
1100 if (nm
[0] == '~') /* prefix ~ */
1105 || nm
[1] == 0)/* ~/filename */
1107 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1108 newdir
= (unsigned char *) "";
1111 nm
++; /* Don't leave the slash in nm. */
1114 else /* ~user/filename */
1116 /* Get past ~ to user */
1117 unsigned char *user
= nm
+ 1;
1118 /* Find end of name. */
1119 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1120 int len
= ptr
? ptr
- user
: strlen (user
);
1122 unsigned char *ptr1
= index (user
, ':');
1123 if (ptr1
!= 0 && ptr1
- user
< len
)
1126 /* Copy the user name into temp storage. */
1127 o
= (unsigned char *) alloca (len
+ 1);
1128 bcopy ((char *) user
, o
, len
);
1131 /* Look up the user name. */
1132 pw
= (struct passwd
*) getpwnam (o
+ 1);
1134 error ("\"%s\" isn't a registered user", o
+ 1);
1136 newdir
= (unsigned char *) pw
->pw_dir
;
1138 /* Discard the user name from NM. */
1145 #endif /* not VMS */
1149 defalt
= current_buffer
->directory
;
1150 CHECK_STRING (defalt
, 1);
1151 newdir
= XSTRING (defalt
)->data
;
1154 /* Now concatenate the directory and name to new space in the stack frame */
1156 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1157 target
= (unsigned char *) alloca (tlen
);
1163 if (nm
[0] == 0 || nm
[0] == '/')
1164 strcpy (target
, newdir
);
1167 file_name_as_directory (target
, newdir
);
1170 strcat (target
, nm
);
1172 if (index (target
, '/'))
1173 strcpy (target
, sys_translate_unix (target
));
1176 /* Now canonicalize by removing /. and /foo/.. if they appear */
1184 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1190 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1191 /* brackets are offset from each other by 2 */
1194 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1195 /* convert [foo][bar] to [bar] */
1196 while (o
[-1] != '[' && o
[-1] != '<')
1198 else if (*p
== '-' && *o
!= '.')
1201 else if (p
[0] == '-' && o
[-1] == '.' &&
1202 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1203 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1207 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1208 if (p
[1] == '.') /* foo.-.bar ==> bar*/
1210 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1212 /* else [foo.-] ==> [-] */
1218 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1219 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1229 else if (!strncmp (p
, "//", 2)
1231 /* // at start of filename is meaningful in Apollo system */
1239 else if (p
[0] == '/' && p
[1] == '.' &&
1240 (p
[2] == '/' || p
[2] == 0))
1242 else if (!strncmp (p
, "/..", 3)
1243 /* `/../' is the "superroot" on certain file systems. */
1245 && (p
[3] == '/' || p
[3] == 0))
1247 while (o
!= target
&& *--o
!= '/')
1250 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1254 if (o
== target
&& *o
== '/')
1262 #endif /* not VMS */
1265 return make_string (target
, o
- target
);
1269 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1270 Ssubstitute_in_file_name
, 1, 1, 0,
1271 "Substitute environment variables referred to in FILENAME.\n\
1272 `$FOO' where FOO is an environment variable name means to substitute\n\
1273 the value of that variable. The variable name should be terminated\n\
1274 with a character not a letter, digit or underscore; otherwise, enclose\n\
1275 the entire variable name in braces.\n\
1276 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1277 On VMS, `$' substitution is not done; this function does little and only\n\
1278 duplicates what `expand-file-name' does.")
1284 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1285 unsigned char *target
;
1287 int substituted
= 0;
1290 CHECK_STRING (string
, 0);
1292 nm
= XSTRING (string
)->data
;
1293 endp
= nm
+ XSTRING (string
)->size
;
1295 /* If /~ or // appears, discard everything through first slash. */
1297 for (p
= nm
; p
!= endp
; p
++)
1301 /* // at start of file name is meaningful in Apollo system */
1302 (p
[0] == '/' && p
- 1 != nm
)
1303 #else /* not APOLLO */
1305 #endif /* not APOLLO */
1309 (p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>' ||
1322 return build_string (nm
);
1325 /* See if any variables are substituted into the string
1326 and find the total length of their values in `total' */
1328 for (p
= nm
; p
!= endp
;)
1338 /* "$$" means a single "$" */
1347 while (p
!= endp
&& *p
!= '}') p
++;
1348 if (*p
!= '}') goto missingclose
;
1354 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1358 /* Copy out the variable name */
1359 target
= (unsigned char *) alloca (s
- o
+ 1);
1360 strncpy (target
, o
, s
- o
);
1363 /* Get variable value */
1364 o
= (unsigned char *) egetenv (target
);
1365 /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
1368 if (!o
&& !strcmp (target
, "USER"))
1369 o
= egetenv ("LOGNAME");
1372 if (!o
) goto badvar
;
1373 total
+= strlen (o
);
1380 /* If substitution required, recopy the string and do it */
1381 /* Make space in stack frame for the new copy */
1382 xnm
= (unsigned char *) alloca (XSTRING (string
)->size
+ total
+ 1);
1385 /* Copy the rest of the name through, replacing $ constructs with values */
1402 while (p
!= endp
&& *p
!= '}') p
++;
1403 if (*p
!= '}') goto missingclose
;
1409 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1413 /* Copy out the variable name */
1414 target
= (unsigned char *) alloca (s
- o
+ 1);
1415 strncpy (target
, o
, s
- o
);
1418 /* Get variable value */
1419 o
= (unsigned char *) egetenv (target
);
1420 /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
1423 if (!o
&& !strcmp (target
, "USER"))
1424 o
= egetenv ("LOGNAME");
1436 /* If /~ or // appears, discard everything through first slash. */
1438 for (p
= xnm
; p
!= x
; p
++)
1441 /* // at start of file name is meaningful in Apollo system */
1442 (p
[0] == '/' && p
- 1 != xnm
)
1443 #else /* not APOLLO */
1445 #endif /* not APOLLO */
1447 && p
!= nm
&& p
[-1] == '/')
1450 return make_string (xnm
, x
- xnm
);
1453 error ("Bad format environment-variable substitution");
1455 error ("Missing \"}\" in environment-variable substitution");
1457 error ("Substituting nonexistent environment variable \"%s\"", target
);
1460 #endif /* not VMS */
1463 /* A slightly faster and more convenient way to get
1464 (directory-file-name (expand-file-name FOO)). The return value may
1465 have had its last character zapped with a '\0' character, meaning
1466 that it is acceptable to system calls, but not to other lisp
1467 functions. Callers should make sure that the return value doesn't
1471 expand_and_dir_to_file (filename
, defdir
)
1472 Lisp_Object filename
, defdir
;
1474 register Lisp_Object abspath
;
1476 abspath
= Fexpand_file_name (filename
, defdir
);
1479 register int c
= XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1];
1480 if (c
== ':' || c
== ']' || c
== '>')
1481 abspath
= Fdirectory_file_name (abspath
);
1484 /* Remove final slash, if any (unless path is root).
1485 stat behaves differently depending! */
1486 if (XSTRING (abspath
)->size
> 1
1487 && XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] == '/')
1489 if (EQ (abspath
, filename
))
1490 abspath
= Fcopy_sequence (abspath
);
1491 XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] = 0;
1497 barf_or_query_if_file_exists (absname
, querystring
, interactive
)
1498 Lisp_Object absname
;
1499 unsigned char *querystring
;
1502 register Lisp_Object tem
;
1503 struct gcpro gcpro1
;
1505 if (access (XSTRING (absname
)->data
, 4) >= 0)
1508 Fsignal (Qfile_already_exists
,
1509 Fcons (build_string ("File already exists"),
1510 Fcons (absname
, Qnil
)));
1512 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1513 XSTRING (absname
)->data
, querystring
));
1516 Fsignal (Qfile_already_exists
,
1517 Fcons (build_string ("File already exists"),
1518 Fcons (absname
, Qnil
)));
1523 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
1524 "fCopy file: \nFCopy %s to file: \np\nP",
1525 "Copy FILE to NEWNAME. Both args must be strings.\n\
1526 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1527 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1528 A number as third arg means request confirmation if NEWNAME already exists.\n\
1529 This is what happens in interactive use with M-x.\n\
1530 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
1531 last-modified time as the old one. (This works on only some systems.)\n\
1532 A prefix arg makes KEEP-TIME non-nil.")
1533 (filename
, newname
, ok_if_already_exists
, keep_date
)
1534 Lisp_Object filename
, newname
, ok_if_already_exists
, keep_date
;
1537 char buf
[16 * 1024];
1539 Lisp_Object handler
;
1540 struct gcpro gcpro1
, gcpro2
;
1541 int count
= specpdl_ptr
- specpdl
;
1543 GCPRO2 (filename
, newname
);
1544 CHECK_STRING (filename
, 0);
1545 CHECK_STRING (newname
, 1);
1546 filename
= Fexpand_file_name (filename
, Qnil
);
1547 newname
= Fexpand_file_name (newname
, Qnil
);
1549 /* If the input file name has special constructs in it,
1550 call the corresponding file handler. */
1551 handler
= Ffind_file_name_handler (filename
);
1552 if (!NILP (handler
))
1553 return call3 (handler
, Qcopy_file
, filename
, newname
);
1554 /* Likewise for output file name. */
1555 handler
= Ffind_file_name_handler (newname
);
1556 if (!NILP (handler
))
1557 return call3 (handler
, Qcopy_file
, filename
, newname
);
1559 if (NILP (ok_if_already_exists
)
1560 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1561 barf_or_query_if_file_exists (newname
, "copy to it",
1562 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1564 ifd
= open (XSTRING (filename
)->data
, 0);
1566 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1568 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1571 /* Create the copy file with the same record format as the input file */
1572 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1574 ofd
= creat (XSTRING (newname
)->data
, 0666);
1577 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1579 record_unwind_protect (close_file_unwind
, make_number (ofd
));
1583 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1584 if (write (ofd
, buf
, n
) != n
)
1585 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1588 if (fstat (ifd
, &st
) >= 0)
1590 if (!NILP (keep_date
))
1592 EMACS_TIME atime
, mtime
;
1593 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1594 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1595 EMACS_SET_UTIMES (XSTRING (newname
)->data
, atime
, mtime
);
1598 if (!egetenv ("USE_DOMAIN_ACLS"))
1600 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1603 /* Discard the unwind protects. */
1604 specpdl_ptr
= specpdl
+ count
;
1607 if (close (ofd
) < 0)
1608 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1614 DEFUN ("make-directory-internal", Fmake_directory_internal
,
1615 Smake_directory_internal
, 1, 1, 0,
1616 "Create a directory. One argument, a file name string.")
1618 Lisp_Object dirname
;
1621 Lisp_Object handler
;
1623 CHECK_STRING (dirname
, 0);
1624 dirname
= Fexpand_file_name (dirname
, Qnil
);
1626 handler
= Ffind_file_name_handler (dirname
);
1627 if (!NILP (handler
))
1628 return call3 (handler
, Qmake_directory
, dirname
, Qnil
);
1630 dir
= XSTRING (dirname
)->data
;
1632 if (mkdir (dir
, 0777) != 0)
1633 report_file_error ("Creating directory", Flist (1, &dirname
));
1638 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
1639 "Delete a directory. One argument, a file name string.")
1641 Lisp_Object dirname
;
1644 Lisp_Object handler
;
1646 CHECK_STRING (dirname
, 0);
1647 dirname
= Fexpand_file_name (dirname
, Qnil
);
1648 dir
= XSTRING (dirname
)->data
;
1650 handler
= Ffind_file_name_handler (dirname
);
1651 if (!NILP (handler
))
1652 return call2 (handler
, Qdelete_directory
, dirname
);
1654 if (rmdir (dir
) != 0)
1655 report_file_error ("Removing directory", Flist (1, &dirname
));
1660 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
1661 "Delete specified file. One argument, a file name string.\n\
1662 If file has multiple names, it continues to exist with the other names.")
1664 Lisp_Object filename
;
1666 Lisp_Object handler
;
1667 CHECK_STRING (filename
, 0);
1668 filename
= Fexpand_file_name (filename
, Qnil
);
1670 handler
= Ffind_file_name_handler (filename
);
1671 if (!NILP (handler
))
1672 return call2 (handler
, Qdelete_file
, filename
);
1674 if (0 > unlink (XSTRING (filename
)->data
))
1675 report_file_error ("Removing old name", Flist (1, &filename
));
1679 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
1680 "fRename file: \nFRename %s to file: \np",
1681 "Rename FILE as NEWNAME. Both args strings.\n\
1682 If file has names other than FILE, it continues to have those names.\n\
1683 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1684 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1685 A number as third arg means request confirmation if NEWNAME already exists.\n\
1686 This is what happens in interactive use with M-x.")
1687 (filename
, newname
, ok_if_already_exists
)
1688 Lisp_Object filename
, newname
, ok_if_already_exists
;
1691 Lisp_Object args
[2];
1693 Lisp_Object handler
;
1694 struct gcpro gcpro1
, gcpro2
;
1696 GCPRO2 (filename
, newname
);
1697 CHECK_STRING (filename
, 0);
1698 CHECK_STRING (newname
, 1);
1699 filename
= Fexpand_file_name (filename
, Qnil
);
1700 newname
= Fexpand_file_name (newname
, Qnil
);
1702 /* If the file name has special constructs in it,
1703 call the corresponding file handler. */
1704 handler
= Ffind_file_name_handler (filename
);
1705 if (!NILP (handler
))
1706 return call3 (handler
, Qrename_file
, filename
, newname
);
1708 if (NILP (ok_if_already_exists
)
1709 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1710 barf_or_query_if_file_exists (newname
, "rename to it",
1711 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1713 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1715 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
1716 || 0 > unlink (XSTRING (filename
)->data
))
1721 Fcopy_file (filename
, newname
, ok_if_already_exists
, Qt
);
1722 Fdelete_file (filename
);
1729 report_file_error ("Renaming", Flist (2, args
));
1732 report_file_error ("Renaming", Flist (2, &filename
));
1739 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
1740 "fAdd name to file: \nFName to add to %s: \np",
1741 "Give FILE additional name NEWNAME. Both args strings.\n\
1742 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1743 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1744 A number as third arg means request confirmation if NEWNAME already exists.\n\
1745 This is what happens in interactive use with M-x.")
1746 (filename
, newname
, ok_if_already_exists
)
1747 Lisp_Object filename
, newname
, ok_if_already_exists
;
1750 Lisp_Object args
[2];
1752 Lisp_Object handler
;
1753 struct gcpro gcpro1
, gcpro2
;
1755 GCPRO2 (filename
, newname
);
1756 CHECK_STRING (filename
, 0);
1757 CHECK_STRING (newname
, 1);
1758 filename
= Fexpand_file_name (filename
, Qnil
);
1759 newname
= Fexpand_file_name (newname
, Qnil
);
1761 /* If the file name has special constructs in it,
1762 call the corresponding file handler. */
1763 handler
= Ffind_file_name_handler (filename
);
1764 if (!NILP (handler
))
1765 return call3 (handler
, Qadd_name_to_file
, filename
, newname
);
1767 if (NILP (ok_if_already_exists
)
1768 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1769 barf_or_query_if_file_exists (newname
, "make it a new name",
1770 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1771 unlink (XSTRING (newname
)->data
);
1772 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1777 report_file_error ("Adding new name", Flist (2, args
));
1779 report_file_error ("Adding new name", Flist (2, &filename
));
1788 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
1789 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
1790 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
1791 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1792 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1793 A number as third arg means request confirmation if NEWNAME already exists.\n\
1794 This happens for interactive use with M-x.")
1795 (filename
, linkname
, ok_if_already_exists
)
1796 Lisp_Object filename
, linkname
, ok_if_already_exists
;
1799 Lisp_Object args
[2];
1801 Lisp_Object handler
;
1802 struct gcpro gcpro1
, gcpro2
;
1804 GCPRO2 (filename
, linkname
);
1805 CHECK_STRING (filename
, 0);
1806 CHECK_STRING (linkname
, 1);
1807 #if 0 /* This made it impossible to make a link to a relative name. */
1808 filename
= Fexpand_file_name (filename
, Qnil
);
1810 linkname
= Fexpand_file_name (linkname
, Qnil
);
1812 /* If the file name has special constructs in it,
1813 call the corresponding file handler. */
1814 handler
= Ffind_file_name_handler (filename
);
1815 if (!NILP (handler
))
1816 return call3 (handler
, Qmake_symbolic_link
, filename
, linkname
);
1818 if (NILP (ok_if_already_exists
)
1819 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1820 barf_or_query_if_file_exists (linkname
, "make it a link",
1821 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1822 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
1824 /* If we didn't complain already, silently delete existing file. */
1825 if (errno
== EEXIST
)
1827 unlink (XSTRING (filename
)->data
);
1828 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
1835 report_file_error ("Making symbolic link", Flist (2, args
));
1837 report_file_error ("Making symbolic link", Flist (2, &filename
));
1843 #endif /* S_IFLNK */
1847 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
1848 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
1849 "Define the job-wide logical name NAME to have the value STRING.\n\
1850 If STRING is nil or a null string, the logical name NAME is deleted.")
1852 Lisp_Object varname
;
1855 CHECK_STRING (varname
, 0);
1857 delete_logical_name (XSTRING (varname
)->data
);
1860 CHECK_STRING (string
, 1);
1862 if (XSTRING (string
)->size
== 0)
1863 delete_logical_name (XSTRING (varname
)->data
);
1865 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
1874 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
1875 "Open a network connection to PATH using LOGIN as the login string.")
1877 Lisp_Object path
, login
;
1881 CHECK_STRING (path
, 0);
1882 CHECK_STRING (login
, 0);
1884 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
1886 if (netresult
== -1)
1891 #endif /* HPUX_NET */
1893 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
1895 "Return t if file FILENAME specifies an absolute path name.\n\
1896 On Unix, this is a name starting with a `/' or a `~'.")
1898 Lisp_Object filename
;
1902 CHECK_STRING (filename
, 0);
1903 ptr
= XSTRING (filename
)->data
;
1904 if (*ptr
== '/' || *ptr
== '~'
1906 /* ??? This criterion is probably wrong for '<'. */
1907 || index (ptr
, ':') || index (ptr
, '<')
1908 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
1917 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
1918 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
1919 See also `file-readable-p' and `file-attributes'.")
1921 Lisp_Object filename
;
1923 Lisp_Object abspath
;
1924 Lisp_Object handler
;
1926 CHECK_STRING (filename
, 0);
1927 abspath
= Fexpand_file_name (filename
, Qnil
);
1929 /* If the file name has special constructs in it,
1930 call the corresponding file handler. */
1931 handler
= Ffind_file_name_handler (abspath
);
1932 if (!NILP (handler
))
1933 return call2 (handler
, Qfile_exists_p
, abspath
);
1935 return (access (XSTRING (abspath
)->data
, 0) >= 0) ? Qt
: Qnil
;
1938 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
1939 "Return t if FILENAME can be executed by you.\n\
1940 For directories this means you can change to that directory.")
1942 Lisp_Object filename
;
1945 Lisp_Object abspath
;
1946 Lisp_Object handler
;
1948 CHECK_STRING (filename
, 0);
1949 abspath
= Fexpand_file_name (filename
, Qnil
);
1951 /* If the file name has special constructs in it,
1952 call the corresponding file handler. */
1953 handler
= Ffind_file_name_handler (abspath
);
1954 if (!NILP (handler
))
1955 return call2 (handler
, Qfile_executable_p
, abspath
);
1957 return (access (XSTRING (abspath
)->data
, 1) >= 0) ? Qt
: Qnil
;
1960 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
1961 "Return t if file FILENAME exists and you can read it.\n\
1962 See also `file-exists-p' and `file-attributes'.")
1964 Lisp_Object filename
;
1966 Lisp_Object abspath
;
1967 Lisp_Object handler
;
1969 CHECK_STRING (filename
, 0);
1970 abspath
= Fexpand_file_name (filename
, Qnil
);
1972 /* If the file name has special constructs in it,
1973 call the corresponding file handler. */
1974 handler
= Ffind_file_name_handler (abspath
);
1975 if (!NILP (handler
))
1976 return call2 (handler
, Qfile_readable_p
, abspath
);
1978 return (access (XSTRING (abspath
)->data
, 4) >= 0) ? Qt
: Qnil
;
1981 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
1982 "If file FILENAME is the name of a symbolic link\n\
1983 returns the name of the file to which it is linked.\n\
1984 Otherwise returns NIL.")
1986 Lisp_Object filename
;
1993 Lisp_Object handler
;
1995 CHECK_STRING (filename
, 0);
1996 filename
= Fexpand_file_name (filename
, Qnil
);
1998 /* If the file name has special constructs in it,
1999 call the corresponding file handler. */
2000 handler
= Ffind_file_name_handler (filename
);
2001 if (!NILP (handler
))
2002 return call2 (handler
, Qfile_symlink_p
, filename
);
2007 buf
= (char *) xmalloc (bufsize
);
2008 bzero (buf
, bufsize
);
2009 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2010 if (valsize
< bufsize
) break;
2011 /* Buffer was not long enough */
2020 val
= make_string (buf
, valsize
);
2023 #else /* not S_IFLNK */
2025 #endif /* not S_IFLNK */
2028 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2030 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2031 "Return t if file FILENAME can be written or created by you.")
2033 Lisp_Object filename
;
2035 Lisp_Object abspath
, dir
;
2036 Lisp_Object handler
;
2038 CHECK_STRING (filename
, 0);
2039 abspath
= Fexpand_file_name (filename
, Qnil
);
2041 /* If the file name has special constructs in it,
2042 call the corresponding file handler. */
2043 handler
= Ffind_file_name_handler (abspath
);
2044 if (!NILP (handler
))
2045 return call2 (handler
, Qfile_writable_p
, abspath
);
2047 if (access (XSTRING (abspath
)->data
, 0) >= 0)
2048 return (access (XSTRING (abspath
)->data
, 2) >= 0) ? Qt
: Qnil
;
2049 dir
= Ffile_name_directory (abspath
);
2052 dir
= Fdirectory_file_name (dir
);
2054 return (access (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "", 2) >= 0
2058 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2059 "Return t if file FILENAME is the name of a directory as a file.\n\
2060 A directory name spec may be given instead; then the value is t\n\
2061 if the directory so specified exists and really is a directory.")
2063 Lisp_Object filename
;
2065 register Lisp_Object abspath
;
2067 Lisp_Object handler
;
2069 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2071 /* If the file name has special constructs in it,
2072 call the corresponding file handler. */
2073 handler
= Ffind_file_name_handler (abspath
);
2074 if (!NILP (handler
))
2075 return call2 (handler
, Qfile_directory_p
, abspath
);
2077 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2079 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2082 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2083 "Return t if file FILENAME is the name of a directory as a file,\n\
2084 and files in that directory can be opened by you. In order to use a\n\
2085 directory as a buffer's current directory, this predicate must return true.\n\
2086 A directory name spec may be given instead; then the value is t\n\
2087 if the directory so specified exists and really is a readable and\n\
2088 searchable directory.")
2090 Lisp_Object filename
;
2092 Lisp_Object handler
;
2094 /* If the file name has special constructs in it,
2095 call the corresponding file handler. */
2096 handler
= Ffind_file_name_handler (filename
);
2097 if (!NILP (handler
))
2098 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2100 if (NILP (Ffile_directory_p (filename
))
2101 || NILP (Ffile_executable_p (filename
)))
2107 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2108 "Return mode bits of FILE, as an integer.")
2110 Lisp_Object filename
;
2112 Lisp_Object abspath
;
2114 Lisp_Object handler
;
2116 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2118 /* If the file name has special constructs in it,
2119 call the corresponding file handler. */
2120 handler
= Ffind_file_name_handler (abspath
);
2121 if (!NILP (handler
))
2122 return call2 (handler
, Qfile_modes
, abspath
);
2124 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2126 return make_number (st
.st_mode
& 07777);
2129 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2130 "Set mode bits of FILE to MODE (an integer).\n\
2131 Only the 12 low bits of MODE are used.")
2133 Lisp_Object filename
, mode
;
2135 Lisp_Object abspath
;
2136 Lisp_Object handler
;
2138 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2139 CHECK_NUMBER (mode
, 1);
2141 /* If the file name has special constructs in it,
2142 call the corresponding file handler. */
2143 handler
= Ffind_file_name_handler (abspath
);
2144 if (!NILP (handler
))
2145 return call3 (handler
, Qset_file_modes
, abspath
, mode
);
2148 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2149 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2151 if (!egetenv ("USE_DOMAIN_ACLS"))
2154 struct timeval tvp
[2];
2156 /* chmod on apollo also change the file's modtime; need to save the
2157 modtime and then restore it. */
2158 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2160 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2164 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2165 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2167 /* reset the old accessed and modified times. */
2168 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
2170 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
2173 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
2174 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
2181 DEFUN ("set-umask", Fset_umask
, Sset_umask
, 1, 1, 0,
2182 "Select which permission bits to disable in newly created files.\n\
2183 MASK should be an integer; if a permission's bit in MASK is 1,\n\
2184 subsequently created files will not have that permission enabled.\n\
2185 Only the low 9 bits are used.\n\
2186 This setting is inherited by subprocesses.")
2190 CHECK_NUMBER (mask
, 0);
2192 umask (XINT (mask
) & 0777);
2197 DEFUN ("umask", Fumask
, Sumask
, 0, 0, 0,
2198 "Return the current umask value.\n\
2199 The umask value determines which permissions are enabled in newly\n\
2200 created files. If a permission's bit in the umask is 1, subsequently\n\
2201 created files will not have that permission enabled.")
2206 XSET (mask
, Lisp_Int
, umask (0));
2207 umask (XINT (mask
));
2214 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2215 "Tell Unix to finish all pending disk updates.")
2224 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2225 "Return t if file FILE1 is newer than file FILE2.\n\
2226 If FILE1 does not exist, the answer is nil;\n\
2227 otherwise, if FILE2 does not exist, the answer is t.")
2229 Lisp_Object file1
, file2
;
2231 Lisp_Object abspath1
, abspath2
;
2234 Lisp_Object handler
;
2235 struct gcpro gcpro1
, gcpro2
;
2237 CHECK_STRING (file1
, 0);
2238 CHECK_STRING (file2
, 0);
2241 GCPRO2 (abspath1
, file2
);
2242 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2243 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2246 /* If the file name has special constructs in it,
2247 call the corresponding file handler. */
2248 handler
= Ffind_file_name_handler (abspath1
);
2249 if (!NILP (handler
))
2250 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2252 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2255 mtime1
= st
.st_mtime
;
2257 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2260 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2263 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2265 "Insert contents of file FILENAME after point.\n\
2266 Returns list of absolute pathname and length of data inserted.\n\
2267 If second argument VISIT is non-nil, the buffer's visited filename\n\
2268 and last save file modtime are set, and it is marked unmodified.\n\
2269 If visiting and the file does not exist, visiting is completed\n\
2270 before the error is signaled.")
2272 Lisp_Object filename
, visit
;
2276 register int inserted
= 0;
2277 register int how_much
;
2278 int count
= specpdl_ptr
- specpdl
;
2279 struct gcpro gcpro1
;
2280 Lisp_Object handler
, val
;
2285 if (!NILP (current_buffer
->read_only
))
2286 Fbarf_if_buffer_read_only();
2288 CHECK_STRING (filename
, 0);
2289 filename
= Fexpand_file_name (filename
, Qnil
);
2291 /* If the file name has special constructs in it,
2292 call the corresponding file handler. */
2293 handler
= Ffind_file_name_handler (filename
);
2294 if (!NILP (handler
))
2296 val
= call3 (handler
, Qinsert_file_contents
, filename
, visit
);
2304 if (stat (XSTRING (filename
)->data
, &st
) < 0
2305 || (fd
= open (XSTRING (filename
)->data
, 0)) < 0)
2307 if ((fd
= open (XSTRING (filename
)->data
, 0)) < 0
2308 || fstat (fd
, &st
) < 0)
2309 #endif /* not APOLLO */
2311 if (fd
>= 0) close (fd
);
2313 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2319 record_unwind_protect (close_file_unwind
, make_number (fd
));
2322 /* This code will need to be changed in order to work on named
2323 pipes, and it's probably just not worth it. So we should at
2324 least signal an error. */
2325 if ((st
.st_mode
& S_IFMT
) == S_IFSOCK
)
2326 Fsignal (Qfile_error
,
2327 Fcons (build_string ("reading from named pipe"),
2328 Fcons (filename
, Qnil
)));
2331 /* Supposedly happens on VMS. */
2333 error ("File size is negative");
2336 register Lisp_Object temp
;
2338 /* Make sure point-max won't overflow after this insertion. */
2339 XSET (temp
, Lisp_Int
, st
.st_size
+ Z
);
2340 if (st
.st_size
+ Z
!= XINT (temp
))
2341 error ("maximum buffer size exceeded");
2345 prepare_to_modify_buffer (point
, point
);
2348 if (GAP_SIZE
< st
.st_size
)
2349 make_gap (st
.st_size
- GAP_SIZE
);
2353 int try = min (st
.st_size
- inserted
, 64 << 10);
2356 /* Allow quitting out of the actual I/O. */
2359 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, try);
2377 record_insert (point
, inserted
);
2379 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
2380 offset_intervals (current_buffer
, point
, inserted
);
2386 /* Discard the unwind protect */
2387 specpdl_ptr
= specpdl
+ count
;
2390 error ("IO error reading %s: %s",
2391 XSTRING (filename
)->data
, err_str (errno
));
2398 current_buffer
->undo_list
= Qnil
;
2400 stat (XSTRING (filename
)->data
, &st
);
2402 current_buffer
->modtime
= st
.st_mtime
;
2403 current_buffer
->save_modified
= MODIFF
;
2404 current_buffer
->auto_save_modified
= MODIFF
;
2405 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2406 #ifdef CLASH_DETECTION
2409 if (!NILP (current_buffer
->filename
))
2410 unlock_file (current_buffer
->filename
);
2411 unlock_file (filename
);
2413 #endif /* CLASH_DETECTION */
2414 current_buffer
->filename
= filename
;
2415 /* If visiting nonexistent file, return nil. */
2416 if (current_buffer
->modtime
== -1)
2417 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2420 signal_after_change (point
, 0, inserted
);
2423 RETURN_UNGCPRO (val
);
2424 RETURN_UNGCPRO (Fcons (filename
,
2425 Fcons (make_number (inserted
),
2429 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
2430 "r\nFWrite region to file: ",
2431 "Write current region into specified file.\n\
2432 When called from a program, takes three arguments:\n\
2433 START, END and FILENAME. START and END are buffer positions.\n\
2434 Optional fourth argument APPEND if non-nil means\n\
2435 append to existing file contents (if any).\n\
2436 Optional fifth argument VISIT if t means\n\
2437 set the last-save-file-modtime of buffer to this file's modtime\n\
2438 and mark buffer not modified.\n\
2439 If VISIT is a string, it is a second file name;\n\
2440 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
2441 VISIT is also the file name to lock and unlock for clash detection.\n\
2442 If VISIT is neither t nor nil nor a string,\n\
2443 that means do not print the \"Wrote file\" message.\n\
2444 Kludgy feature: if START is a string, then that string is written\n\
2445 to the file, instead of any buffer contents, and END is ignored.")
2446 (start
, end
, filename
, append
, visit
)
2447 Lisp_Object start
, end
, filename
, append
, visit
;
2455 int count
= specpdl_ptr
- specpdl
;
2457 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
2459 Lisp_Object handler
;
2460 Lisp_Object visit_file
= XTYPE (visit
) == Lisp_String
? visit
: filename
;
2461 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2463 /* Special kludge to simplify auto-saving */
2466 XFASTINT (start
) = BEG
;
2469 else if (XTYPE (start
) != Lisp_String
)
2470 validate_region (&start
, &end
);
2472 GCPRO4 (start
, filename
, visit
, visit_file
);
2473 filename
= Fexpand_file_name (filename
, Qnil
);
2475 /* If the file name has special constructs in it,
2476 call the corresponding file handler. */
2477 handler
= Ffind_file_name_handler (filename
);
2479 if (!NILP (handler
))
2481 Lisp_Object args
[7];
2484 args
[1] = Qwrite_region
;
2490 val
= Ffuncall (7, args
);
2492 /* Do this before reporting IO error
2493 to avoid a "file has changed on disk" warning on
2494 next attempt to save. */
2495 if (EQ (visit
, Qt
) || XTYPE (visit
) == Lisp_String
)
2497 current_buffer
->modtime
= 0;
2498 current_buffer
->save_modified
= MODIFF
;
2499 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2500 current_buffer
->filename
= visit_file
;
2506 #ifdef CLASH_DETECTION
2508 lock_file (visit_file
);
2509 #endif /* CLASH_DETECTION */
2511 fn
= XSTRING (filename
)->data
;
2514 desc
= open (fn
, O_WRONLY
);
2518 if (auto_saving
) /* Overwrite any previous version of autosave file */
2520 vms_truncate (fn
); /* if fn exists, truncate to zero length */
2521 desc
= open (fn
, O_RDWR
);
2523 desc
= creat_copy_attrs (XTYPE (current_buffer
->filename
) == Lisp_String
2524 ? XSTRING (current_buffer
->filename
)->data
: 0,
2527 else /* Write to temporary name and rename if no errors */
2529 Lisp_Object temp_name
;
2530 temp_name
= Ffile_name_directory (filename
);
2532 if (!NILP (temp_name
))
2534 temp_name
= Fmake_temp_name (concat2 (temp_name
,
2535 build_string ("$$SAVE$$")));
2536 fname
= XSTRING (filename
)->data
;
2537 fn
= XSTRING (temp_name
)->data
;
2538 desc
= creat_copy_attrs (fname
, fn
);
2541 /* If we can't open the temporary file, try creating a new
2542 version of the original file. VMS "creat" creates a
2543 new version rather than truncating an existing file. */
2546 desc
= creat (fn
, 0666);
2547 #if 0 /* This can clobber an existing file and fail to replace it,
2548 if the user runs out of space. */
2551 /* We can't make a new version;
2552 try to truncate and rewrite existing version if any. */
2554 desc
= open (fn
, O_RDWR
);
2560 desc
= creat (fn
, 0666);
2563 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
2564 #endif /* not VMS */
2570 #ifdef CLASH_DETECTION
2572 if (!auto_saving
) unlock_file (visit_file
);
2574 #endif /* CLASH_DETECTION */
2575 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
2578 record_unwind_protect (close_file_unwind
, make_number (desc
));
2581 if (lseek (desc
, 0, 2) < 0)
2583 #ifdef CLASH_DETECTION
2584 if (!auto_saving
) unlock_file (visit_file
);
2585 #endif /* CLASH_DETECTION */
2586 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
2591 * Kludge Warning: The VMS C RTL likes to insert carriage returns
2592 * if we do writes that don't end with a carriage return. Furthermore
2593 * it cannot handle writes of more then 16K. The modified
2594 * version of "sys_write" in SYSDEP.C (see comment there) copes with
2595 * this EXCEPT for the last record (iff it doesn't end with a carriage
2596 * return). This implies that if your buffer doesn't end with a carriage
2597 * return, you get one free... tough. However it also means that if
2598 * we make two calls to sys_write (a la the following code) you can
2599 * get one at the gap as well. The easiest way to fix this (honest)
2600 * is to move the gap to the next newline (or the end of the buffer).
2605 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
2606 move_gap (find_next_newline (GPT
, 1));
2612 if (XTYPE (start
) == Lisp_String
)
2614 failure
= 0 > e_write (desc
, XSTRING (start
)->data
,
2615 XSTRING (start
)->size
);
2618 else if (XINT (start
) != XINT (end
))
2620 if (XINT (start
) < GPT
)
2622 register int end1
= XINT (end
);
2624 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
),
2625 min (GPT
, end1
) - tem
);
2629 if (XINT (end
) > GPT
&& !failure
)
2632 tem
= max (tem
, GPT
);
2633 failure
= 0 > e_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
);
2643 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
2644 Disk full in NFS may be reported here. */
2645 if (fsync (desc
) < 0)
2646 failure
= 1, save_errno
= errno
;
2651 /* Spurious "file has changed on disk" warnings have been
2652 observed on Suns as well.
2653 It seems that `close' can change the modtime, under nfs.
2655 (This has supposedly been fixed in Sunos 4,
2656 but who knows about all the other machines with NFS?) */
2659 /* On VMS and APOLLO, must do the stat after the close
2660 since closing changes the modtime. */
2663 /* Recall that #if defined does not work on VMS. */
2670 /* NFS can report a write failure now. */
2671 if (close (desc
) < 0)
2672 failure
= 1, save_errno
= errno
;
2675 /* If we wrote to a temporary name and had no errors, rename to real name. */
2679 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
2687 /* Discard the unwind protect */
2688 specpdl_ptr
= specpdl
+ count
;
2690 #ifdef CLASH_DETECTION
2692 unlock_file (visit_file
);
2693 #endif /* CLASH_DETECTION */
2695 /* Do this before reporting IO error
2696 to avoid a "file has changed on disk" warning on
2697 next attempt to save. */
2698 if (EQ (visit
, Qt
) || XTYPE (visit
) == Lisp_String
)
2699 current_buffer
->modtime
= st
.st_mtime
;
2702 error ("IO error writing %s: %s", fn
, err_str (save_errno
));
2704 if (EQ (visit
, Qt
) || XTYPE (visit
) == Lisp_String
)
2706 current_buffer
->save_modified
= MODIFF
;
2707 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2708 current_buffer
->filename
= visit_file
;
2710 else if (!NILP (visit
))
2714 message ("Wrote %s", XSTRING (visit_file
)->data
);
2720 e_write (desc
, addr
, len
)
2722 register char *addr
;
2725 char buf
[16 * 1024];
2726 register char *p
, *end
;
2728 if (!EQ (current_buffer
->selective_display
, Qt
))
2729 return write (desc
, addr
, len
) - len
;
2733 end
= p
+ sizeof buf
;
2738 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
2747 if (write (desc
, buf
, p
- buf
) != p
- buf
)
2753 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
2754 Sverify_visited_file_modtime
, 1, 1, 0,
2755 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
2756 This means that the file has not been changed since it was visited or saved.")
2762 Lisp_Object handler
;
2764 CHECK_BUFFER (buf
, 0);
2767 if (XTYPE (b
->filename
) != Lisp_String
) return Qt
;
2768 if (b
->modtime
== 0) return Qt
;
2770 /* If the file name has special constructs in it,
2771 call the corresponding file handler. */
2772 handler
= Ffind_file_name_handler (b
->filename
);
2773 if (!NILP (handler
))
2774 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
2776 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
2778 /* If the file doesn't exist now and didn't exist before,
2779 we say that it isn't modified, provided the error is a tame one. */
2780 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
2785 if (st
.st_mtime
== b
->modtime
2786 /* If both are positive, accept them if they are off by one second. */
2787 || (st
.st_mtime
> 0 && b
->modtime
> 0
2788 && (st
.st_mtime
== b
->modtime
+ 1
2789 || st
.st_mtime
== b
->modtime
- 1)))
2794 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
2795 Sclear_visited_file_modtime
, 0, 0, 0,
2796 "Clear out records of last mod time of visited file.\n\
2797 Next attempt to save will certainly not complain of a discrepancy.")
2800 current_buffer
->modtime
= 0;
2804 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
2805 Sset_visited_file_modtime
, 0, 0, 0,
2806 "Update buffer's recorded modification time from the visited file's time.\n\
2807 Useful if the buffer was not read from the file normally\n\
2808 or if the file itself has been changed for some known benign reason.")
2811 register Lisp_Object filename
;
2813 Lisp_Object handler
;
2815 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
2817 /* If the file name has special constructs in it,
2818 call the corresponding file handler. */
2819 handler
= Ffind_file_name_handler (filename
);
2820 if (!NILP (handler
))
2821 current_buffer
->modtime
= 0;
2823 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
2824 current_buffer
->modtime
= st
.st_mtime
;
2832 unsigned char *name
= XSTRING (current_buffer
->name
)->data
;
2835 message ("Autosaving...error for %s", name
);
2836 Fsleep_for (make_number (1), Qnil
);
2837 message ("Autosaving...error!for %s", name
);
2838 Fsleep_for (make_number (1), Qnil
);
2839 message ("Autosaving...error for %s", name
);
2840 Fsleep_for (make_number (1), Qnil
);
2850 /* Get visited file's mode to become the auto save file's mode. */
2851 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
2852 /* But make sure we can overwrite it later! */
2853 auto_save_mode_bits
= st
.st_mode
| 0600;
2855 auto_save_mode_bits
= 0666;
2858 Fwrite_region (Qnil
, Qnil
,
2859 current_buffer
->auto_save_file_name
,
2863 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
2864 "Auto-save all buffers that need it.\n\
2865 This is all buffers that have auto-saving enabled\n\
2866 and are changed since last auto-saved.\n\
2867 Auto-saving writes the buffer into a file\n\
2868 so that your editing is not lost if the system crashes.\n\
2869 This file is not the file you visited; that changes only when you save.\n\n\
2870 Non-nil first argument means do not print any message if successful.\n\
2871 Non-nil second argument means save only current buffer.")
2875 struct buffer
*old
= current_buffer
, *b
;
2876 Lisp_Object tail
, buf
;
2878 char *omessage
= echo_area_glyphs
;
2879 extern minibuf_level
;
2881 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
2882 point to non-strings reached from Vbuffer_alist. */
2888 /* Vrun_hooks is nil before emacs is dumped, and inc-vers.el will
2889 eventually call do-auto-save, so don't err here in that case. */
2890 if (!NILP (Vrun_hooks
))
2891 call1 (Vrun_hooks
, intern ("auto-save-hook"));
2893 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
2894 tail
= XCONS (tail
)->cdr
)
2896 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
2898 /* Check for auto save enabled
2899 and file changed since last auto save
2900 and file changed since last real save. */
2901 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
2902 && b
->save_modified
< BUF_MODIFF (b
)
2903 && b
->auto_save_modified
< BUF_MODIFF (b
))
2905 if ((XFASTINT (b
->save_length
) * 10
2906 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
2907 /* A short file is likely to change a large fraction;
2908 spare the user annoying messages. */
2909 && XFASTINT (b
->save_length
) > 5000
2910 /* These messages are frequent and annoying for `*mail*'. */
2911 && !EQ (b
->filename
, Qnil
))
2913 /* It has shrunk too much; turn off auto-saving here. */
2914 message ("Buffer %s has shrunk a lot; auto save turned off there",
2915 XSTRING (b
->name
)->data
);
2916 /* User can reenable saving with M-x auto-save. */
2917 b
->auto_save_file_name
= Qnil
;
2918 /* Prevent warning from repeating if user does so. */
2919 XFASTINT (b
->save_length
) = 0;
2920 Fsleep_for (make_number (1), Qnil
);
2923 set_buffer_internal (b
);
2924 if (!auto_saved
&& NILP (nomsg
))
2925 message1 ("Auto-saving...");
2926 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
2928 b
->auto_save_modified
= BUF_MODIFF (b
);
2929 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2930 set_buffer_internal (old
);
2934 /* Prevent another auto save till enough input events come in. */
2935 record_auto_save ();
2937 if (auto_saved
&& NILP (nomsg
))
2938 message1 (omessage
? omessage
: "Auto-saving...done");
2944 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
2945 Sset_buffer_auto_saved
, 0, 0, 0,
2946 "Mark current buffer as auto-saved with its current text.\n\
2947 No auto-save file will be written until the buffer changes again.")
2950 current_buffer
->auto_save_modified
= MODIFF
;
2951 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2955 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
2957 "Return t if buffer has been auto-saved since last read in or saved.")
2960 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
2963 /* Reading and completing file names */
2964 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
2966 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
2968 "Internal subroutine for read-file-name. Do not call this.")
2969 (string
, dir
, action
)
2970 Lisp_Object string
, dir
, action
;
2971 /* action is nil for complete, t for return list of completions,
2972 lambda for verify final value */
2974 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
2976 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2983 /* No need to protect ACTION--we only compare it with t and nil. */
2984 GCPRO4 (string
, realdir
, name
, specdir
);
2986 if (XSTRING (string
)->size
== 0)
2988 if (EQ (action
, Qlambda
))
2996 orig_string
= string
;
2997 string
= Fsubstitute_in_file_name (string
);
2998 changed
= NILP (Fstring_equal (string
, orig_string
));
2999 name
= Ffile_name_nondirectory (string
);
3000 val
= Ffile_name_directory (string
);
3002 realdir
= Fexpand_file_name (val
, realdir
);
3007 specdir
= Ffile_name_directory (string
);
3008 val
= Ffile_name_completion (name
, realdir
);
3010 if (XTYPE (val
) != Lisp_String
)
3017 if (!NILP (specdir
))
3018 val
= concat2 (specdir
, val
);
3021 register unsigned char *old
, *new;
3025 osize
= XSTRING (val
)->size
;
3026 /* Quote "$" as "$$" to get it past substitute-in-file-name */
3027 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
3028 if (*old
++ == '$') count
++;
3031 old
= XSTRING (val
)->data
;
3032 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
3033 new = XSTRING (val
)->data
;
3034 for (n
= osize
; n
> 0; n
--)
3045 #endif /* Not VMS */
3050 if (EQ (action
, Qt
))
3051 return Ffile_name_all_completions (name
, realdir
);
3052 /* Only other case actually used is ACTION = lambda */
3054 /* Supposedly this helps commands such as `cd' that read directory names,
3055 but can someone explain how it helps them? -- RMS */
3056 if (XSTRING (name
)->size
== 0)
3059 return Ffile_exists_p (string
);
3062 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3063 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3064 Value is not expanded---you must call `expand-file-name' yourself.\n\
3065 Default name to DEFAULT if user enters a null string.\n\
3066 (If DEFAULT is omitted, the visited file name is used.)\n\
3067 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3068 Non-nil and non-t means also require confirmation after completion.\n\
3069 Fifth arg INITIAL specifies text to start with.\n\
3070 DIR defaults to current buffer's directory default.")
3071 (prompt
, dir
, defalt
, mustmatch
, initial
)
3072 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3074 Lisp_Object val
, insdef
, insdef1
, tem
;
3075 struct gcpro gcpro1
, gcpro2
;
3076 register char *homedir
;
3080 dir
= current_buffer
->directory
;
3082 defalt
= current_buffer
->filename
;
3084 /* If dir starts with user's homedir, change that to ~. */
3085 homedir
= (char *) egetenv ("HOME");
3087 && XTYPE (dir
) == Lisp_String
3088 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3089 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3091 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3092 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3093 XSTRING (dir
)->data
[0] = '~';
3096 if (insert_default_directory
)
3100 if (!NILP (initial
))
3102 Lisp_Object args
[2], pos
;
3106 insdef
= Fconcat (2, args
);
3107 pos
= make_number (XSTRING (dir
)->size
);
3108 insdef1
= Fcons (insdef
, pos
);
3112 insdef
= Qnil
, insdef1
= Qnil
;
3115 count
= specpdl_ptr
- specpdl
;
3116 specbind (intern ("completion-ignore-case"), Qt
);
3119 GCPRO2 (insdef
, defalt
);
3120 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3121 dir
, mustmatch
, insdef1
,
3122 Qfile_name_history
);
3125 unbind_to (count
, Qnil
);
3130 error ("No file name specified");
3131 tem
= Fstring_equal (val
, insdef
);
3132 if (!NILP (tem
) && !NILP (defalt
))
3134 return Fsubstitute_in_file_name (val
);
3137 #if 0 /* Old version */
3138 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3139 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3140 Value is not expanded---you must call `expand-file-name' yourself.\n\
3141 Default name to DEFAULT if user enters a null string.\n\
3142 (If DEFAULT is omitted, the visited file name is used.)\n\
3143 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3144 Non-nil and non-t means also require confirmation after completion.\n\
3145 Fifth arg INITIAL specifies text to start with.\n\
3146 DIR defaults to current buffer's directory default.")
3147 (prompt
, dir
, defalt
, mustmatch
, initial
)
3148 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3150 Lisp_Object val
, insdef
, tem
;
3151 struct gcpro gcpro1
, gcpro2
;
3152 register char *homedir
;
3156 dir
= current_buffer
->directory
;
3158 defalt
= current_buffer
->filename
;
3160 /* If dir starts with user's homedir, change that to ~. */
3161 homedir
= (char *) egetenv ("HOME");
3163 && XTYPE (dir
) == Lisp_String
3164 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3165 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3167 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3168 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3169 XSTRING (dir
)->data
[0] = '~';
3172 if (!NILP (initial
))
3174 else if (insert_default_directory
)
3177 insdef
= build_string ("");
3180 count
= specpdl_ptr
- specpdl
;
3181 specbind (intern ("completion-ignore-case"), Qt
);
3184 GCPRO2 (insdef
, defalt
);
3185 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3187 insert_default_directory
? insdef
: Qnil
,
3188 Qfile_name_history
);
3191 unbind_to (count
, Qnil
);
3196 error ("No file name specified");
3197 tem
= Fstring_equal (val
, insdef
);
3198 if (!NILP (tem
) && !NILP (defalt
))
3200 return Fsubstitute_in_file_name (val
);
3202 #endif /* Old version */
3206 Qexpand_file_name
= intern ("expand-file-name");
3207 Qdirectory_file_name
= intern ("directory-file-name");
3208 Qfile_name_directory
= intern ("file-name-directory");
3209 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
3210 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
3211 Qfile_name_as_directory
= intern ("file-name-as-directory");
3212 Qcopy_file
= intern ("copy-file");
3213 Qmake_directory
= intern ("make-directory");
3214 Qdelete_directory
= intern ("delete-directory");
3215 Qdelete_file
= intern ("delete-file");
3216 Qrename_file
= intern ("rename-file");
3217 Qadd_name_to_file
= intern ("add-name-to-file");
3218 Qmake_symbolic_link
= intern ("make-symbolic-link");
3219 Qfile_exists_p
= intern ("file-exists-p");
3220 Qfile_executable_p
= intern ("file-executable-p");
3221 Qfile_readable_p
= intern ("file-readable-p");
3222 Qfile_symlink_p
= intern ("file-symlink-p");
3223 Qfile_writable_p
= intern ("file-writable-p");
3224 Qfile_directory_p
= intern ("file-directory-p");
3225 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
3226 Qfile_modes
= intern ("file-modes");
3227 Qset_file_modes
= intern ("set-file-modes");
3228 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
3229 Qinsert_file_contents
= intern ("insert-file-contents");
3230 Qwrite_region
= intern ("write-region");
3231 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
3233 staticpro (&Qexpand_file_name
);
3234 staticpro (&Qdirectory_file_name
);
3235 staticpro (&Qfile_name_directory
);
3236 staticpro (&Qfile_name_nondirectory
);
3237 staticpro (&Qunhandled_file_name_directory
);
3238 staticpro (&Qfile_name_as_directory
);
3239 staticpro (&Qcopy_file
);
3240 staticpro (&Qmake_directory
);
3241 staticpro (&Qdelete_directory
);
3242 staticpro (&Qdelete_file
);
3243 staticpro (&Qrename_file
);
3244 staticpro (&Qadd_name_to_file
);
3245 staticpro (&Qmake_symbolic_link
);
3246 staticpro (&Qfile_exists_p
);
3247 staticpro (&Qfile_executable_p
);
3248 staticpro (&Qfile_readable_p
);
3249 staticpro (&Qfile_symlink_p
);
3250 staticpro (&Qfile_writable_p
);
3251 staticpro (&Qfile_directory_p
);
3252 staticpro (&Qfile_accessible_directory_p
);
3253 staticpro (&Qfile_modes
);
3254 staticpro (&Qset_file_modes
);
3255 staticpro (&Qfile_newer_than_file_p
);
3256 staticpro (&Qinsert_file_contents
);
3257 staticpro (&Qwrite_region
);
3258 staticpro (&Qverify_visited_file_modtime
);
3260 Qfile_name_history
= intern ("file-name-history");
3261 Fset (Qfile_name_history
, Qnil
);
3262 staticpro (&Qfile_name_history
);
3264 Qfile_error
= intern ("file-error");
3265 staticpro (&Qfile_error
);
3266 Qfile_already_exists
= intern("file-already-exists");
3267 staticpro (&Qfile_already_exists
);
3269 Fput (Qfile_error
, Qerror_conditions
,
3270 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
3271 Fput (Qfile_error
, Qerror_message
,
3272 build_string ("File error"));
3274 Fput (Qfile_already_exists
, Qerror_conditions
,
3275 Fcons (Qfile_already_exists
,
3276 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
3277 Fput (Qfile_already_exists
, Qerror_message
,
3278 build_string ("File already exists"));
3280 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
3281 "*Non-nil means when reading a filename start with default dir in minibuffer.");
3282 insert_default_directory
= 1;
3284 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
3285 "*Non-nil means write new files with record format `stmlf'.\n\
3286 nil means use format `var'. This variable is meaningful only on VMS.");
3287 vms_stmlf_recfm
= 0;
3289 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
3290 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
3291 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
3294 The first argument given to HANDLER is the name of the I/O primitive\n\
3295 to be handled; the remaining arguments are the arguments that were\n\
3296 passed to that primitive. For example, if you do\n\
3297 (file-exists-p FILENAME)\n\
3298 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
3299 (funcall HANDLER 'file-exists-p FILENAME)\n\
3300 The function `find-file-name-handler' checks this list for a handler\n\
3301 for its argument.");
3302 Vfile_name_handler_alist
= Qnil
;
3304 defsubr (&Sfind_file_name_handler
);
3305 defsubr (&Sfile_name_directory
);
3306 defsubr (&Sfile_name_nondirectory
);
3307 defsubr (&Sunhandled_file_name_directory
);
3308 defsubr (&Sfile_name_as_directory
);
3309 defsubr (&Sdirectory_file_name
);
3310 defsubr (&Smake_temp_name
);
3311 defsubr (&Sexpand_file_name
);
3312 defsubr (&Ssubstitute_in_file_name
);
3313 defsubr (&Scopy_file
);
3314 defsubr (&Smake_directory_internal
);
3315 defsubr (&Sdelete_directory
);
3316 defsubr (&Sdelete_file
);
3317 defsubr (&Srename_file
);
3318 defsubr (&Sadd_name_to_file
);
3320 defsubr (&Smake_symbolic_link
);
3321 #endif /* S_IFLNK */
3323 defsubr (&Sdefine_logical_name
);
3326 defsubr (&Ssysnetunam
);
3327 #endif /* HPUX_NET */
3328 defsubr (&Sfile_name_absolute_p
);
3329 defsubr (&Sfile_exists_p
);
3330 defsubr (&Sfile_executable_p
);
3331 defsubr (&Sfile_readable_p
);
3332 defsubr (&Sfile_writable_p
);
3333 defsubr (&Sfile_symlink_p
);
3334 defsubr (&Sfile_directory_p
);
3335 defsubr (&Sfile_accessible_directory_p
);
3336 defsubr (&Sfile_modes
);
3337 defsubr (&Sset_file_modes
);
3338 defsubr (&Sset_umask
);
3340 defsubr (&Sfile_newer_than_file_p
);
3341 defsubr (&Sinsert_file_contents
);
3342 defsubr (&Swrite_region
);
3343 defsubr (&Sverify_visited_file_modtime
);
3344 defsubr (&Sclear_visited_file_modtime
);
3345 defsubr (&Sset_visited_file_modtime
);
3346 defsubr (&Sdo_auto_save
);
3347 defsubr (&Sset_buffer_auto_saved
);
3348 defsubr (&Srecent_auto_save_p
);
3350 defsubr (&Sread_file_name_internal
);
3351 defsubr (&Sread_file_name
);
3354 defsubr (&Sunix_sync
);