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>
29 #if !defined (S_ISLNK) && defined (S_IFLNK)
30 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
33 #if !defined (S_ISREG) && defined (S_IFREG)
34 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
45 #include <sys/param.h>
63 extern char *strerror ();
78 #include "intervals.h"
104 #define min(a, b) ((a) < (b) ? (a) : (b))
105 #define max(a, b) ((a) > (b) ? (a) : (b))
107 /* Nonzero during writing of auto-save files */
110 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
111 a new file with the same mode as the original */
112 int auto_save_mode_bits
;
114 /* Alist of elements (REGEXP . HANDLER) for file names
115 whose I/O is done with a special handler. */
116 Lisp_Object Vfile_name_handler_alist
;
118 /* Functions to be called to process text properties in inserted file. */
119 Lisp_Object Vafter_insert_file_functions
;
121 /* Functions to be called to create text property annotations for file. */
122 Lisp_Object Vwrite_region_annotate_functions
;
124 /* File name in which we write a list of all our auto save files. */
125 Lisp_Object Vauto_save_list_file_name
;
127 /* Nonzero means, when reading a filename in the minibuffer,
128 start out by inserting the default directory into the minibuffer. */
129 int insert_default_directory
;
131 /* On VMS, nonzero means write new files with record format stmlf.
132 Zero means use var format. */
135 /* These variables describe handlers that have "already" had a chance
136 to handle the current operation.
138 Vinhibit_file_name_handlers is a list of file name handlers.
139 Vinhibit_file_name_operation is the operation being handled.
140 If we try to handle that operation, we ignore those handlers. */
142 static Lisp_Object Vinhibit_file_name_handlers
;
143 static Lisp_Object Vinhibit_file_name_operation
;
145 Lisp_Object Qfile_error
, Qfile_already_exists
;
147 Lisp_Object Qfile_name_history
;
149 Lisp_Object Qcar_less_than_car
;
151 report_file_error (string
, data
)
155 Lisp_Object errstring
;
157 errstring
= build_string (strerror (errno
));
159 /* System error messages are capitalized. Downcase the initial
160 unless it is followed by a slash. */
161 if (XSTRING (errstring
)->data
[1] != '/')
162 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
165 Fsignal (Qfile_error
,
166 Fcons (build_string (string
), Fcons (errstring
, data
)));
169 close_file_unwind (fd
)
172 close (XFASTINT (fd
));
175 /* Restore point, having saved it as a marker. */
177 restore_point_unwind (location
)
178 Lisp_Object location
;
180 SET_PT (marker_position (location
));
181 Fset_marker (location
, Qnil
, Qnil
);
184 Lisp_Object Qexpand_file_name
;
185 Lisp_Object Qdirectory_file_name
;
186 Lisp_Object Qfile_name_directory
;
187 Lisp_Object Qfile_name_nondirectory
;
188 Lisp_Object Qunhandled_file_name_directory
;
189 Lisp_Object Qfile_name_as_directory
;
190 Lisp_Object Qcopy_file
;
191 Lisp_Object Qmake_directory
;
192 Lisp_Object Qdelete_directory
;
193 Lisp_Object Qdelete_file
;
194 Lisp_Object Qrename_file
;
195 Lisp_Object Qadd_name_to_file
;
196 Lisp_Object Qmake_symbolic_link
;
197 Lisp_Object Qfile_exists_p
;
198 Lisp_Object Qfile_executable_p
;
199 Lisp_Object Qfile_readable_p
;
200 Lisp_Object Qfile_symlink_p
;
201 Lisp_Object Qfile_writable_p
;
202 Lisp_Object Qfile_directory_p
;
203 Lisp_Object Qfile_accessible_directory_p
;
204 Lisp_Object Qfile_modes
;
205 Lisp_Object Qset_file_modes
;
206 Lisp_Object Qfile_newer_than_file_p
;
207 Lisp_Object Qinsert_file_contents
;
208 Lisp_Object Qwrite_region
;
209 Lisp_Object Qverify_visited_file_modtime
;
210 Lisp_Object Qset_visited_file_modtime
;
212 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
213 "Return FILENAME's handler function for OPERATION, if it has one.\n\
214 Otherwise, return nil.\n\
215 A file name is handled if one of the regular expressions in\n\
216 `file-name-handler-alist' matches it.\n\n\
217 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
218 any handlers that are members of `inhibit-file-name-handlers',\n\
219 but we still do run any other handlers. This lets handlers\n\
220 use the standard functions without calling themselves recursively.")
221 (filename
, operation
)
222 Lisp_Object filename
, operation
;
224 /* This function must not munge the match data. */
225 Lisp_Object chain
, inhibited_handlers
;
227 CHECK_STRING (filename
, 0);
229 if (EQ (operation
, Vinhibit_file_name_operation
))
230 inhibited_handlers
= Vinhibit_file_name_handlers
;
232 inhibited_handlers
= Qnil
;
234 for (chain
= Vfile_name_handler_alist
; XTYPE (chain
) == Lisp_Cons
;
235 chain
= XCONS (chain
)->cdr
)
238 elt
= XCONS (chain
)->car
;
239 if (XTYPE (elt
) == Lisp_Cons
)
242 string
= XCONS (elt
)->car
;
243 if (XTYPE (string
) == Lisp_String
244 && fast_string_match (string
, filename
) >= 0)
246 Lisp_Object handler
, tem
;
248 handler
= XCONS (elt
)->cdr
;
249 tem
= Fmemq (handler
, inhibited_handlers
);
260 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
262 "Return the directory component in file name NAME.\n\
263 Return nil if NAME does not include a directory.\n\
264 Otherwise return a directory spec.\n\
265 Given a Unix syntax file name, returns a string ending in slash;\n\
266 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
270 register unsigned char *beg
;
271 register unsigned char *p
;
274 CHECK_STRING (file
, 0);
276 /* If the file name has special constructs in it,
277 call the corresponding file handler. */
278 handler
= Ffind_file_name_handler (file
, Qfile_name_directory
);
280 return call2 (handler
, Qfile_name_directory
, file
);
282 #ifdef FILE_SYSTEM_CASE
283 file
= FILE_SYSTEM_CASE (file
);
285 beg
= XSTRING (file
)->data
;
286 p
= beg
+ XSTRING (file
)->size
;
288 while (p
!= beg
&& p
[-1] != '/'
290 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
300 /* Expansion of "c:" to drive and default directory. */
301 if (p
== beg
+ 2 && beg
[1] == ':')
303 int drive
= (*beg
) - 'a';
304 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
305 unsigned char *res
= alloca (MAXPATHLEN
+ 5);
306 if (getdefdir (drive
+ 1, res
+ 2))
308 res
[0] = drive
+ 'a';
310 if (res
[strlen (res
) - 1] != '/')
313 p
= beg
+ strlen (beg
);
317 return make_string (beg
, p
- beg
);
320 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
322 "Return file name NAME sans its directory.\n\
323 For example, in a Unix-syntax file name,\n\
324 this is everything after the last slash,\n\
325 or the entire name if it contains no slash.")
329 register unsigned char *beg
, *p
, *end
;
332 CHECK_STRING (file
, 0);
334 /* If the file name has special constructs in it,
335 call the corresponding file handler. */
336 handler
= Ffind_file_name_handler (file
, Qfile_name_nondirectory
);
338 return call2 (handler
, Qfile_name_nondirectory
, file
);
340 beg
= XSTRING (file
)->data
;
341 end
= p
= beg
+ XSTRING (file
)->size
;
343 while (p
!= beg
&& p
[-1] != '/'
345 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
352 return make_string (p
, end
- p
);
355 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
, Sunhandled_file_name_directory
, 1, 1, 0,
356 "Return a directly usable directory name somehow associated with FILENAME.\n\
357 A `directly usable' directory name is one that may be used without the\n\
358 intervention of any file handler.\n\
359 If FILENAME is a directly usable file itself, return\n\
360 (file-name-directory FILENAME).\n\
361 The `call-process' and `start-process' functions use this function to\n\
362 get a current directory to run processes in.")
364 Lisp_Object filename
;
368 /* If the file name has special constructs in it,
369 call the corresponding file handler. */
370 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
372 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
374 return Ffile_name_directory (filename
);
379 file_name_as_directory (out
, in
)
382 int size
= strlen (in
) - 1;
387 /* Is it already a directory string? */
388 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
390 /* Is it a VMS directory file name? If so, hack VMS syntax. */
391 else if (! index (in
, '/')
392 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
393 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
394 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
395 || ! strncmp (&in
[size
- 5], ".dir", 4))
396 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
397 && in
[size
] == '1')))
399 register char *p
, *dot
;
403 dir:x.dir --> dir:[x]
404 dir:[x]y.dir --> dir:[x.y] */
406 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
409 strncpy (out
, in
, p
- in
);
428 dot
= index (p
, '.');
431 /* blindly remove any extension */
432 size
= strlen (out
) + (dot
- p
);
433 strncat (out
, p
, dot
- p
);
444 /* For Unix syntax, Append a slash if necessary */
446 if (out
[size
] != ':' && out
[size
] != '/')
448 if (out
[size
] != '/')
455 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
456 Sfile_name_as_directory
, 1, 1, 0,
457 "Return a string representing file FILENAME interpreted as a directory.\n\
458 This operation exists because a directory is also a file, but its name as\n\
459 a directory is different from its name as a file.\n\
460 The result can be used as the value of `default-directory'\n\
461 or passed as second argument to `expand-file-name'.\n\
462 For a Unix-syntax file name, just appends a slash.\n\
463 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
470 CHECK_STRING (file
, 0);
474 /* If the file name has special constructs in it,
475 call the corresponding file handler. */
476 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
478 return call2 (handler
, Qfile_name_as_directory
, file
);
480 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
481 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
485 * Convert from directory name to filename.
487 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
488 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
489 * On UNIX, it's simple: just make sure there is a terminating /
491 * Value is nonzero if the string output is different from the input.
494 directory_file_name (src
, dst
)
502 struct FAB fab
= cc$rms_fab
;
503 struct NAM nam
= cc$rms_nam
;
504 char esa
[NAM$C_MAXRSS
];
509 if (! index (src
, '/')
510 && (src
[slen
- 1] == ']'
511 || src
[slen
- 1] == ':'
512 || src
[slen
- 1] == '>'))
514 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
516 fab
.fab$b_fns
= slen
;
517 fab
.fab$l_nam
= &nam
;
518 fab
.fab$l_fop
= FAB$M_NAM
;
521 nam
.nam$b_ess
= sizeof esa
;
522 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
524 /* We call SYS$PARSE to handle such things as [--] for us. */
525 if (SYS$
PARSE(&fab
, 0, 0) == RMS$_NORMAL
)
527 slen
= nam
.nam$b_esl
;
528 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
533 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
535 /* what about when we have logical_name:???? */
536 if (src
[slen
- 1] == ':')
537 { /* Xlate logical name and see what we get */
538 ptr
= strcpy (dst
, src
); /* upper case for getenv */
541 if ('a' <= *ptr
&& *ptr
<= 'z')
545 dst
[slen
- 1] = 0; /* remove colon */
546 if (!(src
= egetenv (dst
)))
548 /* should we jump to the beginning of this procedure?
549 Good points: allows us to use logical names that xlate
551 Bad points: can be a problem if we just translated to a device
553 For now, I'll punt and always expect VMS names, and hope for
556 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
557 { /* no recursion here! */
563 { /* not a directory spec */
568 bracket
= src
[slen
- 1];
570 /* If bracket is ']' or '>', bracket - 2 is the corresponding
572 ptr
= index (src
, bracket
- 2);
574 { /* no opening bracket */
578 if (!(rptr
= rindex (src
, '.')))
581 strncpy (dst
, src
, slen
);
585 dst
[slen
++] = bracket
;
590 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
591 then translate the device and recurse. */
592 if (dst
[slen
- 1] == ':'
593 && dst
[slen
- 2] != ':' /* skip decnet nodes */
594 && strcmp(src
+ slen
, "[000000]") == 0)
596 dst
[slen
- 1] = '\0';
597 if ((ptr
= egetenv (dst
))
598 && (rlen
= strlen (ptr
) - 1) > 0
599 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
600 && ptr
[rlen
- 1] == '.')
602 char * buf
= (char *) alloca (strlen (ptr
) + 1);
606 return directory_file_name (buf
, dst
);
611 strcat (dst
, "[000000]");
615 rlen
= strlen (rptr
) - 1;
616 strncat (dst
, rptr
, rlen
);
617 dst
[slen
+ rlen
] = '\0';
618 strcat (dst
, ".DIR.1");
622 /* Process as Unix format: just remove any final slash.
623 But leave "/" unchanged; do not change it to "". */
626 && dst
[slen
- 1] == '/'
628 && dst
[slen
- 2] != ':'
635 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
637 "Returns the file name of the directory named DIR.\n\
638 This is the name of the file that holds the data for the directory DIR.\n\
639 This operation exists because a directory is also a file, but its name as\n\
640 a directory is different from its name as a file.\n\
641 In Unix-syntax, this function just removes the final slash.\n\
642 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
643 it returns a file name such as \"[X]Y.DIR.1\".")
645 Lisp_Object directory
;
650 CHECK_STRING (directory
, 0);
652 if (NILP (directory
))
655 /* If the file name has special constructs in it,
656 call the corresponding file handler. */
657 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
659 return call2 (handler
, Qdirectory_file_name
, directory
);
662 /* 20 extra chars is insufficient for VMS, since we might perform a
663 logical name translation. an equivalence string can be up to 255
664 chars long, so grab that much extra space... - sss */
665 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
667 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
669 directory_file_name (XSTRING (directory
)->data
, buf
);
670 return build_string (buf
);
673 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
674 "Generate temporary file name (string) starting with PREFIX (a string).\n\
675 The Emacs process number forms part of the result,\n\
676 so there is no danger of generating a name being used by another process.")
681 val
= concat2 (prefix
, build_string ("XXXXXX"));
682 mktemp (XSTRING (val
)->data
);
686 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
687 "Convert FILENAME to absolute, and canonicalize it.\n\
688 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
689 (does not start with slash); if DEFAULT is nil or missing,\n\
690 the current buffer's value of default-directory is used.\n\
691 Path components that are `.' are removed, and \n\
692 path components followed by `..' are removed, along with the `..' itself;\n\
693 note that these simplifications are done without checking the resulting\n\
694 paths in the file system.\n\
695 An initial `~/' expands to your home directory.\n\
696 An initial `~USER/' expands to USER's home directory.\n\
697 See also the function `substitute-in-file-name'.")
699 Lisp_Object name
, defalt
;
703 register unsigned char *newdir
, *p
, *o
;
705 unsigned char *target
;
708 unsigned char * colon
= 0;
709 unsigned char * close
= 0;
710 unsigned char * slash
= 0;
711 unsigned char * brack
= 0;
712 int lbrack
= 0, rbrack
= 0;
715 #ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida */
718 unsigned char *tmp
, *defdir
;
722 CHECK_STRING (name
, 0);
724 /* If the file name has special constructs in it,
725 call the corresponding file handler. */
726 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
728 return call3 (handler
, Qexpand_file_name
, name
, defalt
);
730 /* Use the buffer's default-directory if DEFALT is omitted. */
732 defalt
= current_buffer
->directory
;
733 CHECK_STRING (defalt
, 1);
735 /* Make sure DEFALT is properly expanded.
736 It would be better to do this down below where we actually use
737 defalt. Unfortunately, calling Fexpand_file_name recursively
738 could invoke GC, and the strings might be relocated. This would
739 be annoying because we have pointers into strings lying around
740 that would need adjusting, and people would add new pointers to
741 the code and forget to adjust them, resulting in intermittent bugs.
742 Putting this call here avoids all that crud.
744 The EQ test avoids infinite recursion. */
745 if (! NILP (defalt
) && !EQ (defalt
, name
)
746 /* This saves time in a common case. */
747 && XSTRING (defalt
)->data
[0] != '/')
752 defalt
= Fexpand_file_name (defalt
, Qnil
);
757 /* Filenames on VMS are always upper case. */
758 name
= Fupcase (name
);
760 #ifdef FILE_SYSTEM_CASE
761 name
= FILE_SYSTEM_CASE (name
);
764 nm
= XSTRING (name
)->data
;
767 /* firstly, strip drive name. */
769 unsigned char *colon
= rindex (nm
, ':');
775 drive
= tolower (colon
[-1]) - 'a';
779 defdir
= alloca (MAXPATHLEN
+ 1);
780 relpath
= getdefdir (drive
+ 1, defdir
);
786 /* If nm is absolute, flush ...// and detect /./ and /../.
787 If no /./ or /../ we can return right away. */
795 /* If it turns out that the filename we want to return is just a
796 suffix of FILENAME, we don't need to go through and edit
797 things; we just need to construct a new string using data
798 starting at the middle of FILENAME. If we set lose to a
799 non-zero value, that means we've discovered that we can't do
806 /* Since we know the path is absolute, we can assume that each
807 element starts with a "/". */
809 /* "//" anywhere isn't necessarily hairy; we just start afresh
810 with the second slash. */
811 if (p
[0] == '/' && p
[1] == '/'
813 /* // at start of filename is meaningful on Apollo system */
819 /* "~" is hairy as the start of any path element. */
820 if (p
[0] == '/' && p
[1] == '~')
821 nm
= p
+ 1, lose
= 1;
823 /* "." and ".." are hairy. */
828 || (p
[2] == '.' && (p
[3] == '/'
835 /* if dev:[dir]/, move nm to / */
836 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
837 nm
= (brack
? brack
+ 1 : colon
+ 1);
846 /* VMS pre V4.4,convert '-'s in filenames. */
847 if (lbrack
== rbrack
)
849 if (dots
< 2) /* this is to allow negative version numbers */
854 if (lbrack
> rbrack
&&
855 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
856 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
862 /* count open brackets, reset close bracket pointer */
863 if (p
[0] == '[' || p
[0] == '<')
865 /* count close brackets, set close bracket pointer */
866 if (p
[0] == ']' || p
[0] == '>')
868 /* detect ][ or >< */
869 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
871 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
872 nm
= p
+ 1, lose
= 1;
873 if (p
[0] == ':' && (colon
|| slash
))
874 /* if dev1:[dir]dev2:, move nm to dev2: */
880 /* if /pathname/dev:, move nm to dev: */
883 /* if node::dev:, move colon following dev */
884 else if (colon
&& colon
[-1] == ':')
886 /* if dev1:dev2:, move nm to dev2: */
887 else if (colon
&& colon
[-1] != ':')
892 if (p
[0] == ':' && !colon
)
898 if (lbrack
== rbrack
)
901 else if (p
[0] == '.')
910 return build_string (sys_translate_unix (nm
));
913 if (nm
== XSTRING (name
)->data
)
915 return build_string (nm
);
920 /* Now determine directory to start with and put it in newdir */
924 if (nm
[0] == '~') /* prefix ~ */
930 || nm
[1] == 0) /* ~ by itself */
932 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
933 newdir
= (unsigned char *) "";
935 dostounix_filename (newdir
);
939 nm
++; /* Don't leave the slash in nm. */
942 else /* ~user/filename */
944 for (p
= nm
; *p
&& (*p
!= '/'
949 o
= (unsigned char *) alloca (p
- nm
+ 1);
950 bcopy ((char *) nm
, o
, p
- nm
);
953 pw
= (struct passwd
*) getpwnam (o
+ 1);
956 newdir
= (unsigned char *) pw
-> pw_dir
;
958 nm
= p
+ 1; /* skip the terminator */
964 /* If we don't find a user of that name, leave the name
965 unchanged; don't move nm forward to p. */
978 newdir
= XSTRING (defalt
)->data
;
982 if (newdir
== 0 && relpath
)
987 /* Get rid of any slash at the end of newdir. */
988 int length
= strlen (newdir
);
989 /* Adding `length > 1 &&' makes ~ expand into / when homedir
990 is the root dir. People disagree about whether that is right.
991 Anyway, we can't take the risk of this change now. */
993 if (newdir
[1] != ':' && length
> 1)
995 if (newdir
[length
- 1] == '/')
997 unsigned char *temp
= (unsigned char *) alloca (length
);
998 bcopy (newdir
, temp
, length
- 1);
999 temp
[length
- 1] = 0;
1007 /* Now concatenate the directory and name to new space in the stack frame */
1008 tlen
+= strlen (nm
) + 1;
1010 /* Add reserved space for drive name. */
1011 target
= (unsigned char *) alloca (tlen
+ 2) + 2;
1013 target
= (unsigned char *) alloca (tlen
);
1020 if (nm
[0] == 0 || nm
[0] == '/')
1021 strcpy (target
, newdir
);
1024 file_name_as_directory (target
, newdir
);
1027 strcat (target
, nm
);
1029 if (index (target
, '/'))
1030 strcpy (target
, sys_translate_unix (target
));
1033 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1041 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1047 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1048 /* brackets are offset from each other by 2 */
1051 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1052 /* convert [foo][bar] to [bar] */
1053 while (o
[-1] != '[' && o
[-1] != '<')
1055 else if (*p
== '-' && *o
!= '.')
1058 else if (p
[0] == '-' && o
[-1] == '.' &&
1059 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1060 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1064 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1065 if (p
[1] == '.') /* foo.-.bar ==> bar*/
1067 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1069 /* else [foo.-] ==> [-] */
1075 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1076 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1086 else if (!strncmp (p
, "//", 2)
1088 /* // at start of filename is meaningful in Apollo system */
1096 else if (p
[0] == '/'
1101 /* If "/." is the entire filename, keep the "/". Otherwise,
1102 just delete the whole "/.". */
1103 if (o
== target
&& p
[2] == '\0')
1107 else if (!strncmp (p
, "/..", 3)
1108 /* `/../' is the "superroot" on certain file systems. */
1110 && (p
[3] == '/' || p
[3] == 0))
1112 while (o
!= target
&& *--o
!= '/')
1115 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1119 if (o
== target
&& *o
== '/')
1127 #endif /* not VMS */
1131 /* at last, set drive name. */
1132 if (target
[1] != ':')
1135 target
[0] = (drive
< 0 ? getdisk () : drive
) + 'a';
1140 return make_string (target
, o
- target
);
1143 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'.
1144 DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
1145 "Convert FILENAME to absolute, and canonicalize it.\n\
1146 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1147 (does not start with slash); if DEFAULT is nil or missing,\n\
1148 the current buffer's value of default-directory is used.\n\
1149 Filenames containing `.' or `..' as components are simplified;\n\
1150 initial `~/' expands to your home directory.\n\
1151 See also the function `substitute-in-file-name'.")
1153 Lisp_Object name, defalt;
1157 register unsigned char *newdir, *p, *o;
1159 unsigned char *target;
1163 unsigned char * colon = 0;
1164 unsigned char * close = 0;
1165 unsigned char * slash = 0;
1166 unsigned char * brack = 0;
1167 int lbrack = 0, rbrack = 0;
1171 CHECK_STRING (name
, 0);
1174 /* Filenames on VMS are always upper case. */
1175 name
= Fupcase (name
);
1178 nm
= XSTRING (name
)->data
;
1180 /* If nm is absolute, flush ...// and detect /./ and /../.
1181 If no /./ or /../ we can return right away. */
1193 if (p
[0] == '/' && p
[1] == '/'
1195 /* // at start of filename is meaningful on Apollo system */
1200 if (p
[0] == '/' && p
[1] == '~')
1201 nm
= p
+ 1, lose
= 1;
1202 if (p
[0] == '/' && p
[1] == '.'
1203 && (p
[2] == '/' || p
[2] == 0
1204 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1210 /* if dev:[dir]/, move nm to / */
1211 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1212 nm
= (brack
? brack
+ 1 : colon
+ 1);
1213 lbrack
= rbrack
= 0;
1221 /* VMS pre V4.4,convert '-'s in filenames. */
1222 if (lbrack
== rbrack
)
1224 if (dots
< 2) /* this is to allow negative version numbers */
1229 if (lbrack
> rbrack
&&
1230 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1231 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1237 /* count open brackets, reset close bracket pointer */
1238 if (p
[0] == '[' || p
[0] == '<')
1239 lbrack
++, brack
= 0;
1240 /* count close brackets, set close bracket pointer */
1241 if (p
[0] == ']' || p
[0] == '>')
1242 rbrack
++, brack
= p
;
1243 /* detect ][ or >< */
1244 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1246 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1247 nm
= p
+ 1, lose
= 1;
1248 if (p
[0] == ':' && (colon
|| slash
))
1249 /* if dev1:[dir]dev2:, move nm to dev2: */
1255 /* if /pathname/dev:, move nm to dev: */
1258 /* if node::dev:, move colon following dev */
1259 else if (colon
&& colon
[-1] == ':')
1261 /* if dev1:dev2:, move nm to dev2: */
1262 else if (colon
&& colon
[-1] != ':')
1267 if (p
[0] == ':' && !colon
)
1273 if (lbrack
== rbrack
)
1276 else if (p
[0] == '.')
1284 if (index (nm
, '/'))
1285 return build_string (sys_translate_unix (nm
));
1287 if (nm
== XSTRING (name
)->data
)
1289 return build_string (nm
);
1293 /* Now determine directory to start with and put it in NEWDIR */
1297 if (nm
[0] == '~') /* prefix ~ */
1302 || nm
[1] == 0)/* ~/filename */
1304 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1305 newdir
= (unsigned char *) "";
1308 nm
++; /* Don't leave the slash in nm. */
1311 else /* ~user/filename */
1313 /* Get past ~ to user */
1314 unsigned char *user
= nm
+ 1;
1315 /* Find end of name. */
1316 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1317 int len
= ptr
? ptr
- user
: strlen (user
);
1319 unsigned char *ptr1
= index (user
, ':');
1320 if (ptr1
!= 0 && ptr1
- user
< len
)
1323 /* Copy the user name into temp storage. */
1324 o
= (unsigned char *) alloca (len
+ 1);
1325 bcopy ((char *) user
, o
, len
);
1328 /* Look up the user name. */
1329 pw
= (struct passwd
*) getpwnam (o
+ 1);
1331 error ("\"%s\" isn't a registered user", o
+ 1);
1333 newdir
= (unsigned char *) pw
->pw_dir
;
1335 /* Discard the user name from NM. */
1342 #endif /* not VMS */
1346 defalt
= current_buffer
->directory
;
1347 CHECK_STRING (defalt
, 1);
1348 newdir
= XSTRING (defalt
)->data
;
1351 /* Now concatenate the directory and name to new space in the stack frame */
1353 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1354 target
= (unsigned char *) alloca (tlen
);
1360 if (nm
[0] == 0 || nm
[0] == '/')
1361 strcpy (target
, newdir
);
1364 file_name_as_directory (target
, newdir
);
1367 strcat (target
, nm
);
1369 if (index (target
, '/'))
1370 strcpy (target
, sys_translate_unix (target
));
1373 /* Now canonicalize by removing /. and /foo/.. if they appear */
1381 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1387 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1388 /* brackets are offset from each other by 2 */
1391 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1392 /* convert [foo][bar] to [bar] */
1393 while (o
[-1] != '[' && o
[-1] != '<')
1395 else if (*p
== '-' && *o
!= '.')
1398 else if (p
[0] == '-' && o
[-1] == '.' &&
1399 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1400 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1404 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1405 if (p
[1] == '.') /* foo.-.bar ==> bar*/
1407 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1409 /* else [foo.-] ==> [-] */
1415 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1416 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1426 else if (!strncmp (p
, "//", 2)
1428 /* // at start of filename is meaningful in Apollo system */
1436 else if (p
[0] == '/' && p
[1] == '.' &&
1437 (p
[2] == '/' || p
[2] == 0))
1439 else if (!strncmp (p
, "/..", 3)
1440 /* `/../' is the "superroot" on certain file systems. */
1442 && (p
[3] == '/' || p
[3] == 0))
1444 while (o
!= target
&& *--o
!= '/')
1447 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1451 if (o
== target
&& *o
== '/')
1459 #endif /* not VMS */
1462 return make_string (target
, o
- target
);
1466 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1467 Ssubstitute_in_file_name
, 1, 1, 0,
1468 "Substitute environment variables referred to in FILENAME.\n\
1469 `$FOO' where FOO is an environment variable name means to substitute\n\
1470 the value of that variable. The variable name should be terminated\n\
1471 with a character not a letter, digit or underscore; otherwise, enclose\n\
1472 the entire variable name in braces.\n\
1473 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1474 On VMS, `$' substitution is not done; this function does little and only\n\
1475 duplicates what `expand-file-name' does.")
1481 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1482 unsigned char *target
;
1484 int substituted
= 0;
1487 CHECK_STRING (string
, 0);
1489 nm
= XSTRING (string
)->data
;
1490 endp
= nm
+ XSTRING (string
)->size
;
1492 /* If /~ or // appears, discard everything through first slash. */
1494 for (p
= nm
; p
!= endp
; p
++)
1498 /* // at start of file name is meaningful in Apollo system */
1499 (p
[0] == '/' && p
- 1 != nm
)
1500 #else /* not APOLLO */
1502 #endif /* not APOLLO */
1506 (p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>' ||
1517 if (p
[0] && p
[1] == ':')
1526 return build_string (nm
);
1529 /* See if any variables are substituted into the string
1530 and find the total length of their values in `total' */
1532 for (p
= nm
; p
!= endp
;)
1542 /* "$$" means a single "$" */
1551 while (p
!= endp
&& *p
!= '}') p
++;
1552 if (*p
!= '}') goto missingclose
;
1558 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1562 /* Copy out the variable name */
1563 target
= (unsigned char *) alloca (s
- o
+ 1);
1564 strncpy (target
, o
, s
- o
);
1567 strupr (target
); /* $home == $HOME etc. */
1570 /* Get variable value */
1571 o
= (unsigned char *) egetenv (target
);
1572 if (!o
) goto badvar
;
1573 total
+= strlen (o
);
1580 /* If substitution required, recopy the string and do it */
1581 /* Make space in stack frame for the new copy */
1582 xnm
= (unsigned char *) alloca (XSTRING (string
)->size
+ total
+ 1);
1585 /* Copy the rest of the name through, replacing $ constructs with values */
1602 while (p
!= endp
&& *p
!= '}') p
++;
1603 if (*p
!= '}') goto missingclose
;
1609 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1613 /* Copy out the variable name */
1614 target
= (unsigned char *) alloca (s
- o
+ 1);
1615 strncpy (target
, o
, s
- o
);
1618 strupr (target
); /* $home == $HOME etc. */
1621 /* Get variable value */
1622 o
= (unsigned char *) egetenv (target
);
1632 /* If /~ or // appears, discard everything through first slash. */
1634 for (p
= xnm
; p
!= x
; p
++)
1637 /* // at start of file name is meaningful in Apollo system */
1638 (p
[0] == '/' && p
- 1 != xnm
)
1639 #else /* not APOLLO */
1641 #endif /* not APOLLO */
1643 && p
!= nm
&& p
[-1] == '/')
1646 else if (p
[0] && p
[1] == ':')
1650 return make_string (xnm
, x
- xnm
);
1653 error ("Bad format environment-variable substitution");
1655 error ("Missing \"}\" in environment-variable substitution");
1657 error ("Substituting nonexistent environment variable \"%s\"", target
);
1660 #endif /* not VMS */
1663 /* A slightly faster and more convenient way to get
1664 (directory-file-name (expand-file-name FOO)). */
1667 expand_and_dir_to_file (filename
, defdir
)
1668 Lisp_Object filename
, defdir
;
1670 register Lisp_Object abspath
;
1672 abspath
= Fexpand_file_name (filename
, defdir
);
1675 register int c
= XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1];
1676 if (c
== ':' || c
== ']' || c
== '>')
1677 abspath
= Fdirectory_file_name (abspath
);
1680 /* Remove final slash, if any (unless path is root).
1681 stat behaves differently depending! */
1682 if (XSTRING (abspath
)->size
> 1
1683 && XSTRING (abspath
)->data
[XSTRING (abspath
)->size
- 1] == '/')
1684 /* We cannot take shortcuts; they might be wrong for magic file names. */
1685 abspath
= Fdirectory_file_name (abspath
);
1690 barf_or_query_if_file_exists (absname
, querystring
, interactive
)
1691 Lisp_Object absname
;
1692 unsigned char *querystring
;
1695 register Lisp_Object tem
;
1696 struct gcpro gcpro1
;
1698 if (access (XSTRING (absname
)->data
, 4) >= 0)
1701 Fsignal (Qfile_already_exists
,
1702 Fcons (build_string ("File already exists"),
1703 Fcons (absname
, Qnil
)));
1705 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1706 XSTRING (absname
)->data
, querystring
));
1709 Fsignal (Qfile_already_exists
,
1710 Fcons (build_string ("File already exists"),
1711 Fcons (absname
, Qnil
)));
1716 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
1717 "fCopy file: \nFCopy %s to file: \np\nP",
1718 "Copy FILE to NEWNAME. Both args must be strings.\n\
1719 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
1720 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
1721 A number as third arg means request confirmation if NEWNAME already exists.\n\
1722 This is what happens in interactive use with M-x.\n\
1723 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
1724 last-modified time as the old one. (This works on only some systems.)\n\
1725 A prefix arg makes KEEP-TIME non-nil.")
1726 (filename
, newname
, ok_if_already_exists
, keep_date
)
1727 Lisp_Object filename
, newname
, ok_if_already_exists
, keep_date
;
1730 char buf
[16 * 1024];
1732 Lisp_Object handler
;
1733 struct gcpro gcpro1
, gcpro2
;
1734 int count
= specpdl_ptr
- specpdl
;
1735 Lisp_Object args
[6];
1736 int input_file_statable_p
;
1738 GCPRO2 (filename
, newname
);
1739 CHECK_STRING (filename
, 0);
1740 CHECK_STRING (newname
, 1);
1741 filename
= Fexpand_file_name (filename
, Qnil
);
1742 newname
= Fexpand_file_name (newname
, Qnil
);
1744 /* If the input file name has special constructs in it,
1745 call the corresponding file handler. */
1746 handler
= Ffind_file_name_handler (filename
, Qcopy_file
);
1747 /* Likewise for output file name. */
1749 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
1750 if (!NILP (handler
))
1751 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, filename
, newname
,
1752 ok_if_already_exists
, keep_date
));
1754 if (NILP (ok_if_already_exists
)
1755 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1756 barf_or_query_if_file_exists (newname
, "copy to it",
1757 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1759 ifd
= open (XSTRING (filename
)->data
, 0);
1761 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
1763 record_unwind_protect (close_file_unwind
, make_number (ifd
));
1765 /* We can only copy regular files and symbolic links. Other files are not
1767 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
1769 #if defined (S_ISREG) && defined (S_ISLNK)
1770 if (input_file_statable_p
)
1772 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
1774 #if defined (EISDIR)
1775 /* Get a better looking error message. */
1778 report_file_error ("Non-regular file", Fcons (filename
, Qnil
));
1781 #endif /* S_ISREG && S_ISLNK */
1784 /* Create the copy file with the same record format as the input file */
1785 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
1788 /* System's default file type was set to binary by _fmode in emacs.c. */
1789 ofd
= creat (XSTRING (newname
)->data
, S_IREAD
| S_IWRITE
);
1790 #else /* not MSDOS */
1791 ofd
= creat (XSTRING (newname
)->data
, 0666);
1792 #endif /* not MSDOS */
1795 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
1797 record_unwind_protect (close_file_unwind
, make_number (ofd
));
1801 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
1802 if (write (ofd
, buf
, n
) != n
)
1803 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1806 if (input_file_statable_p
)
1808 if (!NILP (keep_date
))
1810 EMACS_TIME atime
, mtime
;
1811 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1812 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1813 EMACS_SET_UTIMES (XSTRING (newname
)->data
, atime
, mtime
);
1816 if (!egetenv ("USE_DOMAIN_ACLS"))
1818 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1821 /* Discard the unwind protects. */
1822 specpdl_ptr
= specpdl
+ count
;
1825 if (close (ofd
) < 0)
1826 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1832 DEFUN ("make-directory-internal", Fmake_directory_internal
,
1833 Smake_directory_internal
, 1, 1, 0,
1834 "Create a directory. One argument, a file name string.")
1836 Lisp_Object dirname
;
1839 Lisp_Object handler
;
1841 CHECK_STRING (dirname
, 0);
1842 dirname
= Fexpand_file_name (dirname
, Qnil
);
1844 handler
= Ffind_file_name_handler (dirname
, Qmake_directory
);
1845 if (!NILP (handler
))
1846 return call3 (handler
, Qmake_directory
, dirname
, Qnil
);
1848 dir
= XSTRING (dirname
)->data
;
1850 if (mkdir (dir
, 0777) != 0)
1851 report_file_error ("Creating directory", Flist (1, &dirname
));
1856 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
1857 "Delete a directory. One argument, a file name string.")
1859 Lisp_Object dirname
;
1862 Lisp_Object handler
;
1864 CHECK_STRING (dirname
, 0);
1865 dirname
= Fexpand_file_name (dirname
, Qnil
);
1866 dir
= XSTRING (dirname
)->data
;
1868 handler
= Ffind_file_name_handler (dirname
, Qdelete_directory
);
1869 if (!NILP (handler
))
1870 return call2 (handler
, Qdelete_directory
, dirname
);
1872 if (rmdir (dir
) != 0)
1873 report_file_error ("Removing directory", Flist (1, &dirname
));
1878 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
1879 "Delete specified file. One argument, a file name string.\n\
1880 If file has multiple names, it continues to exist with the other names.")
1882 Lisp_Object filename
;
1884 Lisp_Object handler
;
1885 CHECK_STRING (filename
, 0);
1886 filename
= Fexpand_file_name (filename
, Qnil
);
1888 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
1889 if (!NILP (handler
))
1890 return call2 (handler
, Qdelete_file
, filename
);
1892 if (0 > unlink (XSTRING (filename
)->data
))
1893 report_file_error ("Removing old name", Flist (1, &filename
));
1897 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
1898 "fRename file: \nFRename %s to file: \np",
1899 "Rename FILE as NEWNAME. Both args strings.\n\
1900 If file has names other than FILE, it continues to have those names.\n\
1901 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1902 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1903 A number as third arg means request confirmation if NEWNAME already exists.\n\
1904 This is what happens in interactive use with M-x.")
1905 (filename
, newname
, ok_if_already_exists
)
1906 Lisp_Object filename
, newname
, ok_if_already_exists
;
1909 Lisp_Object args
[2];
1911 Lisp_Object handler
;
1912 struct gcpro gcpro1
, gcpro2
;
1914 GCPRO2 (filename
, newname
);
1915 CHECK_STRING (filename
, 0);
1916 CHECK_STRING (newname
, 1);
1917 filename
= Fexpand_file_name (filename
, Qnil
);
1918 newname
= Fexpand_file_name (newname
, Qnil
);
1920 /* If the file name has special constructs in it,
1921 call the corresponding file handler. */
1922 handler
= Ffind_file_name_handler (filename
, Qrename_file
);
1924 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
1925 if (!NILP (handler
))
1926 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
1927 filename
, newname
, ok_if_already_exists
));
1929 if (NILP (ok_if_already_exists
)
1930 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1931 barf_or_query_if_file_exists (newname
, "rename to it",
1932 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1934 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1936 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
1937 || 0 > unlink (XSTRING (filename
)->data
))
1942 Fcopy_file (filename
, newname
,
1943 /* We have already prompted if it was an integer,
1944 so don't have copy-file prompt again. */
1945 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
1946 Fdelete_file (filename
);
1953 report_file_error ("Renaming", Flist (2, args
));
1956 report_file_error ("Renaming", Flist (2, &filename
));
1963 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
1964 "fAdd name to file: \nFName to add to %s: \np",
1965 "Give FILE additional name NEWNAME. Both args strings.\n\
1966 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1967 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1968 A number as third arg means request confirmation if NEWNAME already exists.\n\
1969 This is what happens in interactive use with M-x.")
1970 (filename
, newname
, ok_if_already_exists
)
1971 Lisp_Object filename
, newname
, ok_if_already_exists
;
1974 Lisp_Object args
[2];
1976 Lisp_Object handler
;
1977 struct gcpro gcpro1
, gcpro2
;
1979 GCPRO2 (filename
, newname
);
1980 CHECK_STRING (filename
, 0);
1981 CHECK_STRING (newname
, 1);
1982 filename
= Fexpand_file_name (filename
, Qnil
);
1983 newname
= Fexpand_file_name (newname
, Qnil
);
1985 /* If the file name has special constructs in it,
1986 call the corresponding file handler. */
1987 handler
= Ffind_file_name_handler (filename
, Qadd_name_to_file
);
1988 if (!NILP (handler
))
1989 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, filename
,
1990 newname
, ok_if_already_exists
));
1992 if (NILP (ok_if_already_exists
)
1993 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1994 barf_or_query_if_file_exists (newname
, "make it a new name",
1995 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1996 unlink (XSTRING (newname
)->data
);
1997 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2002 report_file_error ("Adding new name", Flist (2, args
));
2004 report_file_error ("Adding new name", Flist (2, &filename
));
2013 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2014 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2015 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2016 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2017 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2018 A number as third arg means request confirmation if NEWNAME already exists.\n\
2019 This happens for interactive use with M-x.")
2020 (filename
, linkname
, ok_if_already_exists
)
2021 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2024 Lisp_Object args
[2];
2026 Lisp_Object handler
;
2027 struct gcpro gcpro1
, gcpro2
;
2029 GCPRO2 (filename
, linkname
);
2030 CHECK_STRING (filename
, 0);
2031 CHECK_STRING (linkname
, 1);
2032 /* If the link target has a ~, we must expand it to get
2033 a truly valid file name. Otherwise, do not expand;
2034 we want to permit links to relative file names. */
2035 if (XSTRING (filename
)->data
[0] == '~')
2036 filename
= Fexpand_file_name (filename
, Qnil
);
2037 linkname
= Fexpand_file_name (linkname
, Qnil
);
2039 /* If the file name has special constructs in it,
2040 call the corresponding file handler. */
2041 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2042 if (!NILP (handler
))
2043 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2044 linkname
, ok_if_already_exists
));
2046 if (NILP (ok_if_already_exists
)
2047 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
2048 barf_or_query_if_file_exists (linkname
, "make it a link",
2049 XTYPE (ok_if_already_exists
) == Lisp_Int
);
2050 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2052 /* If we didn't complain already, silently delete existing file. */
2053 if (errno
== EEXIST
)
2055 unlink (XSTRING (linkname
)->data
);
2056 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2063 report_file_error ("Making symbolic link", Flist (2, args
));
2065 report_file_error ("Making symbolic link", Flist (2, &filename
));
2071 #endif /* S_IFLNK */
2075 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2076 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2077 "Define the job-wide logical name NAME to have the value STRING.\n\
2078 If STRING is nil or a null string, the logical name NAME is deleted.")
2080 Lisp_Object varname
;
2083 CHECK_STRING (varname
, 0);
2085 delete_logical_name (XSTRING (varname
)->data
);
2088 CHECK_STRING (string
, 1);
2090 if (XSTRING (string
)->size
== 0)
2091 delete_logical_name (XSTRING (varname
)->data
);
2093 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
2102 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2103 "Open a network connection to PATH using LOGIN as the login string.")
2105 Lisp_Object path
, login
;
2109 CHECK_STRING (path
, 0);
2110 CHECK_STRING (login
, 0);
2112 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2114 if (netresult
== -1)
2119 #endif /* HPUX_NET */
2121 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2123 "Return t if file FILENAME specifies an absolute path name.\n\
2124 On Unix, this is a name starting with a `/' or a `~'.")
2126 Lisp_Object filename
;
2130 CHECK_STRING (filename
, 0);
2131 ptr
= XSTRING (filename
)->data
;
2132 if (*ptr
== '/' || *ptr
== '~'
2134 /* ??? This criterion is probably wrong for '<'. */
2135 || index (ptr
, ':') || index (ptr
, '<')
2136 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2140 || (*ptr
!= 0 && ptr
[1] == ':' && ptr
[2] == '/')
2148 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2149 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2150 See also `file-readable-p' and `file-attributes'.")
2152 Lisp_Object filename
;
2154 Lisp_Object abspath
;
2155 Lisp_Object handler
;
2157 CHECK_STRING (filename
, 0);
2158 abspath
= Fexpand_file_name (filename
, Qnil
);
2160 /* If the file name has special constructs in it,
2161 call the corresponding file handler. */
2162 handler
= Ffind_file_name_handler (abspath
, Qfile_exists_p
);
2163 if (!NILP (handler
))
2164 return call2 (handler
, Qfile_exists_p
, abspath
);
2166 return (access (XSTRING (abspath
)->data
, 0) >= 0) ? Qt
: Qnil
;
2169 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2170 "Return t if FILENAME can be executed by you.\n\
2171 For a directory, this means you can access files in that directory.")
2173 Lisp_Object filename
;
2176 Lisp_Object abspath
;
2177 Lisp_Object handler
;
2179 CHECK_STRING (filename
, 0);
2180 abspath
= Fexpand_file_name (filename
, Qnil
);
2182 /* If the file name has special constructs in it,
2183 call the corresponding file handler. */
2184 handler
= Ffind_file_name_handler (abspath
, Qfile_executable_p
);
2185 if (!NILP (handler
))
2186 return call2 (handler
, Qfile_executable_p
, abspath
);
2188 return (access (XSTRING (abspath
)->data
, 1) >= 0) ? Qt
: Qnil
;
2191 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2192 "Return t if file FILENAME exists and you can read it.\n\
2193 See also `file-exists-p' and `file-attributes'.")
2195 Lisp_Object filename
;
2197 Lisp_Object abspath
;
2198 Lisp_Object handler
;
2200 CHECK_STRING (filename
, 0);
2201 abspath
= Fexpand_file_name (filename
, Qnil
);
2203 /* If the file name has special constructs in it,
2204 call the corresponding file handler. */
2205 handler
= Ffind_file_name_handler (abspath
, Qfile_readable_p
);
2206 if (!NILP (handler
))
2207 return call2 (handler
, Qfile_readable_p
, abspath
);
2209 return (access (XSTRING (abspath
)->data
, 4) >= 0) ? Qt
: Qnil
;
2212 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2213 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2214 The value is the name of the file to which it is linked.\n\
2215 Otherwise returns nil.")
2217 Lisp_Object filename
;
2224 Lisp_Object handler
;
2226 CHECK_STRING (filename
, 0);
2227 filename
= Fexpand_file_name (filename
, Qnil
);
2229 /* If the file name has special constructs in it,
2230 call the corresponding file handler. */
2231 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2232 if (!NILP (handler
))
2233 return call2 (handler
, Qfile_symlink_p
, filename
);
2238 buf
= (char *) xmalloc (bufsize
);
2239 bzero (buf
, bufsize
);
2240 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2241 if (valsize
< bufsize
) break;
2242 /* Buffer was not long enough */
2251 val
= make_string (buf
, valsize
);
2254 #else /* not S_IFLNK */
2256 #endif /* not S_IFLNK */
2259 #ifdef SOLARIS_BROKEN_ACCESS
2260 /* In Solaris 2.1, the readonly-ness of the filesystem is not
2261 considered by the access system call. This is Sun's bug, but we
2262 still have to make Emacs work. */
2264 #include <sys/statvfs.h>
2270 struct statvfs statvfsb
;
2272 if (statvfs(path
, &statvfsb
))
2273 return 1; /* error from statvfs, be conservative and say not wrtable */
2275 /* Otherwise, fsys is ro if bit is set. */
2276 return statvfsb
.f_flag
& ST_RDONLY
;
2279 /* But on every other os, access has already done the right thing. */
2280 #define ro_fsys(path) 0
2283 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2285 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2286 "Return t if file FILENAME can be written or created by you.")
2288 Lisp_Object filename
;
2290 Lisp_Object abspath
, dir
;
2291 Lisp_Object handler
;
2293 CHECK_STRING (filename
, 0);
2294 abspath
= Fexpand_file_name (filename
, Qnil
);
2296 /* If the file name has special constructs in it,
2297 call the corresponding file handler. */
2298 handler
= Ffind_file_name_handler (abspath
, Qfile_writable_p
);
2299 if (!NILP (handler
))
2300 return call2 (handler
, Qfile_writable_p
, abspath
);
2302 if (access (XSTRING (abspath
)->data
, 0) >= 0)
2303 return ((access (XSTRING (abspath
)->data
, 2) >= 0
2304 && ! ro_fsys ((char *) XSTRING (abspath
)->data
))
2306 dir
= Ffile_name_directory (abspath
);
2309 dir
= Fdirectory_file_name (dir
);
2313 dir
= Fdirectory_file_name (dir
);
2315 return ((access (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "", 2) >= 0
2316 && ! ro_fsys ((char *) XSTRING (dir
)->data
))
2320 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2321 "Return t if file FILENAME is the name of a directory as a file.\n\
2322 A directory name spec may be given instead; then the value is t\n\
2323 if the directory so specified exists and really is a directory.")
2325 Lisp_Object filename
;
2327 register Lisp_Object abspath
;
2329 Lisp_Object handler
;
2331 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2333 /* If the file name has special constructs in it,
2334 call the corresponding file handler. */
2335 handler
= Ffind_file_name_handler (abspath
, Qfile_directory_p
);
2336 if (!NILP (handler
))
2337 return call2 (handler
, Qfile_directory_p
, abspath
);
2339 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2341 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2344 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2345 "Return t if file FILENAME is the name of a directory as a file,\n\
2346 and files in that directory can be opened by you. In order to use a\n\
2347 directory as a buffer's current directory, this predicate must return true.\n\
2348 A directory name spec may be given instead; then the value is t\n\
2349 if the directory so specified exists and really is a readable and\n\
2350 searchable directory.")
2352 Lisp_Object filename
;
2354 Lisp_Object handler
;
2356 /* If the file name has special constructs in it,
2357 call the corresponding file handler. */
2358 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2359 if (!NILP (handler
))
2360 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2362 if (NILP (Ffile_directory_p (filename
))
2363 || NILP (Ffile_executable_p (filename
)))
2369 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2370 "Return mode bits of FILE, as an integer.")
2372 Lisp_Object filename
;
2374 Lisp_Object abspath
;
2376 Lisp_Object handler
;
2378 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2380 /* If the file name has special constructs in it,
2381 call the corresponding file handler. */
2382 handler
= Ffind_file_name_handler (abspath
, Qfile_modes
);
2383 if (!NILP (handler
))
2384 return call2 (handler
, Qfile_modes
, abspath
);
2386 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2392 if (S_ISREG (st
.st_mode
)
2393 && (len
= XSTRING (abspath
)->size
) >= 5
2394 && (stricmp ((suffix
= XSTRING (abspath
)->data
+ len
-4), ".com") == 0
2395 || stricmp (suffix
, ".exe") == 0
2396 || stricmp (suffix
, ".bat") == 0))
2397 st
.st_mode
|= S_IEXEC
;
2401 return make_number (st
.st_mode
& 07777);
2404 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2405 "Set mode bits of FILE to MODE (an integer).\n\
2406 Only the 12 low bits of MODE are used.")
2408 Lisp_Object filename
, mode
;
2410 Lisp_Object abspath
;
2411 Lisp_Object handler
;
2413 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2414 CHECK_NUMBER (mode
, 1);
2416 /* If the file name has special constructs in it,
2417 call the corresponding file handler. */
2418 handler
= Ffind_file_name_handler (abspath
, Qset_file_modes
);
2419 if (!NILP (handler
))
2420 return call3 (handler
, Qset_file_modes
, abspath
, mode
);
2423 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2424 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2426 if (!egetenv ("USE_DOMAIN_ACLS"))
2429 struct timeval tvp
[2];
2431 /* chmod on apollo also change the file's modtime; need to save the
2432 modtime and then restore it. */
2433 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2435 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2439 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2440 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2442 /* reset the old accessed and modified times. */
2443 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
2445 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
2448 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
2449 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
2456 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2457 "Set the file permission bits for newly created files.\n\
2458 The argument MODE should be an integer; only the low 9 bits are used.\n\
2459 This setting is inherited by subprocesses.")
2463 CHECK_NUMBER (mode
, 0);
2465 umask ((~ XINT (mode
)) & 0777);
2470 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2471 "Return the default file protection for created files.\n\
2472 The value is an integer.")
2478 realmask
= umask (0);
2481 XSET (value
, Lisp_Int
, (~ realmask
) & 0777);
2487 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2488 "Tell Unix to finish all pending disk updates.")
2497 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2498 "Return t if file FILE1 is newer than file FILE2.\n\
2499 If FILE1 does not exist, the answer is nil;\n\
2500 otherwise, if FILE2 does not exist, the answer is t.")
2502 Lisp_Object file1
, file2
;
2504 Lisp_Object abspath1
, abspath2
;
2507 Lisp_Object handler
;
2508 struct gcpro gcpro1
, gcpro2
;
2510 CHECK_STRING (file1
, 0);
2511 CHECK_STRING (file2
, 0);
2514 GCPRO2 (abspath1
, file2
);
2515 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2516 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2519 /* If the file name has special constructs in it,
2520 call the corresponding file handler. */
2521 handler
= Ffind_file_name_handler (abspath1
, Qfile_newer_than_file_p
);
2523 handler
= Ffind_file_name_handler (abspath2
, Qfile_newer_than_file_p
);
2524 if (!NILP (handler
))
2525 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2527 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2530 mtime1
= st
.st_mtime
;
2532 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2535 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2539 Lisp_Object Qfind_buffer_file_type
;
2542 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2544 "Insert contents of file FILENAME after point.\n\
2545 Returns list of absolute file name and length of data inserted.\n\
2546 If second argument VISIT is non-nil, the buffer's visited filename\n\
2547 and last save file modtime are set, and it is marked unmodified.\n\
2548 If visiting and the file does not exist, visiting is completed\n\
2549 before the error is signaled.\n\n\
2550 The optional third and fourth arguments BEG and END\n\
2551 specify what portion of the file to insert.\n\
2552 If VISIT is non-nil, BEG and END must be nil.\n\
2553 If optional fifth argument REPLACE is non-nil,\n\
2554 it means replace the current buffer contents (in the accessible portion)\n\
2555 with the file contents. This is better than simply deleting and inserting\n\
2556 the whole thing because (1) it preserves some marker positions\n\
2557 and (2) it puts less data in the undo list.")
2558 (filename
, visit
, beg
, end
, replace
)
2559 Lisp_Object filename
, visit
, beg
, end
, replace
;
2563 register int inserted
= 0;
2564 register int how_much
;
2565 int count
= specpdl_ptr
- specpdl
;
2566 struct gcpro gcpro1
, gcpro2
;
2567 Lisp_Object handler
, val
, insval
;
2574 GCPRO2 (filename
, p
);
2575 if (!NILP (current_buffer
->read_only
))
2576 Fbarf_if_buffer_read_only();
2578 CHECK_STRING (filename
, 0);
2579 filename
= Fexpand_file_name (filename
, Qnil
);
2581 /* If the file name has special constructs in it,
2582 call the corresponding file handler. */
2583 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
2584 if (!NILP (handler
))
2586 val
= call6 (handler
, Qinsert_file_contents
, filename
,
2587 visit
, beg
, end
, replace
);
2594 if (stat (XSTRING (filename
)->data
, &st
) < 0
2595 || (fd
= open (XSTRING (filename
)->data
, 0)) < 0)
2597 if ((fd
= open (XSTRING (filename
)->data
, 0)) < 0
2598 || fstat (fd
, &st
) < 0)
2599 #endif /* not APOLLO */
2601 if (fd
>= 0) close (fd
);
2603 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2609 /* Replacement should preserve point as it preserves markers. */
2610 if (!NILP (replace
))
2611 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
2613 record_unwind_protect (close_file_unwind
, make_number (fd
));
2616 /* This code will need to be changed in order to work on named
2617 pipes, and it's probably just not worth it. So we should at
2618 least signal an error. */
2619 if ((st
.st_mode
& S_IFMT
) == S_IFSOCK
)
2620 Fsignal (Qfile_error
,
2621 Fcons (build_string ("reading from named pipe"),
2622 Fcons (filename
, Qnil
)));
2625 /* Supposedly happens on VMS. */
2627 error ("File size is negative");
2629 if (!NILP (beg
) || !NILP (end
))
2631 error ("Attempt to visit less than an entire file");
2634 CHECK_NUMBER (beg
, 0);
2639 CHECK_NUMBER (end
, 0);
2642 XSETINT (end
, st
.st_size
);
2643 if (XINT (end
) != st
.st_size
)
2644 error ("maximum buffer size exceeded");
2647 /* If requested, replace the accessible part of the buffer
2648 with the file contents. Avoid replacing text at the
2649 beginning or end of the buffer that matches the file contents;
2650 that preserves markers pointing to the unchanged parts. */
2652 /* On MSDOS, replace mode doesn't really work, except for binary files,
2653 and it's not worth supporting just for them. */
2654 if (!NILP (replace
))
2658 XFASTINT (end
) = st
.st_size
;
2659 del_range_1 (BEGV
, ZV
, 0);
2662 if (!NILP (replace
))
2664 char buffer
[1 << 14];
2665 int same_at_start
= BEGV
;
2666 int same_at_end
= ZV
;
2671 /* Count how many chars at the start of the file
2672 match the text at the beginning of the buffer. */
2677 nread
= read (fd
, buffer
, sizeof buffer
);
2679 error ("IO error reading %s: %s",
2680 XSTRING (filename
)->data
, strerror (errno
));
2681 else if (nread
== 0)
2684 while (bufpos
< nread
&& same_at_start
< ZV
2685 && FETCH_CHAR (same_at_start
) == buffer
[bufpos
])
2686 same_at_start
++, bufpos
++;
2687 /* If we found a discrepancy, stop the scan.
2688 Otherwise loop around and scan the next bufferfull. */
2689 if (bufpos
!= nread
)
2693 /* If the file matches the buffer completely,
2694 there's no need to replace anything. */
2695 if (same_at_start
== st
.st_size
)
2703 /* Count how many chars at the end of the file
2704 match the text at the end of the buffer. */
2707 int total_read
, nread
, bufpos
, curpos
, trial
;
2709 /* At what file position are we now scanning? */
2710 curpos
= st
.st_size
- (ZV
- same_at_end
);
2711 /* How much can we scan in the next step? */
2712 trial
= min (curpos
, sizeof buffer
);
2713 if (lseek (fd
, curpos
- trial
, 0) < 0)
2714 report_file_error ("Setting file position",
2715 Fcons (filename
, Qnil
));
2718 while (total_read
< trial
)
2720 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
2722 error ("IO error reading %s: %s",
2723 XSTRING (filename
)->data
, strerror (errno
));
2724 total_read
+= nread
;
2726 /* Scan this bufferfull from the end, comparing with
2727 the Emacs buffer. */
2728 bufpos
= total_read
;
2729 /* Compare with same_at_start to avoid counting some buffer text
2730 as matching both at the file's beginning and at the end. */
2731 while (bufpos
> 0 && same_at_end
> same_at_start
2732 && FETCH_CHAR (same_at_end
- 1) == buffer
[bufpos
- 1])
2733 same_at_end
--, bufpos
--;
2734 /* If we found a discrepancy, stop the scan.
2735 Otherwise loop around and scan the preceding bufferfull. */
2741 /* Don't try to reuse the same piece of text twice. */
2742 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
2744 same_at_end
+= overlap
;
2746 /* Arrange to read only the nonmatching middle part of the file. */
2747 XFASTINT (beg
) = same_at_start
- BEGV
;
2748 XFASTINT (end
) = st
.st_size
- (ZV
- same_at_end
);
2750 del_range_1 (same_at_start
, same_at_end
, 0);
2751 /* Insert from the file at the proper position. */
2752 SET_PT (same_at_start
);
2756 total
= XINT (end
) - XINT (beg
);
2759 register Lisp_Object temp
;
2761 /* Make sure point-max won't overflow after this insertion. */
2762 XSET (temp
, Lisp_Int
, total
);
2763 if (total
!= XINT (temp
))
2764 error ("maximum buffer size exceeded");
2767 if (NILP (visit
) && total
> 0)
2768 prepare_to_modify_buffer (point
, point
);
2771 if (GAP_SIZE
< total
)
2772 make_gap (total
- GAP_SIZE
);
2774 if (XINT (beg
) != 0 || !NILP (replace
))
2776 if (lseek (fd
, XINT (beg
), 0) < 0)
2777 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
2781 while (inserted
< total
)
2783 int try = min (total
- inserted
, 64 << 10);
2786 /* Allow quitting out of the actual I/O. */
2789 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, try);
2806 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
2807 /* Determine file type from name and remove LFs from CR-LFs if the file
2808 is deemed to be a text file. */
2810 struct gcpro gcpro1
;
2814 current_buffer
->buffer_file_type
2815 = call1 (Qfind_buffer_file_type
, filename
);
2817 if (NILP (current_buffer
->buffer_file_type
))
2820 = inserted
- crlf_to_lf (inserted
, &FETCH_CHAR (point
- 1) + 1);
2823 GPT
-= reduced_size
;
2824 GAP_SIZE
+= reduced_size
;
2825 inserted
-= reduced_size
;
2832 record_insert (point
, inserted
);
2834 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
2835 offset_intervals (current_buffer
, point
, inserted
);
2841 /* Discard the unwind protect for closing the file. */
2845 error ("IO error reading %s: %s",
2846 XSTRING (filename
)->data
, strerror (errno
));
2853 if (!EQ (current_buffer
->undo_list
, Qt
))
2854 current_buffer
->undo_list
= Qnil
;
2856 stat (XSTRING (filename
)->data
, &st
);
2861 current_buffer
->modtime
= st
.st_mtime
;
2862 current_buffer
->filename
= filename
;
2865 current_buffer
->save_modified
= MODIFF
;
2866 current_buffer
->auto_save_modified
= MODIFF
;
2867 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2868 #ifdef CLASH_DETECTION
2871 if (!NILP (current_buffer
->filename
))
2872 unlock_file (current_buffer
->filename
);
2873 unlock_file (filename
);
2875 #endif /* CLASH_DETECTION */
2876 /* If visiting nonexistent file, return nil. */
2877 if (current_buffer
->modtime
== -1)
2878 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2881 if (inserted
> 0 && NILP (visit
) && total
> 0)
2882 signal_after_change (point
, 0, inserted
);
2886 p
= Vafter_insert_file_functions
;
2889 insval
= call1 (Fcar (p
), make_number (inserted
));
2892 CHECK_NUMBER (insval
, 0);
2893 inserted
= XFASTINT (insval
);
2901 val
= Fcons (filename
,
2902 Fcons (make_number (inserted
),
2905 RETURN_UNGCPRO (unbind_to (count
, val
));
2908 static Lisp_Object
build_annotations ();
2910 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
2911 "r\nFWrite region to file: ",
2912 "Write current region into specified file.\n\
2913 When called from a program, takes three arguments:\n\
2914 START, END and FILENAME. START and END are buffer positions.\n\
2915 Optional fourth argument APPEND if non-nil means\n\
2916 append to existing file contents (if any).\n\
2917 Optional fifth argument VISIT if t means\n\
2918 set the last-save-file-modtime of buffer to this file's modtime\n\
2919 and mark buffer not modified.\n\
2920 If VISIT is a string, it is a second file name;\n\
2921 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
2922 VISIT is also the file name to lock and unlock for clash detection.\n\
2923 If VISIT is neither t nor nil nor a string,\n\
2924 that means do not print the \"Wrote file\" message.\n\
2925 Kludgy feature: if START is a string, then that string is written\n\
2926 to the file, instead of any buffer contents, and END is ignored.")
2927 (start
, end
, filename
, append
, visit
)
2928 Lisp_Object start
, end
, filename
, append
, visit
;
2936 int count
= specpdl_ptr
- specpdl
;
2938 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
2940 Lisp_Object handler
;
2941 Lisp_Object visit_file
;
2942 Lisp_Object annotations
;
2943 int visiting
, quietly
;
2944 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2946 int buffer_file_type
2947 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
2950 if (!NILP (start
) && !STRINGP (start
))
2951 validate_region (&start
, &end
);
2953 filename
= Fexpand_file_name (filename
, Qnil
);
2954 if (STRINGP (visit
))
2955 visit_file
= Fexpand_file_name (visit
, Qnil
);
2957 visit_file
= filename
;
2959 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
2960 quietly
= !NILP (visit
);
2964 GCPRO4 (start
, filename
, annotations
, visit_file
);
2966 /* If the file name has special constructs in it,
2967 call the corresponding file handler. */
2968 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
2969 /* If FILENAME has no handler, see if VISIT has one. */
2970 if (NILP (handler
) && XTYPE (visit
) == Lisp_String
)
2971 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
2973 if (!NILP (handler
))
2976 val
= call6 (handler
, Qwrite_region
, start
, end
,
2977 filename
, append
, visit
);
2981 current_buffer
->save_modified
= MODIFF
;
2982 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2983 current_buffer
->filename
= visit_file
;
2989 /* Special kludge to simplify auto-saving. */
2992 XFASTINT (start
) = BEG
;
2996 annotations
= build_annotations (start
, end
);
2998 #ifdef CLASH_DETECTION
3000 lock_file (visit_file
);
3001 #endif /* CLASH_DETECTION */
3003 fn
= XSTRING (filename
)->data
;
3007 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
3009 desc
= open (fn
, O_WRONLY
);
3014 if (auto_saving
) /* Overwrite any previous version of autosave file */
3016 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3017 desc
= open (fn
, O_RDWR
);
3019 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3020 ? XSTRING (current_buffer
->filename
)->data
: 0,
3023 else /* Write to temporary name and rename if no errors */
3025 Lisp_Object temp_name
;
3026 temp_name
= Ffile_name_directory (filename
);
3028 if (!NILP (temp_name
))
3030 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3031 build_string ("$$SAVE$$")));
3032 fname
= XSTRING (filename
)->data
;
3033 fn
= XSTRING (temp_name
)->data
;
3034 desc
= creat_copy_attrs (fname
, fn
);
3037 /* If we can't open the temporary file, try creating a new
3038 version of the original file. VMS "creat" creates a
3039 new version rather than truncating an existing file. */
3042 desc
= creat (fn
, 0666);
3043 #if 0 /* This can clobber an existing file and fail to replace it,
3044 if the user runs out of space. */
3047 /* We can't make a new version;
3048 try to truncate and rewrite existing version if any. */
3050 desc
= open (fn
, O_RDWR
);
3056 desc
= creat (fn
, 0666);
3061 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3062 S_IREAD
| S_IWRITE
);
3063 #else /* not MSDOS */
3064 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3065 #endif /* not MSDOS */
3066 #endif /* not VMS */
3072 #ifdef CLASH_DETECTION
3074 if (!auto_saving
) unlock_file (visit_file
);
3076 #endif /* CLASH_DETECTION */
3077 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
3080 record_unwind_protect (close_file_unwind
, make_number (desc
));
3083 if (lseek (desc
, 0, 2) < 0)
3085 #ifdef CLASH_DETECTION
3086 if (!auto_saving
) unlock_file (visit_file
);
3087 #endif /* CLASH_DETECTION */
3088 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
3093 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3094 * if we do writes that don't end with a carriage return. Furthermore
3095 * it cannot handle writes of more then 16K. The modified
3096 * version of "sys_write" in SYSDEP.C (see comment there) copes with
3097 * this EXCEPT for the last record (iff it doesn't end with a carriage
3098 * return). This implies that if your buffer doesn't end with a carriage
3099 * return, you get one free... tough. However it also means that if
3100 * we make two calls to sys_write (a la the following code) you can
3101 * get one at the gap as well. The easiest way to fix this (honest)
3102 * is to move the gap to the next newline (or the end of the buffer).
3107 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
3108 move_gap (find_next_newline (GPT
, 1));
3114 if (STRINGP (start
))
3116 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
3117 XSTRING (start
)->size
, 0, &annotations
);
3120 else if (XINT (start
) != XINT (end
))
3123 if (XINT (start
) < GPT
)
3125 register int end1
= XINT (end
);
3127 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
),
3128 min (GPT
, end1
) - tem
, tem
, &annotations
);
3129 nwritten
+= min (GPT
, end1
) - tem
;
3133 if (XINT (end
) > GPT
&& !failure
)
3136 tem
= max (tem
, GPT
);
3137 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
,
3139 nwritten
+= XINT (end
) - tem
;
3145 /* If file was empty, still need to write the annotations */
3146 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
);
3154 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3155 Disk full in NFS may be reported here. */
3156 /* mib says that closing the file will try to write as fast as NFS can do
3157 it, and that means the fsync here is not crucial for autosave files. */
3158 if (!auto_saving
&& fsync (desc
) < 0)
3159 failure
= 1, save_errno
= errno
;
3162 /* Spurious "file has changed on disk" warnings have been
3163 observed on Suns as well.
3164 It seems that `close' can change the modtime, under nfs.
3166 (This has supposedly been fixed in Sunos 4,
3167 but who knows about all the other machines with NFS?) */
3170 /* On VMS and APOLLO, must do the stat after the close
3171 since closing changes the modtime. */
3174 /* Recall that #if defined does not work on VMS. */
3181 /* NFS can report a write failure now. */
3182 if (close (desc
) < 0)
3183 failure
= 1, save_errno
= errno
;
3186 /* If we wrote to a temporary name and had no errors, rename to real name. */
3190 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
3198 /* Discard the unwind protect */
3199 specpdl_ptr
= specpdl
+ count
;
3201 #ifdef CLASH_DETECTION
3203 unlock_file (visit_file
);
3204 #endif /* CLASH_DETECTION */
3206 /* Do this before reporting IO error
3207 to avoid a "file has changed on disk" warning on
3208 next attempt to save. */
3210 current_buffer
->modtime
= st
.st_mtime
;
3213 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
3217 current_buffer
->save_modified
= MODIFF
;
3218 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3219 current_buffer
->filename
= visit_file
;
3225 message ("Wrote %s", XSTRING (visit_file
)->data
);
3230 Lisp_Object
merge ();
3232 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
3233 "Return t if (car A) is numerically less than (car B).")
3237 return Flss (Fcar (a
), Fcar (b
));
3240 /* Build the complete list of annotations appropriate for writing out
3241 the text between START and END, by calling all the functions in
3242 write-region-annotate-functions and merging the lists they return. */
3245 build_annotations (start
, end
)
3246 Lisp_Object start
, end
;
3248 Lisp_Object annotations
;
3250 struct gcpro gcpro1
, gcpro2
;
3253 p
= Vwrite_region_annotate_functions
;
3254 GCPRO2 (annotations
, p
);
3257 res
= call2 (Fcar (p
), start
, end
);
3258 Flength (res
); /* Check basic validity of return value */
3259 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3266 /* Write to descriptor DESC the LEN characters starting at ADDR,
3267 assuming they start at position POS in the buffer.
3268 Intersperse with them the annotations from *ANNOT
3269 (those which fall within the range of positions POS to POS + LEN),
3270 each at its appropriate position.
3272 Modify *ANNOT by discarding elements as we output them.
3273 The return value is negative in case of system call failure. */
3276 a_write (desc
, addr
, len
, pos
, annot
)
3278 register char *addr
;
3285 int lastpos
= pos
+ len
;
3289 tem
= Fcar_safe (Fcar (*annot
));
3290 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
3291 nextpos
= XFASTINT (tem
);
3293 return e_write (desc
, addr
, lastpos
- pos
);
3296 if (0 > e_write (desc
, addr
, nextpos
- pos
))
3298 addr
+= nextpos
- pos
;
3301 tem
= Fcdr (Fcar (*annot
));
3304 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
))
3307 *annot
= Fcdr (*annot
);
3312 e_write (desc
, addr
, len
)
3314 register char *addr
;
3317 char buf
[16 * 1024];
3318 register char *p
, *end
;
3320 if (!EQ (current_buffer
->selective_display
, Qt
))
3321 return write (desc
, addr
, len
) - len
;
3325 end
= p
+ sizeof buf
;
3330 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
3339 if (write (desc
, buf
, p
- buf
) != p
- buf
)
3345 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
3346 Sverify_visited_file_modtime
, 1, 1, 0,
3347 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
3348 This means that the file has not been changed since it was visited or saved.")
3354 Lisp_Object handler
;
3356 CHECK_BUFFER (buf
, 0);
3359 if (XTYPE (b
->filename
) != Lisp_String
) return Qt
;
3360 if (b
->modtime
== 0) return Qt
;
3362 /* If the file name has special constructs in it,
3363 call the corresponding file handler. */
3364 handler
= Ffind_file_name_handler (b
->filename
,
3365 Qverify_visited_file_modtime
);
3366 if (!NILP (handler
))
3367 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
3369 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
3371 /* If the file doesn't exist now and didn't exist before,
3372 we say that it isn't modified, provided the error is a tame one. */
3373 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
3378 if (st
.st_mtime
== b
->modtime
3379 /* If both are positive, accept them if they are off by one second. */
3380 || (st
.st_mtime
> 0 && b
->modtime
> 0
3381 && (st
.st_mtime
== b
->modtime
+ 1
3382 || st
.st_mtime
== b
->modtime
- 1)))
3387 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
3388 Sclear_visited_file_modtime
, 0, 0, 0,
3389 "Clear out records of last mod time of visited file.\n\
3390 Next attempt to save will certainly not complain of a discrepancy.")
3393 current_buffer
->modtime
= 0;
3397 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
3398 Svisited_file_modtime
, 0, 0, 0,
3399 "Return the current buffer's recorded visited file modification time.\n\
3400 The value is a list of the form (HIGH . LOW), like the time values\n\
3401 that `file-attributes' returns.")
3404 return long_to_cons (current_buffer
->modtime
);
3407 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
3408 Sset_visited_file_modtime
, 0, 1, 0,
3409 "Update buffer's recorded modification time from the visited file's time.\n\
3410 Useful if the buffer was not read from the file normally\n\
3411 or if the file itself has been changed for some known benign reason.\n\
3412 An argument specifies the modification time value to use\n\
3413 \(instead of that of the visited file), in the form of a list\n\
3414 \(HIGH . LOW) or (HIGH LOW).")
3416 Lisp_Object time_list
;
3418 if (!NILP (time_list
))
3419 current_buffer
->modtime
= cons_to_long (time_list
);
3422 register Lisp_Object filename
;
3424 Lisp_Object handler
;
3426 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
3428 /* If the file name has special constructs in it,
3429 call the corresponding file handler. */
3430 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
3431 if (!NILP (handler
))
3432 /* The handler can find the file name the same way we did. */
3433 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
3434 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
3435 current_buffer
->modtime
= st
.st_mtime
;
3444 unsigned char *name
= XSTRING (current_buffer
->name
)->data
;
3447 message ("Autosaving...error for %s", name
);
3448 Fsleep_for (make_number (1), Qnil
);
3449 message ("Autosaving...error!for %s", name
);
3450 Fsleep_for (make_number (1), Qnil
);
3451 message ("Autosaving...error for %s", name
);
3452 Fsleep_for (make_number (1), Qnil
);
3462 /* Get visited file's mode to become the auto save file's mode. */
3463 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
3464 /* But make sure we can overwrite it later! */
3465 auto_save_mode_bits
= st
.st_mode
| 0600;
3467 auto_save_mode_bits
= 0666;
3470 Fwrite_region (Qnil
, Qnil
,
3471 current_buffer
->auto_save_file_name
,
3476 do_auto_save_unwind (stream
) /* used as unwind-protect function */
3479 close (*(int *)XPNTR (stream
));
3480 xfree (XPNTR (stream
));
3484 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
3485 "Auto-save all buffers that need it.\n\
3486 This is all buffers that have auto-saving enabled\n\
3487 and are changed since last auto-saved.\n\
3488 Auto-saving writes the buffer into a file\n\
3489 so that your editing is not lost if the system crashes.\n\
3490 This file is not the file you visited; that changes only when you save.\n\
3491 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
3492 Non-nil first argument means do not print any message if successful.\n\
3493 Non-nil second argument means save only current buffer.")
3494 (no_message
, current_only
)
3495 Lisp_Object no_message
, current_only
;
3497 struct buffer
*old
= current_buffer
, *b
;
3498 Lisp_Object tail
, buf
;
3500 char *omessage
= echo_area_glyphs
;
3501 int omessage_length
= echo_area_glyphs_length
;
3502 extern int minibuf_level
;
3503 int do_handled_files
;
3506 Lisp_Object lispstream
;
3507 int count
= specpdl_ptr
- specpdl
;
3510 /* Ordinarily don't quit within this function,
3511 but don't make it impossible to quit (in case we get hung in I/O). */
3515 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
3516 point to non-strings reached from Vbuffer_alist. */
3522 if (!NILP (Vrun_hooks
))
3523 call1 (Vrun_hooks
, intern ("auto-save-hook"));
3525 if (STRINGP (Vauto_save_list_file_name
))
3528 listdesc
= open (XSTRING (Vauto_save_list_file_name
)->data
,
3529 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
3530 S_IREAD
| S_IWRITE
);
3531 #else /* not MSDOS */
3532 listdesc
= creat (XSTRING (Vauto_save_list_file_name
)->data
, 0666);
3533 #endif /* not MSDOS */
3538 /* We may not be able to store STREAM itself as a Lisp_Object pointer
3539 since that is guaranteed to work only for data that has been malloc'd.
3540 So malloc a full-size pointer, and record the address of that pointer. */
3541 ptr
= (int *) xmalloc (sizeof (int));
3543 XSET (lispstream
, Lisp_Internal_Stream
, (int) ptr
);
3545 record_unwind_protect (do_auto_save_unwind
, lispstream
);
3547 /* First, save all files which don't have handlers. If Emacs is
3548 crashing, the handlers may tweak what is causing Emacs to crash
3549 in the first place, and it would be a shame if Emacs failed to
3550 autosave perfectly ordinary files because it couldn't handle some
3552 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
3553 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
3554 tail
= XCONS (tail
)->cdr
)
3556 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
3559 /* Record all the buffers that have auto save mode
3560 in the special file that lists them. */
3561 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
3562 && listdesc
>= 0 && do_handled_files
== 0)
3564 write (listdesc
, XSTRING (b
->auto_save_file_name
)->data
,
3565 XSTRING (b
->auto_save_file_name
)->size
);
3566 write (listdesc
, "\n", 1);
3569 if (!NILP (current_only
)
3570 && b
!= current_buffer
)
3573 /* Check for auto save enabled
3574 and file changed since last auto save
3575 and file changed since last real save. */
3576 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
3577 && b
->save_modified
< BUF_MODIFF (b
)
3578 && b
->auto_save_modified
< BUF_MODIFF (b
)
3579 /* -1 means we've turned off autosaving for a while--see below. */
3580 && XINT (b
->save_length
) >= 0
3581 && (do_handled_files
3582 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
3585 EMACS_TIME before_time
, after_time
;
3587 EMACS_GET_TIME (before_time
);
3589 /* If we had a failure, don't try again for 20 minutes. */
3590 if (b
->auto_save_failure_time
>= 0
3591 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
3594 if ((XFASTINT (b
->save_length
) * 10
3595 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
3596 /* A short file is likely to change a large fraction;
3597 spare the user annoying messages. */
3598 && XFASTINT (b
->save_length
) > 5000
3599 /* These messages are frequent and annoying for `*mail*'. */
3600 && !EQ (b
->filename
, Qnil
)
3601 && NILP (no_message
))
3603 /* It has shrunk too much; turn off auto-saving here. */
3604 message ("Buffer %s has shrunk a lot; auto save turned off there",
3605 XSTRING (b
->name
)->data
);
3606 /* Turn off auto-saving until there's a real save,
3607 and prevent any more warnings. */
3608 XSET (b
->save_length
, Lisp_Int
, -1);
3609 Fsleep_for (make_number (1), Qnil
);
3612 set_buffer_internal (b
);
3613 if (!auto_saved
&& NILP (no_message
))
3614 message1 ("Auto-saving...");
3615 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
3617 b
->auto_save_modified
= BUF_MODIFF (b
);
3618 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3619 set_buffer_internal (old
);
3621 EMACS_GET_TIME (after_time
);
3623 /* If auto-save took more than 60 seconds,
3624 assume it was an NFS failure that got a timeout. */
3625 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
3626 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
3630 /* Prevent another auto save till enough input events come in. */
3631 record_auto_save ();
3633 if (auto_saved
&& NILP (no_message
))
3636 message2 (omessage
, omessage_length
);
3638 message1 ("Auto-saving...done");
3644 unbind_to (count
, Qnil
);
3648 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
3649 Sset_buffer_auto_saved
, 0, 0, 0,
3650 "Mark current buffer as auto-saved with its current text.\n\
3651 No auto-save file will be written until the buffer changes again.")
3654 current_buffer
->auto_save_modified
= MODIFF
;
3655 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3656 current_buffer
->auto_save_failure_time
= -1;
3660 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
3661 Sclear_buffer_auto_save_failure
, 0, 0, 0,
3662 "Clear any record of a recent auto-save failure in the current buffer.")
3665 current_buffer
->auto_save_failure_time
= -1;
3669 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
3671 "Return t if buffer has been auto-saved since last read in or saved.")
3674 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
3677 /* Reading and completing file names */
3678 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
3680 /* In the string VAL, change each $ to $$ and return the result. */
3683 double_dollars (val
)
3686 register unsigned char *old
, *new;
3690 osize
= XSTRING (val
)->size
;
3691 /* Quote "$" as "$$" to get it past substitute-in-file-name */
3692 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
3693 if (*old
++ == '$') count
++;
3696 old
= XSTRING (val
)->data
;
3697 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
3698 new = XSTRING (val
)->data
;
3699 for (n
= osize
; n
> 0; n
--)
3712 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
3714 "Internal subroutine for read-file-name. Do not call this.")
3715 (string
, dir
, action
)
3716 Lisp_Object string
, dir
, action
;
3717 /* action is nil for complete, t for return list of completions,
3718 lambda for verify final value */
3720 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
3722 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3729 /* No need to protect ACTION--we only compare it with t and nil. */
3730 GCPRO4 (string
, realdir
, name
, specdir
);
3732 if (XSTRING (string
)->size
== 0)
3734 if (EQ (action
, Qlambda
))
3742 orig_string
= string
;
3743 string
= Fsubstitute_in_file_name (string
);
3744 changed
= NILP (Fstring_equal (string
, orig_string
));
3745 name
= Ffile_name_nondirectory (string
);
3746 val
= Ffile_name_directory (string
);
3748 realdir
= Fexpand_file_name (val
, realdir
);
3753 specdir
= Ffile_name_directory (string
);
3754 val
= Ffile_name_completion (name
, realdir
);
3756 if (XTYPE (val
) != Lisp_String
)
3763 if (!NILP (specdir
))
3764 val
= concat2 (specdir
, val
);
3766 return double_dollars (val
);
3769 #endif /* not VMS */
3773 if (EQ (action
, Qt
))
3774 return Ffile_name_all_completions (name
, realdir
);
3775 /* Only other case actually used is ACTION = lambda */
3777 /* Supposedly this helps commands such as `cd' that read directory names,
3778 but can someone explain how it helps them? -- RMS */
3779 if (XSTRING (name
)->size
== 0)
3782 return Ffile_exists_p (string
);
3785 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3786 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3787 Value is not expanded---you must call `expand-file-name' yourself.\n\
3788 Default name to DEFAULT if user enters a null string.\n\
3789 (If DEFAULT is omitted, the visited file name is used.)\n\
3790 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3791 Non-nil and non-t means also require confirmation after completion.\n\
3792 Fifth arg INITIAL specifies text to start with.\n\
3793 DIR defaults to current buffer's directory default.")
3794 (prompt
, dir
, defalt
, mustmatch
, initial
)
3795 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3797 Lisp_Object val
, insdef
, insdef1
, tem
;
3798 struct gcpro gcpro1
, gcpro2
;
3799 register char *homedir
;
3803 dir
= current_buffer
->directory
;
3805 defalt
= current_buffer
->filename
;
3807 /* If dir starts with user's homedir, change that to ~. */
3808 homedir
= (char *) egetenv ("HOME");
3810 && XTYPE (dir
) == Lisp_String
3811 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3812 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3814 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3815 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3816 XSTRING (dir
)->data
[0] = '~';
3819 if (insert_default_directory
)
3822 if (!NILP (initial
))
3824 Lisp_Object args
[2], pos
;
3828 insdef
= Fconcat (2, args
);
3829 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
3830 insdef1
= Fcons (double_dollars (insdef
), pos
);
3833 insdef1
= double_dollars (insdef
);
3835 else if (!NILP (initial
))
3838 insdef1
= Fcons (double_dollars (insdef
), 0);
3841 insdef
= Qnil
, insdef1
= Qnil
;
3844 count
= specpdl_ptr
- specpdl
;
3845 specbind (intern ("completion-ignore-case"), Qt
);
3848 GCPRO2 (insdef
, defalt
);
3849 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3850 dir
, mustmatch
, insdef1
,
3851 Qfile_name_history
);
3854 unbind_to (count
, Qnil
);
3859 error ("No file name specified");
3860 tem
= Fstring_equal (val
, insdef
);
3861 if (!NILP (tem
) && !NILP (defalt
))
3863 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
3868 error ("No default file name");
3870 return Fsubstitute_in_file_name (val
);
3873 #if 0 /* Old version */
3874 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3875 /* Don't confuse make-docfile by having two doc strings for this function.
3876 make-docfile does not pay attention to #if, for good reason! */
3878 (prompt
, dir
, defalt
, mustmatch
, initial
)
3879 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3881 Lisp_Object val
, insdef
, tem
;
3882 struct gcpro gcpro1
, gcpro2
;
3883 register char *homedir
;
3887 dir
= current_buffer
->directory
;
3889 defalt
= current_buffer
->filename
;
3891 /* If dir starts with user's homedir, change that to ~. */
3892 homedir
= (char *) egetenv ("HOME");
3894 && XTYPE (dir
) == Lisp_String
3895 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3896 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3898 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3899 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3900 XSTRING (dir
)->data
[0] = '~';
3903 if (!NILP (initial
))
3905 else if (insert_default_directory
)
3908 insdef
= build_string ("");
3911 count
= specpdl_ptr
- specpdl
;
3912 specbind (intern ("completion-ignore-case"), Qt
);
3915 GCPRO2 (insdef
, defalt
);
3916 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3918 insert_default_directory
? insdef
: Qnil
,
3919 Qfile_name_history
);
3922 unbind_to (count
, Qnil
);
3927 error ("No file name specified");
3928 tem
= Fstring_equal (val
, insdef
);
3929 if (!NILP (tem
) && !NILP (defalt
))
3931 return Fsubstitute_in_file_name (val
);
3933 #endif /* Old version */
3937 Qexpand_file_name
= intern ("expand-file-name");
3938 Qdirectory_file_name
= intern ("directory-file-name");
3939 Qfile_name_directory
= intern ("file-name-directory");
3940 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
3941 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
3942 Qfile_name_as_directory
= intern ("file-name-as-directory");
3943 Qcopy_file
= intern ("copy-file");
3944 Qmake_directory
= intern ("make-directory");
3945 Qdelete_directory
= intern ("delete-directory");
3946 Qdelete_file
= intern ("delete-file");
3947 Qrename_file
= intern ("rename-file");
3948 Qadd_name_to_file
= intern ("add-name-to-file");
3949 Qmake_symbolic_link
= intern ("make-symbolic-link");
3950 Qfile_exists_p
= intern ("file-exists-p");
3951 Qfile_executable_p
= intern ("file-executable-p");
3952 Qfile_readable_p
= intern ("file-readable-p");
3953 Qfile_symlink_p
= intern ("file-symlink-p");
3954 Qfile_writable_p
= intern ("file-writable-p");
3955 Qfile_directory_p
= intern ("file-directory-p");
3956 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
3957 Qfile_modes
= intern ("file-modes");
3958 Qset_file_modes
= intern ("set-file-modes");
3959 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
3960 Qinsert_file_contents
= intern ("insert-file-contents");
3961 Qwrite_region
= intern ("write-region");
3962 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
3963 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
3965 staticpro (&Qexpand_file_name
);
3966 staticpro (&Qdirectory_file_name
);
3967 staticpro (&Qfile_name_directory
);
3968 staticpro (&Qfile_name_nondirectory
);
3969 staticpro (&Qunhandled_file_name_directory
);
3970 staticpro (&Qfile_name_as_directory
);
3971 staticpro (&Qcopy_file
);
3972 staticpro (&Qmake_directory
);
3973 staticpro (&Qdelete_directory
);
3974 staticpro (&Qdelete_file
);
3975 staticpro (&Qrename_file
);
3976 staticpro (&Qadd_name_to_file
);
3977 staticpro (&Qmake_symbolic_link
);
3978 staticpro (&Qfile_exists_p
);
3979 staticpro (&Qfile_executable_p
);
3980 staticpro (&Qfile_readable_p
);
3981 staticpro (&Qfile_symlink_p
);
3982 staticpro (&Qfile_writable_p
);
3983 staticpro (&Qfile_directory_p
);
3984 staticpro (&Qfile_accessible_directory_p
);
3985 staticpro (&Qfile_modes
);
3986 staticpro (&Qset_file_modes
);
3987 staticpro (&Qfile_newer_than_file_p
);
3988 staticpro (&Qinsert_file_contents
);
3989 staticpro (&Qwrite_region
);
3990 staticpro (&Qverify_visited_file_modtime
);
3992 Qfile_name_history
= intern ("file-name-history");
3993 Fset (Qfile_name_history
, Qnil
);
3994 staticpro (&Qfile_name_history
);
3996 Qfile_error
= intern ("file-error");
3997 staticpro (&Qfile_error
);
3998 Qfile_already_exists
= intern("file-already-exists");
3999 staticpro (&Qfile_already_exists
);
4002 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
4003 staticpro (&Qfind_buffer_file_type
);
4006 Qcar_less_than_car
= intern ("car-less-than-car");
4007 staticpro (&Qcar_less_than_car
);
4009 Fput (Qfile_error
, Qerror_conditions
,
4010 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
4011 Fput (Qfile_error
, Qerror_message
,
4012 build_string ("File error"));
4014 Fput (Qfile_already_exists
, Qerror_conditions
,
4015 Fcons (Qfile_already_exists
,
4016 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
4017 Fput (Qfile_already_exists
, Qerror_message
,
4018 build_string ("File already exists"));
4020 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
4021 "*Non-nil means when reading a filename start with default dir in minibuffer.");
4022 insert_default_directory
= 1;
4024 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
4025 "*Non-nil means write new files with record format `stmlf'.\n\
4026 nil means use format `var'. This variable is meaningful only on VMS.");
4027 vms_stmlf_recfm
= 0;
4029 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
4030 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
4031 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
4034 The first argument given to HANDLER is the name of the I/O primitive\n\
4035 to be handled; the remaining arguments are the arguments that were\n\
4036 passed to that primitive. For example, if you do\n\
4037 (file-exists-p FILENAME)\n\
4038 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
4039 (funcall HANDLER 'file-exists-p FILENAME)\n\
4040 The function `find-file-name-handler' checks this list for a handler\n\
4041 for its argument.");
4042 Vfile_name_handler_alist
= Qnil
;
4044 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
4045 "A list of functions to be called at the end of `insert-file-contents'.\n\
4046 Each is passed one argument, the number of bytes inserted. It should return\n\
4047 the new byte count, and leave point the same. If `insert-file-contents' is\n\
4048 intercepted by a handler from `file-name-handler-alist', that handler is\n\
4049 responsible for calling the after-insert-file-functions if appropriate.");
4050 Vafter_insert_file_functions
= Qnil
;
4052 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
4053 "A list of functions to be called at the start of `write-region'.\n\
4054 Each is passed two arguments, START and END as for `write-region'. It should\n\
4055 return a list of pairs (POSITION . STRING) of strings to be effectively\n\
4056 inserted at the specified positions of the file being written (1 means to\n\
4057 insert before the first byte written). The POSITIONs must be sorted into\n\
4058 increasing order. If there are several functions in the list, the several\n\
4059 lists are merged destructively.");
4060 Vwrite_region_annotate_functions
= Qnil
;
4062 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
4063 "A list of file names for which handlers should not be used.\n\
4064 This applies only to the operation `inhibit-file-name-operation'.");
4065 Vinhibit_file_name_handlers
= Qnil
;
4067 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
4068 "The operation for which `inhibit-file-name-handlers' is applicable.");
4069 Vinhibit_file_name_operation
= Qnil
;
4071 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
4072 "File name in which we write a list of all auto save file names.");
4073 Vauto_save_list_file_name
= Qnil
;
4075 defsubr (&Sfind_file_name_handler
);
4076 defsubr (&Sfile_name_directory
);
4077 defsubr (&Sfile_name_nondirectory
);
4078 defsubr (&Sunhandled_file_name_directory
);
4079 defsubr (&Sfile_name_as_directory
);
4080 defsubr (&Sdirectory_file_name
);
4081 defsubr (&Smake_temp_name
);
4082 defsubr (&Sexpand_file_name
);
4083 defsubr (&Ssubstitute_in_file_name
);
4084 defsubr (&Scopy_file
);
4085 defsubr (&Smake_directory_internal
);
4086 defsubr (&Sdelete_directory
);
4087 defsubr (&Sdelete_file
);
4088 defsubr (&Srename_file
);
4089 defsubr (&Sadd_name_to_file
);
4091 defsubr (&Smake_symbolic_link
);
4092 #endif /* S_IFLNK */
4094 defsubr (&Sdefine_logical_name
);
4097 defsubr (&Ssysnetunam
);
4098 #endif /* HPUX_NET */
4099 defsubr (&Sfile_name_absolute_p
);
4100 defsubr (&Sfile_exists_p
);
4101 defsubr (&Sfile_executable_p
);
4102 defsubr (&Sfile_readable_p
);
4103 defsubr (&Sfile_writable_p
);
4104 defsubr (&Sfile_symlink_p
);
4105 defsubr (&Sfile_directory_p
);
4106 defsubr (&Sfile_accessible_directory_p
);
4107 defsubr (&Sfile_modes
);
4108 defsubr (&Sset_file_modes
);
4109 defsubr (&Sset_default_file_modes
);
4110 defsubr (&Sdefault_file_modes
);
4111 defsubr (&Sfile_newer_than_file_p
);
4112 defsubr (&Sinsert_file_contents
);
4113 defsubr (&Swrite_region
);
4114 defsubr (&Scar_less_than_car
);
4115 defsubr (&Sverify_visited_file_modtime
);
4116 defsubr (&Sclear_visited_file_modtime
);
4117 defsubr (&Svisited_file_modtime
);
4118 defsubr (&Sset_visited_file_modtime
);
4119 defsubr (&Sdo_auto_save
);
4120 defsubr (&Sset_buffer_auto_saved
);
4121 defsubr (&Sclear_buffer_auto_save_failure
);
4122 defsubr (&Srecent_auto_save_p
);
4124 defsubr (&Sread_file_name_internal
);
4125 defsubr (&Sread_file_name
);
4128 defsubr (&Sunix_sync
);