1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994 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>
25 #if !defined (S_ISLNK) && defined (S_IFLNK)
26 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
29 #if !defined (S_ISREG) && defined (S_IFREG)
30 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
41 #include <sys/param.h>
59 extern char *strerror ();
74 #include "intervals.h"
100 #define min(a, b) ((a) < (b) ? (a) : (b))
101 #define max(a, b) ((a) > (b) ? (a) : (b))
103 /* Nonzero during writing of auto-save files */
106 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
107 a new file with the same mode as the original */
108 int auto_save_mode_bits
;
110 /* Alist of elements (REGEXP . HANDLER) for file names
111 whose I/O is done with a special handler. */
112 Lisp_Object Vfile_name_handler_alist
;
114 /* Functions to be called to process text properties in inserted file. */
115 Lisp_Object Vafter_insert_file_functions
;
117 /* Functions to be called to create text property annotations for file. */
118 Lisp_Object Vwrite_region_annotate_functions
;
120 /* Nonzero means, when reading a filename in the minibuffer,
121 start out by inserting the default directory into the minibuffer. */
122 int insert_default_directory
;
124 /* On VMS, nonzero means write new files with record format stmlf.
125 Zero means use var format. */
128 Lisp_Object Qfile_error
, Qfile_already_exists
;
130 Lisp_Object Qfile_name_history
;
132 Lisp_Object Qcar_less_than_car
;
134 report_file_error (string
, data
)
138 Lisp_Object errstring
;
140 errstring
= build_string (strerror (errno
));
142 /* System error messages are capitalized. Downcase the initial
143 unless it is followed by a slash. */
144 if (XSTRING (errstring
)->data
[1] != '/')
145 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
148 Fsignal (Qfile_error
,
149 Fcons (build_string (string
), Fcons (errstring
, data
)));
152 close_file_unwind (fd
)
155 close (XFASTINT (fd
));
158 Lisp_Object Qexpand_file_name
;
159 Lisp_Object Qdirectory_file_name
;
160 Lisp_Object Qfile_name_directory
;
161 Lisp_Object Qfile_name_nondirectory
;
162 Lisp_Object Qunhandled_file_name_directory
;
163 Lisp_Object Qfile_name_as_directory
;
164 Lisp_Object Qcopy_file
;
165 Lisp_Object Qmake_directory
;
166 Lisp_Object Qdelete_directory
;
167 Lisp_Object Qdelete_file
;
168 Lisp_Object Qrename_file
;
169 Lisp_Object Qadd_name_to_file
;
170 Lisp_Object Qmake_symbolic_link
;
171 Lisp_Object Qfile_exists_p
;
172 Lisp_Object Qfile_executable_p
;
173 Lisp_Object Qfile_readable_p
;
174 Lisp_Object Qfile_symlink_p
;
175 Lisp_Object Qfile_writable_p
;
176 Lisp_Object Qfile_directory_p
;
177 Lisp_Object Qfile_accessible_directory_p
;
178 Lisp_Object Qfile_modes
;
179 Lisp_Object Qset_file_modes
;
180 Lisp_Object Qfile_newer_than_file_p
;
181 Lisp_Object Qinsert_file_contents
;
182 Lisp_Object Qwrite_region
;
183 Lisp_Object Qverify_visited_file_modtime
;
184 Lisp_Object Qset_visited_file_modtime
;
186 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 1, 1, 0,
187 "Return FILENAME's handler function, if its syntax is handled specially.\n\
188 Otherwise, return nil.\n\
189 A file name is handled if one of the regular expressions in\n\
190 `file-name-handler-alist' matches it.")
192 Lisp_Object filename
;
194 /* This function must not munge the match data. */
197 CHECK_STRING (filename
, 0);
199 for (chain
= Vfile_name_handler_alist
; XTYPE (chain
) == Lisp_Cons
;
200 chain
= XCONS (chain
)->cdr
)
203 elt
= XCONS (chain
)->car
;
204 if (XTYPE (elt
) == Lisp_Cons
)
207 string
= XCONS (elt
)->car
;
208 if (XTYPE (string
) == Lisp_String
209 && fast_string_match (string
, filename
) >= 0)
210 return XCONS (elt
)->cdr
;
218 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
220 "Return the directory component in file name NAME.\n\
221 Return nil if NAME does not include a directory.\n\
222 Otherwise return a directory spec.\n\
223 Given a Unix syntax file name, returns a string ending in slash;\n\
224 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
228 register unsigned char *beg
;
229 register unsigned char *p
;
232 CHECK_STRING (file
, 0);
234 /* If the file name has special constructs in it,
235 call the corresponding file handler. */
236 handler
= Ffind_file_name_handler (file
);
238 return call2 (handler
, Qfile_name_directory
, file
);
240 #ifdef FILE_SYSTEM_CASE
241 file
= FILE_SYSTEM_CASE (file
);
243 beg
= XSTRING (file
)->data
;
244 p
= beg
+ XSTRING (file
)->size
;
246 while (p
!= beg
&& p
[-1] != '/'
248 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
258 /* Expansion of "c:" to drive and default directory. */
259 if (p
== beg
+ 2 && beg
[1] == ':')
261 int drive
= (*beg
) - 'a';
262 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
263 unsigned char *res
= alloca (MAXPATHLEN
+ 5);
264 if (getdefdir (drive
+ 1, res
+ 2))
266 res
[0] = drive
+ 'a';
268 if (res
[strlen (res
) - 1] != '/')
271 p
= beg
+ strlen (beg
);
275 return make_string (beg
, p
- beg
);
278 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
280 "Return file name NAME sans its directory.\n\
281 For example, in a Unix-syntax file name,\n\
282 this is everything after the last slash,\n\
283 or the entire name if it contains no slash.")
287 register unsigned char *beg
, *p
, *end
;
290 CHECK_STRING (file
, 0);
292 /* If the file name has special constructs in it,
293 call the corresponding file handler. */
294 handler
= Ffind_file_name_handler (file
);
296 return call2 (handler
, Qfile_name_nondirectory
, file
);
298 beg
= XSTRING (file
)->data
;
299 end
= p
= beg
+ XSTRING (file
)->size
;
301 while (p
!= beg
&& p
[-1] != '/'
303 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
310 return make_string (p
, end
- p
);
313 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
, Sunhandled_file_name_directory
, 1, 1, 0,
314 "Return a directly usable directory name somehow associated with FILENAME.\n\
315 A `directly usable' directory name is one that may be used without the\n\
316 intervention of any file handler.\n\
317 If FILENAME is a directly usable file itself, return\n\
318 (file-name-directory FILENAME).\n\
319 The `call-process' and `start-process' functions use this function to\n\
320 get a current directory to run processes in.")
322 Lisp_Object filename
;
326 /* If the file name has special constructs in it,
327 call the corresponding file handler. */
328 handler
= Ffind_file_name_handler (filename
);
330 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
332 return Ffile_name_directory (filename
);
337 file_name_as_directory (out
, in
)
340 int size
= strlen (in
) - 1;
345 /* Is it already a directory string? */
346 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
348 /* Is it a VMS directory file name? If so, hack VMS syntax. */
349 else if (! index (in
, '/')
350 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
351 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
352 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
353 || ! strncmp (&in
[size
- 5], ".dir", 4))
354 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
355 && in
[size
] == '1')))
357 register char *p
, *dot
;
361 dir:x.dir --> dir:[x]
362 dir:[x]y.dir --> dir:[x.y] */
364 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
367 strncpy (out
, in
, p
- in
);
386 dot
= index (p
, '.');
389 /* blindly remove any extension */
390 size
= strlen (out
) + (dot
- p
);
391 strncat (out
, p
, dot
- p
);
402 /* For Unix syntax, Append a slash if necessary */
404 if (out
[size
] != ':' && out
[size
] != '/')
406 if (out
[size
] != '/')
413 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
414 Sfile_name_as_directory
, 1, 1, 0,
415 "Return a string representing file FILENAME interpreted as a directory.\n\
416 This operation exists because a directory is also a file, but its name as\n\
417 a directory is different from its name as a file.\n\
418 The result can be used as the value of `default-directory'\n\
419 or passed as second argument to `expand-file-name'.\n\
420 For a Unix-syntax file name, just appends a slash.\n\
421 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
428 CHECK_STRING (file
, 0);
432 /* If the file name has special constructs in it,
433 call the corresponding file handler. */
434 handler
= Ffind_file_name_handler (file
);
436 return call2 (handler
, Qfile_name_as_directory
, file
);
438 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
439 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
443 * Convert from directory name to filename.
445 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
446 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
447 * On UNIX, it's simple: just make sure there is a terminating /
449 * Value is nonzero if the string output is different from the input.
452 directory_file_name (src
, dst
)
460 struct FAB fab
= cc$rms_fab
;
461 struct NAM nam
= cc$rms_nam
;
462 char esa
[NAM$C_MAXRSS
];
467 if (! index (src
, '/')
468 && (src
[slen
- 1] == ']'
469 || src
[slen
- 1] == ':'
470 || src
[slen
- 1] == '>'))
472 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
474 fab
.fab$b_fns
= slen
;
475 fab
.fab$l_nam
= &nam
;
476 fab
.fab$l_fop
= FAB$M_NAM
;
479 nam
.nam$b_ess
= sizeof esa
;
480 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
482 /* We call SYS$PARSE to handle such things as [--] for us. */
483 if (SYS$
PARSE(&fab
, 0, 0) == RMS$_NORMAL
)
485 slen
= nam
.nam$b_esl
;
486 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
491 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
493 /* what about when we have logical_name:???? */
494 if (src
[slen
- 1] == ':')
495 { /* Xlate logical name and see what we get */
496 ptr
= strcpy (dst
, src
); /* upper case for getenv */
499 if ('a' <= *ptr
&& *ptr
<= 'z')
503 dst
[slen
- 1] = 0; /* remove colon */
504 if (!(src
= egetenv (dst
)))
506 /* should we jump to the beginning of this procedure?
507 Good points: allows us to use logical names that xlate
509 Bad points: can be a problem if we just translated to a device
511 For now, I'll punt and always expect VMS names, and hope for
514 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
515 { /* no recursion here! */
521 { /* not a directory spec */
526 bracket
= src
[slen
- 1];
528 /* If bracket is ']' or '>', bracket - 2 is the corresponding
530 ptr
= index (src
, bracket
- 2);
532 { /* no opening bracket */
536 if (!(rptr
= rindex (src
, '.')))
539 strncpy (dst
, src
, slen
);
543 dst
[slen
++] = bracket
;
548 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
549 then translate the device and recurse. */
550 if (dst
[slen
- 1] == ':'
551 && dst
[slen
- 2] != ':' /* skip decnet nodes */
552 && strcmp(src
+ slen
, "[000000]") == 0)
554 dst
[slen
- 1] = '\0';
555 if ((ptr
= egetenv (dst
))
556 && (rlen
= strlen (ptr
) - 1) > 0
557 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
558 && ptr
[rlen
- 1] == '.')
560 char * buf
= (char *) alloca (strlen (ptr
) + 1);
564 return directory_file_name (buf
, dst
);
569 strcat (dst
, "[000000]");
573 rlen
= strlen (rptr
) - 1;
574 strncat (dst
, rptr
, rlen
);
575 dst
[slen
+ rlen
] = '\0';
576 strcat (dst
, ".DIR.1");
580 /* Process as Unix format: just remove any final slash.
581 But leave "/" unchanged; do not change it to "". */
584 && dst
[slen
- 1] == '/'
586 && dst
[slen
- 2] != ':'
593 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
595 "Returns the file name of the directory named DIR.\n\
596 This is the name of the file that holds the data for the directory DIR.\n\
597 This operation exists because a directory is also a file, but its name as\n\
598 a directory is different from its name as a file.\n\
599 In Unix-syntax, this function just removes the final slash.\n\
600 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
601 it returns a file name such as \"[X]Y.DIR.1\".")
603 Lisp_Object directory
;
608 CHECK_STRING (directory
, 0);
610 if (NILP (directory
))
613 /* If the file name has special constructs in it,
614 call the corresponding file handler. */
615 handler
= Ffind_file_name_handler (directory
);
617 return call2 (handler
, Qdirectory_file_name
, directory
);
620 /* 20 extra chars is insufficient for VMS, since we might perform a
621 logical name translation. an equivalence string can be up to 255
622 chars long, so grab that much extra space... - sss */
623 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
625 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
627 directory_file_name (XSTRING (directory
)->data
, buf
);
628 return build_string (buf
);
631 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
632 "Generate temporary file name (string) starting with PREFIX (a string).\n\
633 The Emacs process number forms part of the result,\n\
634 so there is no danger of generating a name being used by another process.")
639 val
= concat2 (prefix
, build_string ("XXXXXX"));
640 mktemp (XSTRING (val
)->data
);
644 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
645 "Convert FILENAME to absolute, and canonicalize it.\n\
646 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
647 (does not start with slash); if DEFAULT is nil or missing,\n\
648 the current buffer's value of default-directory is used.\n\
649 Path components that are `.' are removed, and \n\
650 path components followed by `..' are removed, along with the `..' itself;\n\
651 note that these simplifications are done without checking the resulting\n\
652 paths in the file system.\n\
653 An initial `~/' expands to your home directory.\n\
654 An initial `~USER/' expands to USER's home directory.\n\
655 See also the function `substitute-in-file-name'.")
657 Lisp_Object name
, defalt
;
661 register unsigned char *newdir
, *p
, *o
;
663 unsigned char *target
;
666 unsigned char * colon
= 0;
667 unsigned char * close
= 0;
668 unsigned char * slash
= 0;
669 unsigned char * brack
= 0;
670 int lbrack
= 0, rbrack
= 0;
673 #ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida */
676 unsigned char *tmp
, *defdir
;
680 CHECK_STRING (name
, 0);
682 /* If the file name has special constructs in it,
683 call the corresponding file handler. */
684 handler
= Ffind_file_name_handler (name
);
686 return call3 (handler
, Qexpand_file_name
, name
, defalt
);
688 /* Use the buffer's default-directory if DEFALT is omitted. */
690 defalt
= current_buffer
->directory
;
691 CHECK_STRING (defalt
, 1);
693 /* Make sure DEFALT is properly expanded.
694 It would be better to do this down below where we actually use
695 defalt. Unfortunately, calling Fexpand_file_name recursively
696 could invoke GC, and the strings might be relocated. This would
697 be annoying because we have pointers into strings lying around
698 that would need adjusting, and people would add new pointers to
699 the code and forget to adjust them, resulting in intermittent bugs.
700 Putting this call here avoids all that crud.
702 The EQ test avoids infinite recursion. */
703 if (! NILP (defalt
) && !EQ (defalt
, name
)
704 /* This saves time in a common case. */
705 && XSTRING (defalt
)->data
[0] != '/')
710 defalt
= Fexpand_file_name (defalt
, Qnil
);
715 /* Filenames on VMS are always upper case. */
716 name
= Fupcase (name
);
718 #ifdef FILE_SYSTEM_CASE
719 name
= FILE_SYSTEM_CASE (name
);
722 nm
= XSTRING (name
)->data
;
725 /* firstly, strip drive name. */
727 unsigned char *colon
= rindex (nm
, ':');
733 drive
= tolower (colon
[-1]) - 'a';
737 defdir
= alloca (MAXPATHLEN
+ 1);
738 relpath
= getdefdir (drive
+ 1, defdir
);
744 /* If nm is absolute, flush ...// and detect /./ and /../.
745 If no /./ or /../ we can return right away. */
753 /* If it turns out that the filename we want to return is just a
754 suffix of FILENAME, we don't need to go through and edit
755 things; we just need to construct a new string using data
756 starting at the middle of FILENAME. If we set lose to a
757 non-zero value, that means we've discovered that we can't do
764 /* Since we know the path is absolute, we can assume that each
765 element starts with a "/". */
767 /* "//" anywhere isn't necessarily hairy; we just start afresh
768 with the second slash. */
769 if (p
[0] == '/' && p
[1] == '/'
771 /* // at start of filename is meaningful on Apollo system */
777 /* "~" is hairy as the start of any path element. */
778 if (p
[0] == '/' && p
[1] == '~')
779 nm
= p
+ 1, lose
= 1;
781 /* "." and ".." are hairy. */
786 || (p
[2] == '.' && (p
[3] == '/'
793 /* if dev:[dir]/, move nm to / */
794 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
795 nm
= (brack
? brack
+ 1 : colon
+ 1);
804 /* VMS pre V4.4,convert '-'s in filenames. */
805 if (lbrack
== rbrack
)
807 if (dots
< 2) /* this is to allow negative version numbers */
812 if (lbrack
> rbrack
&&
813 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
814 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
820 /* count open brackets, reset close bracket pointer */
821 if (p
[0] == '[' || p
[0] == '<')
823 /* count close brackets, set close bracket pointer */
824 if (p
[0] == ']' || p
[0] == '>')
826 /* detect ][ or >< */
827 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
829 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
830 nm
= p
+ 1, lose
= 1;
831 if (p
[0] == ':' && (colon
|| slash
))
832 /* if dev1:[dir]dev2:, move nm to dev2: */
838 /* if /pathname/dev:, move nm to dev: */
841 /* if node::dev:, move colon following dev */
842 else if (colon
&& colon
[-1] == ':')
844 /* if dev1:dev2:, move nm to dev2: */
845 else if (colon
&& colon
[-1] != ':')
850 if (p
[0] == ':' && !colon
)
856 if (lbrack
== rbrack
)
859 else if (p
[0] == '.')
868 return build_string (sys_translate_unix (nm
));
871 if (nm
== XSTRING (name
)->data
)
873 return build_string (nm
);
878 /* Now determine directory to start with and put it in newdir */
882 if (nm
[0] == '~') /* prefix ~ */
888 || nm
[1] == 0) /* ~ by itself */
890 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
891 newdir
= (unsigned char *) "";
893 dostounix_filename (newdir
);
897 nm
++; /* Don't leave the slash in nm. */
900 else /* ~user/filename */
902 for (p
= nm
; *p
&& (*p
!= '/'
907 o
= (unsigned char *) alloca (p
- nm
+ 1);
908 bcopy ((char *) nm
, o
, p
- nm
);
911 pw
= (struct passwd
*) getpwnam (o
+ 1);
914 newdir
= (unsigned char *) pw
-> pw_dir
;
916 nm
= p
+ 1; /* skip the terminator */
922 /* If we don't find a user of that name, leave the name
923 unchanged; don't move nm forward to p. */
936 newdir
= XSTRING (defalt
)->data
;
940 if (newdir
== 0 && relpath
)
945 /* Get rid of any slash at the end of newdir. */
946 int length
= strlen (newdir
);
947 /* Adding `length > 1 &&' makes ~ expand into / when homedir
948 is the root dir. People disagree about whether that is right.
949 Anyway, we can't take the risk of this change now. */
951 if (newdir
[1] != ':' && length
> 1)
953 if (newdir
[length
- 1] == '/')
955 unsigned char *temp
= (unsigned char *) alloca (length
);
956 bcopy (newdir
, temp
, length
- 1);
957 temp
[length
- 1] = 0;
965 /* Now concatenate the directory and name to new space in the stack frame */
966 tlen
+= strlen (nm
) + 1;
968 /* Add reserved space for drive name. */
969 target
= (unsigned char *) alloca (tlen
+ 2) + 2;
971 target
= (unsigned char *) alloca (tlen
);
978 if (nm
[0] == 0 || nm
[0] == '/')
979 strcpy (target
, newdir
);
982 file_name_as_directory (target
, newdir
);
987 if (index (target
, '/'))
988 strcpy (target
, sys_translate_unix (target
));
991 /* Now canonicalize by removing /. and /foo/.. if they appear. */
999 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1005 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1006 /* brackets are offset from each other by 2 */
1009 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1010 /* convert [foo][bar] to [bar] */
1011 while (o
[-1] != '[' && o
[-1] != '<')
1013 else if (*p
== '-' && *o
!= '.')
1016 else if (p
[0] == '-' && o
[-1] == '.' &&
1017 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1018 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1022 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1023 if (p
[1] == '.') /* foo.-.bar ==> bar*/
1025 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1027 /* else [foo.-] ==> [-] */
1033 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1034 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1044 else if (!strncmp (p
, "//", 2)
1046 /* // at start of filename is meaningful in Apollo system */
1054 else if (p
[0] == '/'
1059 /* If "/." is the entire filename, keep the "/". Otherwise,
1060 just delete the whole "/.". */
1061 if (o
== target
&& p
[2] == '\0')
1065 else if (!strncmp (p
, "/..", 3)
1066 /* `/../' is the "superroot" on certain file systems. */
1068 && (p
[3] == '/' || p
[3] == 0))
1070 while (o
!= target
&& *--o
!= '/')
1073 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1077 if (o
== target
&& *o
== '/')
1085 #endif /* not VMS */
1089 /* at last, set drive name. */
1090 if (target
[1] != ':')
1093 target
[0] = (drive
< 0 ? getdisk () : drive
) + 'a';
1098 return make_string (target
, o
- target
);
1101 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'.
1102 DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
1103 "Convert FILENAME to absolute, and canonicalize it.\n\
1104 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1105 (does not start with slash); if DEFAULT is nil or missing,\n\
1106 the current buffer's value of default-directory is used.\n\
1107 Filenames containing `.' or `..' as components are simplified;\n\
1108 initial `~/' expands to your home directory.\n\
1109 See also the function `substitute-in-file-name'.")
1111 Lisp_Object name, defalt;
1115 register unsigned char *newdir, *p, *o;
1117 unsigned char *target;
1121 unsigned char * colon = 0;
1122 unsigned char * close = 0;
1123 unsigned char * slash = 0;
1124 unsigned char * brack = 0;
1125 int lbrack = 0, rbrack = 0;
1129 CHECK_STRING (name
, 0);
1132 /* Filenames on VMS are always upper case. */
1133 name
= Fupcase (name
);
1136 nm
= XSTRING (name
)->data
;
1138 /* If nm is absolute, flush ...// and detect /./ and /../.
1139 If no /./ or /../ we can return right away. */
1151 if (p
[0] == '/' && p
[1] == '/'
1153 /* // at start of filename is meaningful on Apollo system */
1158 if (p
[0] == '/' && p
[1] == '~')
1159 nm
= p
+ 1, lose
= 1;
1160 if (p
[0] == '/' && p
[1] == '.'
1161 && (p
[2] == '/' || p
[2] == 0
1162 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1168 /* if dev:[dir]/, move nm to / */
1169 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1170 nm
= (brack
? brack
+ 1 : colon
+ 1);
1171 lbrack
= rbrack
= 0;
1179 /* VMS pre V4.4,convert '-'s in filenames. */
1180 if (lbrack
== rbrack
)
1182 if (dots
< 2) /* this is to allow negative version numbers */
1187 if (lbrack
> rbrack
&&
1188 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1189 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1195 /* count open brackets, reset close bracket pointer */
1196 if (p
[0] == '[' || p
[0] == '<')
1197 lbrack
++, brack
= 0;
1198 /* count close brackets, set close bracket pointer */
1199 if (p
[0] == ']' || p
[0] == '>')
1200 rbrack
++, brack
= p
;
1201 /* detect ][ or >< */
1202 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1204 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1205 nm
= p
+ 1, lose
= 1;
1206 if (p
[0] == ':' && (colon
|| slash
))
1207 /* if dev1:[dir]dev2:, move nm to dev2: */
1213 /* if /pathname/dev:, move nm to dev: */
1216 /* if node::dev:, move colon following dev */
1217 else if (colon
&& colon
[-1] == ':')
1219 /* if dev1:dev2:, move nm to dev2: */
1220 else if (colon
&& colon
[-1] != ':')
1225 if (p
[0] == ':' && !colon
)
1231 if (lbrack
== rbrack
)
1234 else if (p
[0] == '.')
1242 if (index (nm
, '/'))
1243 return build_string (sys_translate_unix (nm
));
1245 if (nm
== XSTRING (name
)->data
)
1247 return build_string (nm
);
1251 /* Now determine directory to start with and put it in NEWDIR */
1255 if (nm
[0] == '~') /* prefix ~ */
1260 || nm
[1] == 0)/* ~/filename */
1262 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1263 newdir
= (unsigned char *) "";
1266 nm
++; /* Don't leave the slash in nm. */
1269 else /* ~user/filename */
1271 /* Get past ~ to user */
1272 unsigned char *user
= nm
+ 1;
1273 /* Find end of name. */
1274 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1275 int len
= ptr
? ptr
- user
: strlen (user
);
1277 unsigned char *ptr1
= index (user
, ':');
1278 if (ptr1
!= 0 && ptr1
- user
< len
)
1281 /* Copy the user name into temp storage. */
1282 o
= (unsigned char *) alloca (len
+ 1);
1283 bcopy ((char *) user
, o
, len
);
1286 /* Look up the user name. */
1287 pw
= (struct passwd
*) getpwnam (o
+ 1);
1289 error ("\"%s\" isn't a registered user", o
+ 1);
1291 newdir
= (unsigned char *) pw
->pw_dir
;
1293 /* Discard the user name from NM. */
1300 #endif /* not VMS */
1304 defalt
= current_buffer
->directory
;
1305 CHECK_STRING (defalt
, 1);
1306 newdir
= XSTRING (defalt
)->data
;
1309 /* Now concatenate the directory and name to new space in the stack frame */
1311 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1312 target
= (unsigned char *) alloca (tlen
);
1318 if (nm
[0] == 0 || nm
[0] == '/')
1319 strcpy (target
, newdir
);
1322 file_name_as_directory (target
, newdir
);
1325 strcat (target
, nm
);
1327 if (index (target
, '/'))
1328 strcpy (target
, sys_translate_unix (target
));
1331 /* Now canonicalize by removing /. and /foo/.. if they appear */
1339 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1345 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1346 /* brackets are offset from each other by 2 */
1349 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1350 /* convert [foo][bar] to [bar] */
1351 while (o
[-1] != '[' && o
[-1] != '<')
1353 else if (*p
== '-' && *o
!= '.')
1356 else if (p
[0] == '-' && o
[-1] == '.' &&
1357 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1358 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1362 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1363 if (p
[1] == '.') /* foo.-.bar ==> bar*/
1365 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1367 /* else [foo.-] ==> [-] */
1373 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1374 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1384 else if (!strncmp (p
, "//", 2)
1386 /* // at start of filename is meaningful in Apollo system */
1394 else if (p
[0] == '/' && p
[1] == '.' &&
1395 (p
[2] == '/' || p
[2] == 0))
1397 else if (!strncmp (p
, "/..", 3)
1398 /* `/../' is the "superroot" on certain file systems. */
1400 && (p
[3] == '/' || p
[3] == 0))
1402 while (o
!= target
&& *--o
!= '/')
1405 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1409 if (o
== target
&& *o
== '/')
1417 #endif /* not VMS */
1420 return make_string (target
, o
- target
);
1424 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1425 Ssubstitute_in_file_name
, 1, 1, 0,
1426 "Substitute environment variables referred to in FILENAME.\n\
1427 `$FOO' where FOO is an environment variable name means to substitute\n\
1428 the value of that variable. The variable name should be terminated\n\
1429 with a character not a letter, digit or underscore; otherwise, enclose\n\
1430 the entire variable name in braces.\n\
1431 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1432 On VMS, `$' substitution is not done; this function does little and only\n\
1433 duplicates what `expand-file-name' does.")
1439 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1440 unsigned char *target
;
1442 int substituted
= 0;
1445 CHECK_STRING (string
, 0);
1447 nm
= XSTRING (string
)->data
;
1448 endp
= nm
+ XSTRING (string
)->size
;
1450 /* If /~ or // appears, discard everything through first slash. */
1452 for (p
= nm
; p
!= endp
; p
++)
1456 /* // at start of file name is meaningful in Apollo system */
1457 (p
[0] == '/' && p
- 1 != nm
)
1458 #else /* not APOLLO */
1460 #endif /* not APOLLO */
1464 (p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>' ||
1475 if (p
[0] && p
[1] == ':')
1484 return build_string (nm
);
1487 /* See if any variables are substituted into the string
1488 and find the total length of their values in `total' */
1490 for (p
= nm
; p
!= endp
;)
1500 /* "$$" means a single "$" */
1509 while (p
!= endp
&& *p
!= '}') p
++;
1510 if (*p
!= '}') goto missingclose
;
1516 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1520 /* Copy out the variable name */
1521 target
= (unsigned char *) alloca (s
- o
+ 1);
1522 strncpy (target
, o
, s
- o
);
1525 strupr (target
); /* $home == $HOME etc. */
1528 /* Get variable value */
1529 o
= (unsigned char *) egetenv (target
);
1530 /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
1533 if (!o
&& !strcmp (target
, "USER"))
1534 o
= egetenv ("LOGNAME");
1537 if (!o
) goto badvar
;
1538 total
+= strlen (o
);
1545 /* If substitution required, recopy the string and do it */
1546 /* Make space in stack frame for the new copy */
1547 xnm
= (unsigned char *) alloca (XSTRING (string
)->size
+ total
+ 1);
1550 /* Copy the rest of the name through, replacing $ constructs with values */
1567 while (p
!= endp
&& *p
!= '}') p
++;
1568 if (*p
!= '}') goto missingclose
;
1574 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1578 /* Copy out the variable name */
1579 target
= (unsigned char *) alloca (s
- o
+ 1);
1580 strncpy (target
, o
, s
- o
);
1583 strupr (target
); /* $home == $HOME etc. */
1586 /* Get variable value */
1587 o
= (unsigned char *) egetenv (target
);
1588 /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
1591 if (!o
&& !strcmp (target
, "USER"))
1592 o
= egetenv ("LOGNAME");
1604 /* If /~ or // appears, discard everything through first slash. */
1606 for (p
= xnm
; p
!= x
; p
++)
1609 /* // at start of file name is meaningful in Apollo system */
1610 (p
[0] == '/' && p
- 1 != xnm
)
1611 #else /* not APOLLO */
1613 #endif /* not APOLLO */
1615 && p
!= nm
&& p
[-1] == '/')
1618 else if (p
[0] && p
[1] == ':')
1622 return make_string (xnm
, x
- xnm
);
1625 error ("Bad format environment-variable substitution");
1627 error ("Missing \"}\" in environment-variable substitution");
1629 error ("Substituting nonexistent environment variable \"%s\"", target
);
1632 #endif /* not VMS */
1635 /* A slightly faster and more convenient way to get
1636 (directory-file-name (expand-file-name FOO)). */
1639 expand_and_dir_to_file (filename
, defdir
)
1640 Lisp_Object filename
, defdir
;
1642 register Lisp_Object abspath
;
1644 abspath
= Fexpand_file_name (filename
, defdir
);
1647 register int c
= XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1];
1648 if (c
== ':' || c
== ']' || c
== '>')
1649 abspath
= Fdirectory_file_name (abspath
);
1652 /* Remove final slash, if any (unless path is root).
1653 stat behaves differently depending! */
1654 if (XSTRING (abspath
)->size
> 1
1655 && XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] == '/')
1656 /* We cannot take shortcuts; they might be wrong for magic file names. */
1657 abspath
= Fdirectory_file_name (abspath
);
1662 barf_or_query_if_file_exists (absname
, querystring
, interactive
)
1663 Lisp_Object absname
;
1664 unsigned char *querystring
;
1667 register Lisp_Object tem
;
1668 struct gcpro gcpro1
;
1670 if (access (XSTRING (absname
)->data
, 4) >= 0)
1673 Fsignal (Qfile_already_exists
,
1674 Fcons (build_string ("File already exists"),
1675 Fcons (absname
, Qnil
)));
1677 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1678 XSTRING (absname
)->data
, querystring
));
1681 Fsignal (Qfile_already_exists
,
1682 Fcons (build_string ("File already exists"),
1683 Fcons (absname
, Qnil
)));
1688 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
1689 "fCopy file: \nFCopy %s to file: \np\nP",
1690 "Copy FILE to NEWNAME. Both args must be strings.\n\
1691 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1692 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1693 A number as third arg means request confirmation if NEWNAME already exists.\n\
1694 This is what happens in interactive use with M-x.\n\
1695 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
1696 last-modified time as the old one. (This works on only some systems.)\n\
1697 A prefix arg makes KEEP-TIME non-nil.")
1698 (filename
, newname
, ok_if_already_exists
, keep_date
)
1699 Lisp_Object filename
, newname
, ok_if_already_exists
, keep_date
;
1702 char buf
[16 * 1024];
1704 Lisp_Object handler
;
1705 struct gcpro gcpro1
, gcpro2
;
1706 int count
= specpdl_ptr
- specpdl
;
1707 Lisp_Object args
[6];
1708 int input_file_statable_p
;
1710 GCPRO2 (filename
, newname
);
1711 CHECK_STRING (filename
, 0);
1712 CHECK_STRING (newname
, 1);
1713 filename
= Fexpand_file_name (filename
, Qnil
);
1714 newname
= Fexpand_file_name (newname
, Qnil
);
1716 /* If the input file name has special constructs in it,
1717 call the corresponding file handler. */
1718 handler
= Ffind_file_name_handler (filename
);
1719 /* Likewise for output file name. */
1721 handler
= Ffind_file_name_handler (newname
);
1722 if (!NILP (handler
))
1723 return call5 (handler
, Qcopy_file
, filename
, newname
,
1724 ok_if_already_exists
, keep_date
);
1726 if (NILP (ok_if_already_exists
)
1727 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1728 barf_or_query_if_file_exists (newname
, "copy to it",
1729 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1731 ifd
= open (XSTRING (filename
)->data
, 0);
1733 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1735 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1737 /* We can only copy regular files and symbolic links. Other files are not
1739 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
1741 #if defined (S_ISREG) && defined (S_ISLNK)
1742 if (input_file_statable_p
)
1744 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
1746 #if defined (EISDIR)
1747 /* Get a better looking error message. */
1750 report_file_error ("Non-regular file", Fcons (filename
, Qnil
));
1753 #endif /* S_ISREG && S_ISLNK */
1756 /* Create the copy file with the same record format as the input file */
1757 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1760 /* System's default file type was set to binary by _fmode in emacs.c. */
1761 ofd
= creat (XSTRING (newname
)->data
, S_IREAD
| S_IWRITE
);
1762 #else /* not MSDOS */
1763 ofd
= creat (XSTRING (newname
)->data
, 0666);
1764 #endif /* not MSDOS */
1767 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1769 record_unwind_protect (close_file_unwind
, make_number (ofd
));
1773 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1774 if (write (ofd
, buf
, n
) != n
)
1775 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1778 if (input_file_statable_p
)
1780 if (!NILP (keep_date
))
1782 EMACS_TIME atime
, mtime
;
1783 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1784 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1785 EMACS_SET_UTIMES (XSTRING (newname
)->data
, atime
, mtime
);
1788 if (!egetenv ("USE_DOMAIN_ACLS"))
1790 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1793 /* Discard the unwind protects. */
1794 specpdl_ptr
= specpdl
+ count
;
1797 if (close (ofd
) < 0)
1798 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1804 DEFUN ("make-directory-internal", Fmake_directory_internal
,
1805 Smake_directory_internal
, 1, 1, 0,
1806 "Create a directory. One argument, a file name string.")
1808 Lisp_Object dirname
;
1811 Lisp_Object handler
;
1813 CHECK_STRING (dirname
, 0);
1814 dirname
= Fexpand_file_name (dirname
, Qnil
);
1816 handler
= Ffind_file_name_handler (dirname
);
1817 if (!NILP (handler
))
1818 return call3 (handler
, Qmake_directory
, dirname
, Qnil
);
1820 dir
= XSTRING (dirname
)->data
;
1822 if (mkdir (dir
, 0777) != 0)
1823 report_file_error ("Creating directory", Flist (1, &dirname
));
1828 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
1829 "Delete a directory. One argument, a file name string.")
1831 Lisp_Object dirname
;
1834 Lisp_Object handler
;
1836 CHECK_STRING (dirname
, 0);
1837 dirname
= Fexpand_file_name (dirname
, Qnil
);
1838 dir
= XSTRING (dirname
)->data
;
1840 handler
= Ffind_file_name_handler (dirname
);
1841 if (!NILP (handler
))
1842 return call2 (handler
, Qdelete_directory
, dirname
);
1844 if (rmdir (dir
) != 0)
1845 report_file_error ("Removing directory", Flist (1, &dirname
));
1850 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
1851 "Delete specified file. One argument, a file name string.\n\
1852 If file has multiple names, it continues to exist with the other names.")
1854 Lisp_Object filename
;
1856 Lisp_Object handler
;
1857 CHECK_STRING (filename
, 0);
1858 filename
= Fexpand_file_name (filename
, Qnil
);
1860 handler
= Ffind_file_name_handler (filename
);
1861 if (!NILP (handler
))
1862 return call2 (handler
, Qdelete_file
, filename
);
1864 if (0 > unlink (XSTRING (filename
)->data
))
1865 report_file_error ("Removing old name", Flist (1, &filename
));
1869 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
1870 "fRename file: \nFRename %s to file: \np",
1871 "Rename FILE as NEWNAME. Both args strings.\n\
1872 If file has names other than FILE, it continues to have those names.\n\
1873 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1874 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1875 A number as third arg means request confirmation if NEWNAME already exists.\n\
1876 This is what happens in interactive use with M-x.")
1877 (filename
, newname
, ok_if_already_exists
)
1878 Lisp_Object filename
, newname
, ok_if_already_exists
;
1881 Lisp_Object args
[2];
1883 Lisp_Object handler
;
1884 struct gcpro gcpro1
, gcpro2
;
1886 GCPRO2 (filename
, newname
);
1887 CHECK_STRING (filename
, 0);
1888 CHECK_STRING (newname
, 1);
1889 filename
= Fexpand_file_name (filename
, Qnil
);
1890 newname
= Fexpand_file_name (newname
, Qnil
);
1892 /* If the file name has special constructs in it,
1893 call the corresponding file handler. */
1894 handler
= Ffind_file_name_handler (filename
);
1896 handler
= Ffind_file_name_handler (newname
);
1897 if (!NILP (handler
))
1898 return call4 (handler
, Qrename_file
,
1899 filename
, newname
, ok_if_already_exists
);
1901 if (NILP (ok_if_already_exists
)
1902 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1903 barf_or_query_if_file_exists (newname
, "rename to it",
1904 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1906 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1908 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
1909 || 0 > unlink (XSTRING (filename
)->data
))
1914 Fcopy_file (filename
, newname
,
1915 /* We have already prompted if it was an integer,
1916 so don't have copy-file prompt again. */
1917 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
1918 Fdelete_file (filename
);
1925 report_file_error ("Renaming", Flist (2, args
));
1928 report_file_error ("Renaming", Flist (2, &filename
));
1935 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
1936 "fAdd name to file: \nFName to add to %s: \np",
1937 "Give FILE additional name NEWNAME. Both args strings.\n\
1938 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1939 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1940 A number as third arg means request confirmation if NEWNAME already exists.\n\
1941 This is what happens in interactive use with M-x.")
1942 (filename
, newname
, ok_if_already_exists
)
1943 Lisp_Object filename
, newname
, ok_if_already_exists
;
1946 Lisp_Object args
[2];
1948 Lisp_Object handler
;
1949 struct gcpro gcpro1
, gcpro2
;
1951 GCPRO2 (filename
, newname
);
1952 CHECK_STRING (filename
, 0);
1953 CHECK_STRING (newname
, 1);
1954 filename
= Fexpand_file_name (filename
, Qnil
);
1955 newname
= Fexpand_file_name (newname
, Qnil
);
1957 /* If the file name has special constructs in it,
1958 call the corresponding file handler. */
1959 handler
= Ffind_file_name_handler (filename
);
1960 if (!NILP (handler
))
1961 return call4 (handler
, Qadd_name_to_file
, filename
, newname
,
1962 ok_if_already_exists
);
1964 if (NILP (ok_if_already_exists
)
1965 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1966 barf_or_query_if_file_exists (newname
, "make it a new name",
1967 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1968 unlink (XSTRING (newname
)->data
);
1969 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1974 report_file_error ("Adding new name", Flist (2, args
));
1976 report_file_error ("Adding new name", Flist (2, &filename
));
1985 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
1986 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
1987 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
1988 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1989 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1990 A number as third arg means request confirmation if NEWNAME already exists.\n\
1991 This happens for interactive use with M-x.")
1992 (filename
, linkname
, ok_if_already_exists
)
1993 Lisp_Object filename
, linkname
, ok_if_already_exists
;
1996 Lisp_Object args
[2];
1998 Lisp_Object handler
;
1999 struct gcpro gcpro1
, gcpro2
;
2001 GCPRO2 (filename
, linkname
);
2002 CHECK_STRING (filename
, 0);
2003 CHECK_STRING (linkname
, 1);
2004 /* If the link target has a ~, we must expand it to get
2005 a truly valid file name. Otherwise, do not expand;
2006 we want to permit links to relative file names. */
2007 if (XSTRING (filename
)->data
[0] == '~')
2008 filename
= Fexpand_file_name (filename
, Qnil
);
2009 linkname
= Fexpand_file_name (linkname
, Qnil
);
2011 /* If the file name has special constructs in it,
2012 call the corresponding file handler. */
2013 handler
= Ffind_file_name_handler (filename
);
2014 if (!NILP (handler
))
2015 return call4 (handler
, Qmake_symbolic_link
, filename
, linkname
,
2016 ok_if_already_exists
);
2018 if (NILP (ok_if_already_exists
)
2019 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
2020 barf_or_query_if_file_exists (linkname
, "make it a link",
2021 XTYPE (ok_if_already_exists
) == Lisp_Int
);
2022 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2024 /* If we didn't complain already, silently delete existing file. */
2025 if (errno
== EEXIST
)
2027 unlink (XSTRING (linkname
)->data
);
2028 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2035 report_file_error ("Making symbolic link", Flist (2, args
));
2037 report_file_error ("Making symbolic link", Flist (2, &filename
));
2043 #endif /* S_IFLNK */
2047 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2048 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2049 "Define the job-wide logical name NAME to have the value STRING.\n\
2050 If STRING is nil or a null string, the logical name NAME is deleted.")
2052 Lisp_Object varname
;
2055 CHECK_STRING (varname
, 0);
2057 delete_logical_name (XSTRING (varname
)->data
);
2060 CHECK_STRING (string
, 1);
2062 if (XSTRING (string
)->size
== 0)
2063 delete_logical_name (XSTRING (varname
)->data
);
2065 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
2074 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2075 "Open a network connection to PATH using LOGIN as the login string.")
2077 Lisp_Object path
, login
;
2081 CHECK_STRING (path
, 0);
2082 CHECK_STRING (login
, 0);
2084 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2086 if (netresult
== -1)
2091 #endif /* HPUX_NET */
2093 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2095 "Return t if file FILENAME specifies an absolute path name.\n\
2096 On Unix, this is a name starting with a `/' or a `~'.")
2098 Lisp_Object filename
;
2102 CHECK_STRING (filename
, 0);
2103 ptr
= XSTRING (filename
)->data
;
2104 if (*ptr
== '/' || *ptr
== '~'
2106 /* ??? This criterion is probably wrong for '<'. */
2107 || index (ptr
, ':') || index (ptr
, '<')
2108 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2112 || (*ptr
!= 0 && ptr
[1] == ':' && ptr
[2] == '/')
2120 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2121 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2122 See also `file-readable-p' and `file-attributes'.")
2124 Lisp_Object filename
;
2126 Lisp_Object abspath
;
2127 Lisp_Object handler
;
2129 CHECK_STRING (filename
, 0);
2130 abspath
= Fexpand_file_name (filename
, Qnil
);
2132 /* If the file name has special constructs in it,
2133 call the corresponding file handler. */
2134 handler
= Ffind_file_name_handler (abspath
);
2135 if (!NILP (handler
))
2136 return call2 (handler
, Qfile_exists_p
, abspath
);
2138 return (access (XSTRING (abspath
)->data
, 0) >= 0) ? Qt
: Qnil
;
2141 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2142 "Return t if FILENAME can be executed by you.\n\
2143 For a directory, this means you can access files in that directory.")
2145 Lisp_Object filename
;
2148 Lisp_Object abspath
;
2149 Lisp_Object handler
;
2151 CHECK_STRING (filename
, 0);
2152 abspath
= Fexpand_file_name (filename
, Qnil
);
2154 /* If the file name has special constructs in it,
2155 call the corresponding file handler. */
2156 handler
= Ffind_file_name_handler (abspath
);
2157 if (!NILP (handler
))
2158 return call2 (handler
, Qfile_executable_p
, abspath
);
2160 return (access (XSTRING (abspath
)->data
, 1) >= 0) ? Qt
: Qnil
;
2163 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2164 "Return t if file FILENAME exists and you can read it.\n\
2165 See also `file-exists-p' and `file-attributes'.")
2167 Lisp_Object filename
;
2169 Lisp_Object abspath
;
2170 Lisp_Object handler
;
2172 CHECK_STRING (filename
, 0);
2173 abspath
= Fexpand_file_name (filename
, Qnil
);
2175 /* If the file name has special constructs in it,
2176 call the corresponding file handler. */
2177 handler
= Ffind_file_name_handler (abspath
);
2178 if (!NILP (handler
))
2179 return call2 (handler
, Qfile_readable_p
, abspath
);
2181 return (access (XSTRING (abspath
)->data
, 4) >= 0) ? Qt
: Qnil
;
2184 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2185 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2186 The value is the name of the file to which it is linked.\n\
2187 Otherwise returns nil.")
2189 Lisp_Object filename
;
2196 Lisp_Object handler
;
2198 CHECK_STRING (filename
, 0);
2199 filename
= Fexpand_file_name (filename
, Qnil
);
2201 /* If the file name has special constructs in it,
2202 call the corresponding file handler. */
2203 handler
= Ffind_file_name_handler (filename
);
2204 if (!NILP (handler
))
2205 return call2 (handler
, Qfile_symlink_p
, filename
);
2210 buf
= (char *) xmalloc (bufsize
);
2211 bzero (buf
, bufsize
);
2212 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2213 if (valsize
< bufsize
) break;
2214 /* Buffer was not long enough */
2223 val
= make_string (buf
, valsize
);
2226 #else /* not S_IFLNK */
2228 #endif /* not S_IFLNK */
2231 #ifdef SOLARIS_BROKEN_ACCESS
2232 /* In Solaris 2.1, the readonly-ness of the filesystem is not
2233 considered by the access system call. This is Sun's bug, but we
2234 still have to make Emacs work. */
2236 #include <sys/statvfs.h>
2242 struct statvfs statvfsb
;
2244 if (statvfs(path
, &statvfsb
))
2245 return 1; /* error from statvfs, be conservative and say not wrtable */
2247 /* Otherwise, fsys is ro if bit is set. */
2248 return statvfsb
.f_flag
& ST_RDONLY
;
2251 /* But on every other os, access has already done the right thing. */
2252 #define ro_fsys(path) 0
2255 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2257 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2258 "Return t if file FILENAME can be written or created by you.")
2260 Lisp_Object filename
;
2262 Lisp_Object abspath
, dir
;
2263 Lisp_Object handler
;
2265 CHECK_STRING (filename
, 0);
2266 abspath
= Fexpand_file_name (filename
, Qnil
);
2268 /* If the file name has special constructs in it,
2269 call the corresponding file handler. */
2270 handler
= Ffind_file_name_handler (abspath
);
2271 if (!NILP (handler
))
2272 return call2 (handler
, Qfile_writable_p
, abspath
);
2274 if (access (XSTRING (abspath
)->data
, 0) >= 0)
2275 return ((access (XSTRING (abspath
)->data
, 2) >= 0
2276 && ! ro_fsys ((char *) XSTRING (abspath
)->data
))
2278 dir
= Ffile_name_directory (abspath
);
2281 dir
= Fdirectory_file_name (dir
);
2285 dir
= Fdirectory_file_name (dir
);
2287 return ((access (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "", 2) >= 0
2288 && ! ro_fsys ((char *) XSTRING (dir
)->data
))
2292 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2293 "Return t if file FILENAME is the name of a directory as a file.\n\
2294 A directory name spec may be given instead; then the value is t\n\
2295 if the directory so specified exists and really is a directory.")
2297 Lisp_Object filename
;
2299 register Lisp_Object abspath
;
2301 Lisp_Object handler
;
2303 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2305 /* If the file name has special constructs in it,
2306 call the corresponding file handler. */
2307 handler
= Ffind_file_name_handler (abspath
);
2308 if (!NILP (handler
))
2309 return call2 (handler
, Qfile_directory_p
, abspath
);
2311 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2313 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2316 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2317 "Return t if file FILENAME is the name of a directory as a file,\n\
2318 and files in that directory can be opened by you. In order to use a\n\
2319 directory as a buffer's current directory, this predicate must return true.\n\
2320 A directory name spec may be given instead; then the value is t\n\
2321 if the directory so specified exists and really is a readable and\n\
2322 searchable directory.")
2324 Lisp_Object filename
;
2326 Lisp_Object handler
;
2328 /* If the file name has special constructs in it,
2329 call the corresponding file handler. */
2330 handler
= Ffind_file_name_handler (filename
);
2331 if (!NILP (handler
))
2332 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2334 if (NILP (Ffile_directory_p (filename
))
2335 || NILP (Ffile_executable_p (filename
)))
2341 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2342 "Return mode bits of FILE, as an integer.")
2344 Lisp_Object filename
;
2346 Lisp_Object abspath
;
2348 Lisp_Object handler
;
2350 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2352 /* If the file name has special constructs in it,
2353 call the corresponding file handler. */
2354 handler
= Ffind_file_name_handler (abspath
);
2355 if (!NILP (handler
))
2356 return call2 (handler
, Qfile_modes
, abspath
);
2358 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2360 return make_number (st
.st_mode
& 07777);
2363 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2364 "Set mode bits of FILE to MODE (an integer).\n\
2365 Only the 12 low bits of MODE are used.")
2367 Lisp_Object filename
, mode
;
2369 Lisp_Object abspath
;
2370 Lisp_Object handler
;
2372 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2373 CHECK_NUMBER (mode
, 1);
2375 /* If the file name has special constructs in it,
2376 call the corresponding file handler. */
2377 handler
= Ffind_file_name_handler (abspath
);
2378 if (!NILP (handler
))
2379 return call3 (handler
, Qset_file_modes
, abspath
, mode
);
2382 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2383 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2385 if (!egetenv ("USE_DOMAIN_ACLS"))
2388 struct timeval tvp
[2];
2390 /* chmod on apollo also change the file's modtime; need to save the
2391 modtime and then restore it. */
2392 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2394 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2398 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2399 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2401 /* reset the old accessed and modified times. */
2402 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
2404 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
2407 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
2408 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
2415 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2416 "Set the file permission bits for newly created files.\n\
2417 The argument MODE should be an integer; only the low 9 bits are used.\n\
2418 This setting is inherited by subprocesses.")
2422 CHECK_NUMBER (mode
, 0);
2424 umask ((~ XINT (mode
)) & 0777);
2429 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2430 "Return the default file protection for created files.\n\
2431 The value is an integer.")
2437 realmask
= umask (0);
2440 XSET (value
, Lisp_Int
, (~ realmask
) & 0777);
2446 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2447 "Tell Unix to finish all pending disk updates.")
2456 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2457 "Return t if file FILE1 is newer than file FILE2.\n\
2458 If FILE1 does not exist, the answer is nil;\n\
2459 otherwise, if FILE2 does not exist, the answer is t.")
2461 Lisp_Object file1
, file2
;
2463 Lisp_Object abspath1
, abspath2
;
2466 Lisp_Object handler
;
2467 struct gcpro gcpro1
, gcpro2
;
2469 CHECK_STRING (file1
, 0);
2470 CHECK_STRING (file2
, 0);
2473 GCPRO2 (abspath1
, file2
);
2474 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2475 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2478 /* If the file name has special constructs in it,
2479 call the corresponding file handler. */
2480 handler
= Ffind_file_name_handler (abspath1
);
2482 handler
= Ffind_file_name_handler (abspath2
);
2483 if (!NILP (handler
))
2484 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2486 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2489 mtime1
= st
.st_mtime
;
2491 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2494 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2498 Lisp_Object Qfind_buffer_file_type
;
2501 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2503 "Insert contents of file FILENAME after point.\n\
2504 Returns list of absolute file name and length of data inserted.\n\
2505 If second argument VISIT is non-nil, the buffer's visited filename\n\
2506 and last save file modtime are set, and it is marked unmodified.\n\
2507 If visiting and the file does not exist, visiting is completed\n\
2508 before the error is signaled.\n\n\
2509 The optional third and fourth arguments BEG and END\n\
2510 specify what portion of the file to insert.\n\
2511 If VISIT is non-nil, BEG and END must be nil.")
2512 (filename
, visit
, beg
, end
)
2513 Lisp_Object filename
, visit
, beg
, end
;
2517 register int inserted
= 0;
2518 register int how_much
;
2519 int count
= specpdl_ptr
- specpdl
;
2520 struct gcpro gcpro1
, gcpro2
;
2521 Lisp_Object handler
, val
, insval
;
2528 GCPRO2 (filename
, p
);
2529 if (!NILP (current_buffer
->read_only
))
2530 Fbarf_if_buffer_read_only();
2532 CHECK_STRING (filename
, 0);
2533 filename
= Fexpand_file_name (filename
, Qnil
);
2535 /* If the file name has special constructs in it,
2536 call the corresponding file handler. */
2537 handler
= Ffind_file_name_handler (filename
);
2538 if (!NILP (handler
))
2540 val
= call5 (handler
, Qinsert_file_contents
, filename
, visit
, beg
, end
);
2547 if (stat (XSTRING (filename
)->data
, &st
) < 0
2548 || (fd
= open (XSTRING (filename
)->data
, 0)) < 0)
2550 if ((fd
= open (XSTRING (filename
)->data
, 0)) < 0
2551 || fstat (fd
, &st
) < 0)
2552 #endif /* not APOLLO */
2554 if (fd
>= 0) close (fd
);
2556 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2562 record_unwind_protect (close_file_unwind
, make_number (fd
));
2565 /* This code will need to be changed in order to work on named
2566 pipes, and it's probably just not worth it. So we should at
2567 least signal an error. */
2568 if ((st
.st_mode
& S_IFMT
) == S_IFSOCK
)
2569 Fsignal (Qfile_error
,
2570 Fcons (build_string ("reading from named pipe"),
2571 Fcons (filename
, Qnil
)));
2574 /* Supposedly happens on VMS. */
2576 error ("File size is negative");
2578 if (!NILP (beg
) || !NILP (end
))
2580 error ("Attempt to visit less than an entire file");
2583 CHECK_NUMBER (beg
, 0);
2588 CHECK_NUMBER (end
, 0);
2591 XSETINT (end
, st
.st_size
);
2592 if (XINT (end
) != st
.st_size
)
2593 error ("maximum buffer size exceeded");
2596 total
= XINT (end
) - XINT (beg
);
2599 register Lisp_Object temp
;
2601 /* Make sure point-max won't overflow after this insertion. */
2602 XSET (temp
, Lisp_Int
, total
);
2603 if (total
!= XINT (temp
))
2604 error ("maximum buffer size exceeded");
2607 if (NILP (visit
) && total
> 0)
2608 prepare_to_modify_buffer (point
, point
);
2611 if (GAP_SIZE
< total
)
2612 make_gap (total
- GAP_SIZE
);
2614 if (XINT (beg
) != 0)
2616 if (lseek (fd
, XINT (beg
), 0) < 0)
2617 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
2622 int try = min (total
- inserted
, 64 << 10);
2625 /* Allow quitting out of the actual I/O. */
2628 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, try);
2645 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
2646 /* Determine file type from name and remove LFs from CR-LFs if the file
2647 is deemed to be a text file. */
2649 struct gcpro gcpro1
;
2650 Lisp_Object code
= Qnil
;
2652 code
= call1 (Qfind_buffer_file_type
, filename
);
2654 if (XTYPE (code
) == Lisp_Int
)
2655 XFASTINT (current_buffer
->buffer_file_type
) = XFASTINT (code
);
2656 if (XFASTINT (current_buffer
->buffer_file_type
) == 0)
2659 inserted
- crlf_to_lf (inserted
, &FETCH_CHAR (point
- 1) + 1);
2662 GPT
-= reduced_size
;
2663 GAP_SIZE
+= reduced_size
;
2664 inserted
-= reduced_size
;
2671 record_insert (point
, inserted
);
2673 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
2674 offset_intervals (current_buffer
, point
, inserted
);
2680 /* Discard the unwind protect */
2681 specpdl_ptr
= specpdl
+ count
;
2684 error ("IO error reading %s: %s",
2685 XSTRING (filename
)->data
, strerror (errno
));
2692 current_buffer
->undo_list
= Qnil
;
2694 stat (XSTRING (filename
)->data
, &st
);
2699 current_buffer
->modtime
= st
.st_mtime
;
2700 current_buffer
->filename
= filename
;
2703 current_buffer
->save_modified
= MODIFF
;
2704 current_buffer
->auto_save_modified
= MODIFF
;
2705 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2706 #ifdef CLASH_DETECTION
2709 if (!NILP (current_buffer
->filename
))
2710 unlock_file (current_buffer
->filename
);
2711 unlock_file (filename
);
2713 #endif /* CLASH_DETECTION */
2714 /* If visiting nonexistent file, return nil. */
2715 if (current_buffer
->modtime
== -1)
2716 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2719 if (inserted
> 0 && NILP (visit
) && total
> 0)
2720 signal_after_change (point
, 0, inserted
);
2724 p
= Vafter_insert_file_functions
;
2727 insval
= call1 (Fcar (p
), make_number (inserted
));
2730 CHECK_NUMBER (insval
, 0);
2731 inserted
= XFASTINT (insval
);
2739 RETURN_UNGCPRO (val
);
2740 RETURN_UNGCPRO (Fcons (filename
,
2741 Fcons (make_number (inserted
),
2745 static Lisp_Object
build_annotations ();
2747 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
2748 "r\nFWrite region to file: ",
2749 "Write current region into specified file.\n\
2750 When called from a program, takes three arguments:\n\
2751 START, END and FILENAME. START and END are buffer positions.\n\
2752 Optional fourth argument APPEND if non-nil means\n\
2753 append to existing file contents (if any).\n\
2754 Optional fifth argument VISIT if t means\n\
2755 set the last-save-file-modtime of buffer to this file's modtime\n\
2756 and mark buffer not modified.\n\
2757 If VISIT is a string, it is a second file name;\n\
2758 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
2759 VISIT is also the file name to lock and unlock for clash detection.\n\
2760 If VISIT is neither t nor nil nor a string,\n\
2761 that means do not print the \"Wrote file\" message.\n\
2762 Kludgy feature: if START is a string, then that string is written\n\
2763 to the file, instead of any buffer contents, and END is ignored.")
2764 (start
, end
, filename
, append
, visit
)
2765 Lisp_Object start
, end
, filename
, append
, visit
;
2773 int count
= specpdl_ptr
- specpdl
;
2775 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
2777 Lisp_Object handler
;
2778 Lisp_Object visit_file
;
2779 Lisp_Object annotations
;
2780 int visiting
, quietly
;
2781 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2783 int buffer_file_type
2784 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
2787 if (!NILP (start
) && !STRINGP (start
))
2788 validate_region (&start
, &end
);
2790 filename
= Fexpand_file_name (filename
, Qnil
);
2791 if (STRINGP (visit
))
2792 visit_file
= Fexpand_file_name (visit
, Qnil
);
2794 visit_file
= filename
;
2796 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
2797 quietly
= !NILP (visit
);
2801 GCPRO4 (start
, filename
, annotations
, visit_file
);
2803 /* If the file name has special constructs in it,
2804 call the corresponding file handler. */
2805 handler
= Ffind_file_name_handler (filename
);
2807 if (!NILP (handler
))
2810 val
= call6 (handler
, Qwrite_region
, start
, end
,
2811 filename
, append
, visit
);
2815 current_buffer
->save_modified
= MODIFF
;
2816 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2817 current_buffer
->filename
= visit_file
;
2823 /* Special kludge to simplify auto-saving. */
2826 XFASTINT (start
) = BEG
;
2830 annotations
= build_annotations (start
, end
);
2832 #ifdef CLASH_DETECTION
2834 lock_file (visit_file
);
2835 #endif /* CLASH_DETECTION */
2837 fn
= XSTRING (filename
)->data
;
2841 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
2843 desc
= open (fn
, O_WRONLY
);
2848 if (auto_saving
) /* Overwrite any previous version of autosave file */
2850 vms_truncate (fn
); /* if fn exists, truncate to zero length */
2851 desc
= open (fn
, O_RDWR
);
2853 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
2854 ? XSTRING (current_buffer
->filename
)->data
: 0,
2857 else /* Write to temporary name and rename if no errors */
2859 Lisp_Object temp_name
;
2860 temp_name
= Ffile_name_directory (filename
);
2862 if (!NILP (temp_name
))
2864 temp_name
= Fmake_temp_name (concat2 (temp_name
,
2865 build_string ("$$SAVE$$")));
2866 fname
= XSTRING (filename
)->data
;
2867 fn
= XSTRING (temp_name
)->data
;
2868 desc
= creat_copy_attrs (fname
, fn
);
2871 /* If we can't open the temporary file, try creating a new
2872 version of the original file. VMS "creat" creates a
2873 new version rather than truncating an existing file. */
2876 desc
= creat (fn
, 0666);
2877 #if 0 /* This can clobber an existing file and fail to replace it,
2878 if the user runs out of space. */
2881 /* We can't make a new version;
2882 try to truncate and rewrite existing version if any. */
2884 desc
= open (fn
, O_RDWR
);
2890 desc
= creat (fn
, 0666);
2895 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
2896 S_IREAD
| S_IWRITE
);
2897 #else /* not MSDOS */
2898 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
2899 #endif /* not MSDOS */
2900 #endif /* not VMS */
2906 #ifdef CLASH_DETECTION
2908 if (!auto_saving
) unlock_file (visit_file
);
2910 #endif /* CLASH_DETECTION */
2911 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
2914 record_unwind_protect (close_file_unwind
, make_number (desc
));
2917 if (lseek (desc
, 0, 2) < 0)
2919 #ifdef CLASH_DETECTION
2920 if (!auto_saving
) unlock_file (visit_file
);
2921 #endif /* CLASH_DETECTION */
2922 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
2927 * Kludge Warning: The VMS C RTL likes to insert carriage returns
2928 * if we do writes that don't end with a carriage return. Furthermore
2929 * it cannot handle writes of more then 16K. The modified
2930 * version of "sys_write" in SYSDEP.C (see comment there) copes with
2931 * this EXCEPT for the last record (iff it doesn't end with a carriage
2932 * return). This implies that if your buffer doesn't end with a carriage
2933 * return, you get one free... tough. However it also means that if
2934 * we make two calls to sys_write (a la the following code) you can
2935 * get one at the gap as well. The easiest way to fix this (honest)
2936 * is to move the gap to the next newline (or the end of the buffer).
2941 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
2942 move_gap (find_next_newline (GPT
, 1));
2948 if (STRINGP (start
))
2950 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
2951 XSTRING (start
)->size
, 0, &annotations
);
2954 else if (XINT (start
) != XINT (end
))
2957 if (XINT (start
) < GPT
)
2959 register int end1
= XINT (end
);
2961 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
),
2962 min (GPT
, end1
) - tem
, tem
, &annotations
);
2963 nwritten
+= min (GPT
, end1
) - tem
;
2967 if (XINT (end
) > GPT
&& !failure
)
2970 tem
= max (tem
, GPT
);
2971 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
,
2973 nwritten
+= XINT (end
) - tem
;
2979 /* If file was empty, still need to write the annotations */
2980 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
);
2988 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
2989 Disk full in NFS may be reported here. */
2990 /* mib says that closing the file will try to write as fast as NFS can do
2991 it, and that means the fsync here is not crucial for autosave files. */
2992 if (!auto_saving
&& fsync (desc
) < 0)
2993 failure
= 1, save_errno
= errno
;
2996 /* Spurious "file has changed on disk" warnings have been
2997 observed on Suns as well.
2998 It seems that `close' can change the modtime, under nfs.
3000 (This has supposedly been fixed in Sunos 4,
3001 but who knows about all the other machines with NFS?) */
3004 /* On VMS and APOLLO, must do the stat after the close
3005 since closing changes the modtime. */
3008 /* Recall that #if defined does not work on VMS. */
3015 /* NFS can report a write failure now. */
3016 if (close (desc
) < 0)
3017 failure
= 1, save_errno
= errno
;
3020 /* If we wrote to a temporary name and had no errors, rename to real name. */
3024 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
3032 /* Discard the unwind protect */
3033 specpdl_ptr
= specpdl
+ count
;
3035 #ifdef CLASH_DETECTION
3037 unlock_file (visit_file
);
3038 #endif /* CLASH_DETECTION */
3040 /* Do this before reporting IO error
3041 to avoid a "file has changed on disk" warning on
3042 next attempt to save. */
3044 current_buffer
->modtime
= st
.st_mtime
;
3047 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
3051 current_buffer
->save_modified
= MODIFF
;
3052 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3053 current_buffer
->filename
= visit_file
;
3059 message ("Wrote %s", XSTRING (visit_file
)->data
);
3064 Lisp_Object
merge ();
3066 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
3067 "Return t if (car A) is numerically less than (car B).")
3071 return Flss (Fcar (a
), Fcar (b
));
3074 /* Build the complete list of annotations appropriate for writing out
3075 the text between START and END, by calling all the functions in
3076 write-region-annotate-functions and merging the lists they return. */
3079 build_annotations (start
, end
)
3080 Lisp_Object start
, end
;
3082 Lisp_Object annotations
;
3084 struct gcpro gcpro1
, gcpro2
;
3087 p
= Vwrite_region_annotate_functions
;
3088 GCPRO2 (annotations
, p
);
3091 res
= call2 (Fcar (p
), start
, end
);
3092 Flength (res
); /* Check basic validity of return value */
3093 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3100 /* Write to descriptor DESC the LEN characters starting at ADDR,
3101 assuming they start at position POS in the buffer.
3102 Intersperse with them the annotations from *ANNOT
3103 (those which fall within the range of positions POS to POS + LEN),
3104 each at its appropriate position.
3106 Modify *ANNOT by discarding elements as we output them.
3107 The return value is negative in case of system call failure. */
3110 a_write (desc
, addr
, len
, pos
, annot
)
3112 register char *addr
;
3119 int lastpos
= pos
+ len
;
3123 tem
= Fcar_safe (Fcar (*annot
));
3124 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
3125 nextpos
= XFASTINT (tem
);
3127 return e_write (desc
, addr
, lastpos
- pos
);
3130 if (0 > e_write (desc
, addr
, nextpos
- pos
))
3132 addr
+= nextpos
- pos
;
3135 tem
= Fcdr (Fcar (*annot
));
3138 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
))
3141 *annot
= Fcdr (*annot
);
3146 e_write (desc
, addr
, len
)
3148 register char *addr
;
3151 char buf
[16 * 1024];
3152 register char *p
, *end
;
3154 if (!EQ (current_buffer
->selective_display
, Qt
))
3155 return write (desc
, addr
, len
) - len
;
3159 end
= p
+ sizeof buf
;
3164 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
3173 if (write (desc
, buf
, p
- buf
) != p
- buf
)
3179 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
3180 Sverify_visited_file_modtime
, 1, 1, 0,
3181 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
3182 This means that the file has not been changed since it was visited or saved.")
3188 Lisp_Object handler
;
3190 CHECK_BUFFER (buf
, 0);
3193 if (XTYPE (b
->filename
) != Lisp_String
) return Qt
;
3194 if (b
->modtime
== 0) return Qt
;
3196 /* If the file name has special constructs in it,
3197 call the corresponding file handler. */
3198 handler
= Ffind_file_name_handler (b
->filename
);
3199 if (!NILP (handler
))
3200 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
3202 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
3204 /* If the file doesn't exist now and didn't exist before,
3205 we say that it isn't modified, provided the error is a tame one. */
3206 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
3211 if (st
.st_mtime
== b
->modtime
3212 /* If both are positive, accept them if they are off by one second. */
3213 || (st
.st_mtime
> 0 && b
->modtime
> 0
3214 && (st
.st_mtime
== b
->modtime
+ 1
3215 || st
.st_mtime
== b
->modtime
- 1)))
3220 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
3221 Sclear_visited_file_modtime
, 0, 0, 0,
3222 "Clear out records of last mod time of visited file.\n\
3223 Next attempt to save will certainly not complain of a discrepancy.")
3226 current_buffer
->modtime
= 0;
3230 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
3231 Svisited_file_modtime
, 0, 0, 0,
3232 "Return the current buffer's recorded visited file modification time.\n\
3233 The value is a list of the form (HIGH . LOW), like the time values\n\
3234 that `file-attributes' returns.")
3237 return long_to_cons (current_buffer
->modtime
);
3240 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
3241 Sset_visited_file_modtime
, 0, 1, 0,
3242 "Update buffer's recorded modification time from the visited file's time.\n\
3243 Useful if the buffer was not read from the file normally\n\
3244 or if the file itself has been changed for some known benign reason.\n\
3245 An argument specifies the modification time value to use\n\
3246 \(instead of that of the visited file), in the form of a list\n\
3247 \(HIGH . LOW) or (HIGH LOW).")
3249 Lisp_Object time_list
;
3251 if (!NILP (time_list
))
3252 current_buffer
->modtime
= cons_to_long (time_list
);
3255 register Lisp_Object filename
;
3257 Lisp_Object handler
;
3259 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
3261 /* If the file name has special constructs in it,
3262 call the corresponding file handler. */
3263 handler
= Ffind_file_name_handler (filename
);
3264 if (!NILP (handler
))
3265 /* The handler can find the file name the same way we did. */
3266 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
3267 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
3268 current_buffer
->modtime
= st
.st_mtime
;
3277 unsigned char *name
= XSTRING (current_buffer
->name
)->data
;
3280 message ("Autosaving...error for %s", name
);
3281 Fsleep_for (make_number (1), Qnil
);
3282 message ("Autosaving...error!for %s", name
);
3283 Fsleep_for (make_number (1), Qnil
);
3284 message ("Autosaving...error for %s", name
);
3285 Fsleep_for (make_number (1), Qnil
);
3295 /* Get visited file's mode to become the auto save file's mode. */
3296 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
3297 /* But make sure we can overwrite it later! */
3298 auto_save_mode_bits
= st
.st_mode
| 0600;
3300 auto_save_mode_bits
= 0666;
3303 Fwrite_region (Qnil
, Qnil
,
3304 current_buffer
->auto_save_file_name
,
3308 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
3309 "Auto-save all buffers that need it.\n\
3310 This is all buffers that have auto-saving enabled\n\
3311 and are changed since last auto-saved.\n\
3312 Auto-saving writes the buffer into a file\n\
3313 so that your editing is not lost if the system crashes.\n\
3314 This file is not the file you visited; that changes only when you save.\n\n\
3315 Non-nil first argument means do not print any message if successful.\n\
3316 Non-nil second argument means save only current buffer.")
3317 (no_message
, current_only
)
3318 Lisp_Object no_message
, current_only
;
3320 struct buffer
*old
= current_buffer
, *b
;
3321 Lisp_Object tail
, buf
;
3323 char *omessage
= echo_area_glyphs
;
3324 extern int minibuf_level
;
3325 int do_handled_files
;
3328 /* Ordinarily don't quit within this function,
3329 but don't make it impossible to quit (in case we get hung in I/O). */
3333 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
3334 point to non-strings reached from Vbuffer_alist. */
3340 /* Vrun_hooks is nil before emacs is dumped, and inc-vers.el will
3341 eventually call do-auto-save, so don't err here in that case. */
3342 if (!NILP (Vrun_hooks
))
3343 call1 (Vrun_hooks
, intern ("auto-save-hook"));
3345 /* First, save all files which don't have handlers. If Emacs is
3346 crashing, the handlers may tweak what is causing Emacs to crash
3347 in the first place, and it would be a shame if Emacs failed to
3348 autosave perfectly ordinary files because it couldn't handle some
3350 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
3351 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
3352 tail
= XCONS (tail
)->cdr
)
3354 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
3357 if (!NILP (current_only
)
3358 && b
!= current_buffer
)
3361 /* Check for auto save enabled
3362 and file changed since last auto save
3363 and file changed since last real save. */
3364 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
3365 && b
->save_modified
< BUF_MODIFF (b
)
3366 && b
->auto_save_modified
< BUF_MODIFF (b
)
3367 && (do_handled_files
3368 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
))))
3370 EMACS_TIME before_time
, after_time
;
3372 EMACS_GET_TIME (before_time
);
3374 /* If we had a failure, don't try again for 20 minutes. */
3375 if (b
->auto_save_failure_time
>= 0
3376 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
3379 if ((XFASTINT (b
->save_length
) * 10
3380 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
3381 /* A short file is likely to change a large fraction;
3382 spare the user annoying messages. */
3383 && XFASTINT (b
->save_length
) > 5000
3384 /* These messages are frequent and annoying for `*mail*'. */
3385 && !EQ (b
->filename
, Qnil
)
3386 && NILP (no_message
))
3388 /* It has shrunk too much; turn off auto-saving here. */
3389 message ("Buffer %s has shrunk a lot; auto save turned off there",
3390 XSTRING (b
->name
)->data
);
3391 /* User can reenable saving with M-x auto-save. */
3392 b
->auto_save_file_name
= Qnil
;
3393 /* Prevent warning from repeating if user does so. */
3394 XFASTINT (b
->save_length
) = 0;
3395 Fsleep_for (make_number (1), Qnil
);
3398 set_buffer_internal (b
);
3399 if (!auto_saved
&& NILP (no_message
))
3400 message1 ("Auto-saving...");
3401 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
3403 b
->auto_save_modified
= BUF_MODIFF (b
);
3404 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3405 set_buffer_internal (old
);
3407 EMACS_GET_TIME (after_time
);
3409 /* If auto-save took more than 60 seconds,
3410 assume it was an NFS failure that got a timeout. */
3411 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
3412 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
3416 /* Prevent another auto save till enough input events come in. */
3417 record_auto_save ();
3419 if (auto_saved
&& NILP (no_message
))
3420 message1 (omessage
? omessage
: "Auto-saving...done");
3428 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
3429 Sset_buffer_auto_saved
, 0, 0, 0,
3430 "Mark current buffer as auto-saved with its current text.\n\
3431 No auto-save file will be written until the buffer changes again.")
3434 current_buffer
->auto_save_modified
= MODIFF
;
3435 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3436 current_buffer
->auto_save_failure_time
= -1;
3440 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
3441 Sclear_buffer_auto_save_failure
, 0, 0, 0,
3442 "Clear any record of a recent auto-save failure in the current buffer.")
3445 current_buffer
->auto_save_failure_time
= -1;
3449 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
3451 "Return t if buffer has been auto-saved since last read in or saved.")
3454 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
3457 /* Reading and completing file names */
3458 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
3460 /* In the string VAL, change each $ to $$ and return the result. */
3463 double_dollars (val
)
3466 register unsigned char *old
, *new;
3470 osize
= XSTRING (val
)->size
;
3471 /* Quote "$" as "$$" to get it past substitute-in-file-name */
3472 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
3473 if (*old
++ == '$') count
++;
3476 old
= XSTRING (val
)->data
;
3477 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
3478 new = XSTRING (val
)->data
;
3479 for (n
= osize
; n
> 0; n
--)
3492 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
3494 "Internal subroutine for read-file-name. Do not call this.")
3495 (string
, dir
, action
)
3496 Lisp_Object string
, dir
, action
;
3497 /* action is nil for complete, t for return list of completions,
3498 lambda for verify final value */
3500 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
3502 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3509 /* No need to protect ACTION--we only compare it with t and nil. */
3510 GCPRO4 (string
, realdir
, name
, specdir
);
3512 if (XSTRING (string
)->size
== 0)
3514 if (EQ (action
, Qlambda
))
3522 orig_string
= string
;
3523 string
= Fsubstitute_in_file_name (string
);
3524 changed
= NILP (Fstring_equal (string
, orig_string
));
3525 name
= Ffile_name_nondirectory (string
);
3526 val
= Ffile_name_directory (string
);
3528 realdir
= Fexpand_file_name (val
, realdir
);
3533 specdir
= Ffile_name_directory (string
);
3534 val
= Ffile_name_completion (name
, realdir
);
3536 if (XTYPE (val
) != Lisp_String
)
3543 if (!NILP (specdir
))
3544 val
= concat2 (specdir
, val
);
3546 return double_dollars (val
);
3549 #endif /* not VMS */
3553 if (EQ (action
, Qt
))
3554 return Ffile_name_all_completions (name
, realdir
);
3555 /* Only other case actually used is ACTION = lambda */
3557 /* Supposedly this helps commands such as `cd' that read directory names,
3558 but can someone explain how it helps them? -- RMS */
3559 if (XSTRING (name
)->size
== 0)
3562 return Ffile_exists_p (string
);
3565 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3566 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3567 Value is not expanded---you must call `expand-file-name' yourself.\n\
3568 Default name to DEFAULT if user enters a null string.\n\
3569 (If DEFAULT is omitted, the visited file name is used.)\n\
3570 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3571 Non-nil and non-t means also require confirmation after completion.\n\
3572 Fifth arg INITIAL specifies text to start with.\n\
3573 DIR defaults to current buffer's directory default.")
3574 (prompt
, dir
, defalt
, mustmatch
, initial
)
3575 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3577 Lisp_Object val
, insdef
, insdef1
, tem
;
3578 struct gcpro gcpro1
, gcpro2
;
3579 register char *homedir
;
3583 dir
= current_buffer
->directory
;
3585 defalt
= current_buffer
->filename
;
3587 /* If dir starts with user's homedir, change that to ~. */
3588 homedir
= (char *) egetenv ("HOME");
3590 && XTYPE (dir
) == Lisp_String
3591 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3592 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3594 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3595 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3596 XSTRING (dir
)->data
[0] = '~';
3599 if (insert_default_directory
)
3603 if (!NILP (initial
))
3605 Lisp_Object args
[2], pos
;
3609 insdef
= Fconcat (2, args
);
3610 pos
= make_number (XSTRING (dir
)->size
);
3611 insdef1
= Fcons (double_dollars (insdef
), pos
);
3614 insdef1
= double_dollars (insdef
);
3617 insdef
= Qnil
, insdef1
= Qnil
;
3620 count
= specpdl_ptr
- specpdl
;
3621 specbind (intern ("completion-ignore-case"), Qt
);
3624 GCPRO2 (insdef
, defalt
);
3625 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3626 dir
, mustmatch
, insdef1
,
3627 Qfile_name_history
);
3630 unbind_to (count
, Qnil
);
3635 error ("No file name specified");
3636 tem
= Fstring_equal (val
, insdef
);
3637 if (!NILP (tem
) && !NILP (defalt
))
3639 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
3644 error ("No default file name");
3646 return Fsubstitute_in_file_name (val
);
3649 #if 0 /* Old version */
3650 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3651 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3652 Value is not expanded---you must call `expand-file-name' yourself.\n\
3653 Default name to DEFAULT if user enters a null string.\n\
3654 (If DEFAULT is omitted, the visited file name is used.)\n\
3655 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3656 Non-nil and non-t means also require confirmation after completion.\n\
3657 Fifth arg INITIAL specifies text to start with.\n\
3658 DIR defaults to current buffer's directory default.")
3659 (prompt
, dir
, defalt
, mustmatch
, initial
)
3660 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3662 Lisp_Object val
, insdef
, tem
;
3663 struct gcpro gcpro1
, gcpro2
;
3664 register char *homedir
;
3668 dir
= current_buffer
->directory
;
3670 defalt
= current_buffer
->filename
;
3672 /* If dir starts with user's homedir, change that to ~. */
3673 homedir
= (char *) egetenv ("HOME");
3675 && XTYPE (dir
) == Lisp_String
3676 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3677 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3679 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3680 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3681 XSTRING (dir
)->data
[0] = '~';
3684 if (!NILP (initial
))
3686 else if (insert_default_directory
)
3689 insdef
= build_string ("");
3692 count
= specpdl_ptr
- specpdl
;
3693 specbind (intern ("completion-ignore-case"), Qt
);
3696 GCPRO2 (insdef
, defalt
);
3697 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3699 insert_default_directory
? insdef
: Qnil
,
3700 Qfile_name_history
);
3703 unbind_to (count
, Qnil
);
3708 error ("No file name specified");
3709 tem
= Fstring_equal (val
, insdef
);
3710 if (!NILP (tem
) && !NILP (defalt
))
3712 return Fsubstitute_in_file_name (val
);
3714 #endif /* Old version */
3718 Qexpand_file_name
= intern ("expand-file-name");
3719 Qdirectory_file_name
= intern ("directory-file-name");
3720 Qfile_name_directory
= intern ("file-name-directory");
3721 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
3722 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
3723 Qfile_name_as_directory
= intern ("file-name-as-directory");
3724 Qcopy_file
= intern ("copy-file");
3725 Qmake_directory
= intern ("make-directory");
3726 Qdelete_directory
= intern ("delete-directory");
3727 Qdelete_file
= intern ("delete-file");
3728 Qrename_file
= intern ("rename-file");
3729 Qadd_name_to_file
= intern ("add-name-to-file");
3730 Qmake_symbolic_link
= intern ("make-symbolic-link");
3731 Qfile_exists_p
= intern ("file-exists-p");
3732 Qfile_executable_p
= intern ("file-executable-p");
3733 Qfile_readable_p
= intern ("file-readable-p");
3734 Qfile_symlink_p
= intern ("file-symlink-p");
3735 Qfile_writable_p
= intern ("file-writable-p");
3736 Qfile_directory_p
= intern ("file-directory-p");
3737 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
3738 Qfile_modes
= intern ("file-modes");
3739 Qset_file_modes
= intern ("set-file-modes");
3740 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
3741 Qinsert_file_contents
= intern ("insert-file-contents");
3742 Qwrite_region
= intern ("write-region");
3743 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
3744 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
3746 staticpro (&Qexpand_file_name
);
3747 staticpro (&Qdirectory_file_name
);
3748 staticpro (&Qfile_name_directory
);
3749 staticpro (&Qfile_name_nondirectory
);
3750 staticpro (&Qunhandled_file_name_directory
);
3751 staticpro (&Qfile_name_as_directory
);
3752 staticpro (&Qcopy_file
);
3753 staticpro (&Qmake_directory
);
3754 staticpro (&Qdelete_directory
);
3755 staticpro (&Qdelete_file
);
3756 staticpro (&Qrename_file
);
3757 staticpro (&Qadd_name_to_file
);
3758 staticpro (&Qmake_symbolic_link
);
3759 staticpro (&Qfile_exists_p
);
3760 staticpro (&Qfile_executable_p
);
3761 staticpro (&Qfile_readable_p
);
3762 staticpro (&Qfile_symlink_p
);
3763 staticpro (&Qfile_writable_p
);
3764 staticpro (&Qfile_directory_p
);
3765 staticpro (&Qfile_accessible_directory_p
);
3766 staticpro (&Qfile_modes
);
3767 staticpro (&Qset_file_modes
);
3768 staticpro (&Qfile_newer_than_file_p
);
3769 staticpro (&Qinsert_file_contents
);
3770 staticpro (&Qwrite_region
);
3771 staticpro (&Qverify_visited_file_modtime
);
3773 Qfile_name_history
= intern ("file-name-history");
3774 Fset (Qfile_name_history
, Qnil
);
3775 staticpro (&Qfile_name_history
);
3777 Qfile_error
= intern ("file-error");
3778 staticpro (&Qfile_error
);
3779 Qfile_already_exists
= intern("file-already-exists");
3780 staticpro (&Qfile_already_exists
);
3783 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
3784 staticpro (&Qfind_buffer_file_type
);
3787 Qcar_less_than_car
= intern ("car-less-than-car");
3788 staticpro (&Qcar_less_than_car
);
3790 Fput (Qfile_error
, Qerror_conditions
,
3791 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
3792 Fput (Qfile_error
, Qerror_message
,
3793 build_string ("File error"));
3795 Fput (Qfile_already_exists
, Qerror_conditions
,
3796 Fcons (Qfile_already_exists
,
3797 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
3798 Fput (Qfile_already_exists
, Qerror_message
,
3799 build_string ("File already exists"));
3801 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
3802 "*Non-nil means when reading a filename start with default dir in minibuffer.");
3803 insert_default_directory
= 1;
3805 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
3806 "*Non-nil means write new files with record format `stmlf'.\n\
3807 nil means use format `var'. This variable is meaningful only on VMS.");
3808 vms_stmlf_recfm
= 0;
3810 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
3811 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
3812 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
3815 The first argument given to HANDLER is the name of the I/O primitive\n\
3816 to be handled; the remaining arguments are the arguments that were\n\
3817 passed to that primitive. For example, if you do\n\
3818 (file-exists-p FILENAME)\n\
3819 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
3820 (funcall HANDLER 'file-exists-p FILENAME)\n\
3821 The function `find-file-name-handler' checks this list for a handler\n\
3822 for its argument.");
3823 Vfile_name_handler_alist
= Qnil
;
3825 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
3826 "A list of functions to be called at the end of `insert-file-contents'.\n\
3827 Each is passed one argument, the number of bytes inserted. It should return\n\
3828 the new byte count, and leave point the same. If `insert-file-contents' is\n\
3829 intercepted by a handler from `file-name-handler-alist', that handler is\n\
3830 responsible for calling the after-insert-file-functions if appropriate.");
3831 Vafter_insert_file_functions
= Qnil
;
3833 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
3834 "A list of functions to be called at the start of `write-region'.\n\
3835 Each is passed two arguments, START and END as for `write-region'. It should\n\
3836 return a list of pairs (POSITION . STRING) of strings to be effectively\n\
3837 inserted at the specified positions of the file being written (1 means to\n\
3838 insert before the first byte written). The POSITIONs must be sorted into\n\
3839 increasing order. If there are several functions in the list, the several\n\
3840 lists are merged destructively.");
3841 Vwrite_region_annotate_functions
= Qnil
;
3843 defsubr (&Sfind_file_name_handler
);
3844 defsubr (&Sfile_name_directory
);
3845 defsubr (&Sfile_name_nondirectory
);
3846 defsubr (&Sunhandled_file_name_directory
);
3847 defsubr (&Sfile_name_as_directory
);
3848 defsubr (&Sdirectory_file_name
);
3849 defsubr (&Smake_temp_name
);
3850 defsubr (&Sexpand_file_name
);
3851 defsubr (&Ssubstitute_in_file_name
);
3852 defsubr (&Scopy_file
);
3853 defsubr (&Smake_directory_internal
);
3854 defsubr (&Sdelete_directory
);
3855 defsubr (&Sdelete_file
);
3856 defsubr (&Srename_file
);
3857 defsubr (&Sadd_name_to_file
);
3859 defsubr (&Smake_symbolic_link
);
3860 #endif /* S_IFLNK */
3862 defsubr (&Sdefine_logical_name
);
3865 defsubr (&Ssysnetunam
);
3866 #endif /* HPUX_NET */
3867 defsubr (&Sfile_name_absolute_p
);
3868 defsubr (&Sfile_exists_p
);
3869 defsubr (&Sfile_executable_p
);
3870 defsubr (&Sfile_readable_p
);
3871 defsubr (&Sfile_writable_p
);
3872 defsubr (&Sfile_symlink_p
);
3873 defsubr (&Sfile_directory_p
);
3874 defsubr (&Sfile_accessible_directory_p
);
3875 defsubr (&Sfile_modes
);
3876 defsubr (&Sset_file_modes
);
3877 defsubr (&Sset_default_file_modes
);
3878 defsubr (&Sdefault_file_modes
);
3879 defsubr (&Sfile_newer_than_file_p
);
3880 defsubr (&Sinsert_file_contents
);
3881 defsubr (&Swrite_region
);
3882 defsubr (&Scar_less_than_car
);
3883 defsubr (&Sverify_visited_file_modtime
);
3884 defsubr (&Sclear_visited_file_modtime
);
3885 defsubr (&Svisited_file_modtime
);
3886 defsubr (&Sset_visited_file_modtime
);
3887 defsubr (&Sdo_auto_save
);
3888 defsubr (&Sset_buffer_auto_saved
);
3889 defsubr (&Sclear_buffer_auto_save_failure
);
3890 defsubr (&Srecent_auto_save_p
);
3892 defsubr (&Sread_file_name_internal
);
3893 defsubr (&Sread_file_name
);
3896 defsubr (&Sunix_sync
);