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 /* Closing the output clobbers the file times on some systems. */
1807 if (close (ofd
) < 0)
1808 report_file_error ("I/O error", Fcons (newname
, Qnil
));
1810 if (input_file_statable_p
)
1812 if (!NILP (keep_date
))
1814 EMACS_TIME atime
, mtime
;
1815 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
1816 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
1817 EMACS_SET_UTIMES (XSTRING (newname
)->data
, atime
, mtime
);
1820 if (!egetenv ("USE_DOMAIN_ACLS"))
1822 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
1827 /* Discard the unwind protects. */
1828 specpdl_ptr
= specpdl
+ count
;
1834 DEFUN ("make-directory-internal", Fmake_directory_internal
,
1835 Smake_directory_internal
, 1, 1, 0,
1836 "Create a directory. One argument, a file name string.")
1838 Lisp_Object dirname
;
1841 Lisp_Object handler
;
1843 CHECK_STRING (dirname
, 0);
1844 dirname
= Fexpand_file_name (dirname
, Qnil
);
1846 handler
= Ffind_file_name_handler (dirname
, Qmake_directory
);
1847 if (!NILP (handler
))
1848 return call3 (handler
, Qmake_directory
, dirname
, Qnil
);
1850 dir
= XSTRING (dirname
)->data
;
1852 if (mkdir (dir
, 0777) != 0)
1853 report_file_error ("Creating directory", Flist (1, &dirname
));
1858 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
1859 "Delete a directory. One argument, a file name or directory name string.")
1861 Lisp_Object dirname
;
1864 Lisp_Object handler
;
1866 CHECK_STRING (dirname
, 0);
1867 dirname
= Fdirectory_file_name (Fexpand_file_name (dirname
, Qnil
));
1868 dir
= XSTRING (dirname
)->data
;
1870 handler
= Ffind_file_name_handler (dirname
, Qdelete_directory
);
1871 if (!NILP (handler
))
1872 return call2 (handler
, Qdelete_directory
, dirname
);
1874 if (rmdir (dir
) != 0)
1875 report_file_error ("Removing directory", Flist (1, &dirname
));
1880 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
1881 "Delete specified file. One argument, a file name string.\n\
1882 If file has multiple names, it continues to exist with the other names.")
1884 Lisp_Object filename
;
1886 Lisp_Object handler
;
1887 CHECK_STRING (filename
, 0);
1888 filename
= Fexpand_file_name (filename
, Qnil
);
1890 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
1891 if (!NILP (handler
))
1892 return call2 (handler
, Qdelete_file
, filename
);
1894 if (0 > unlink (XSTRING (filename
)->data
))
1895 report_file_error ("Removing old name", Flist (1, &filename
));
1899 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
1900 "fRename file: \nFRename %s to file: \np",
1901 "Rename FILE as NEWNAME. Both args strings.\n\
1902 If file has names other than FILE, it continues to have those names.\n\
1903 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1904 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1905 A number as third arg means request confirmation if NEWNAME already exists.\n\
1906 This is what happens in interactive use with M-x.")
1907 (filename
, newname
, ok_if_already_exists
)
1908 Lisp_Object filename
, newname
, ok_if_already_exists
;
1911 Lisp_Object args
[2];
1913 Lisp_Object handler
;
1914 struct gcpro gcpro1
, gcpro2
;
1916 GCPRO2 (filename
, newname
);
1917 CHECK_STRING (filename
, 0);
1918 CHECK_STRING (newname
, 1);
1919 filename
= Fexpand_file_name (filename
, Qnil
);
1920 newname
= Fexpand_file_name (newname
, Qnil
);
1922 /* If the file name has special constructs in it,
1923 call the corresponding file handler. */
1924 handler
= Ffind_file_name_handler (filename
, Qrename_file
);
1926 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
1927 if (!NILP (handler
))
1928 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
1929 filename
, newname
, ok_if_already_exists
));
1931 if (NILP (ok_if_already_exists
)
1932 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1933 barf_or_query_if_file_exists (newname
, "rename to it",
1934 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1936 if (0 > rename (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
1938 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
)
1939 || 0 > unlink (XSTRING (filename
)->data
))
1944 Fcopy_file (filename
, newname
,
1945 /* We have already prompted if it was an integer,
1946 so don't have copy-file prompt again. */
1947 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
1948 Fdelete_file (filename
);
1955 report_file_error ("Renaming", Flist (2, args
));
1958 report_file_error ("Renaming", Flist (2, &filename
));
1965 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
1966 "fAdd name to file: \nFName to add to %s: \np",
1967 "Give FILE additional name NEWNAME. Both args strings.\n\
1968 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
1969 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
1970 A number as third arg means request confirmation if NEWNAME already exists.\n\
1971 This is what happens in interactive use with M-x.")
1972 (filename
, newname
, ok_if_already_exists
)
1973 Lisp_Object filename
, newname
, ok_if_already_exists
;
1976 Lisp_Object args
[2];
1978 Lisp_Object handler
;
1979 struct gcpro gcpro1
, gcpro2
;
1981 GCPRO2 (filename
, newname
);
1982 CHECK_STRING (filename
, 0);
1983 CHECK_STRING (newname
, 1);
1984 filename
= Fexpand_file_name (filename
, Qnil
);
1985 newname
= Fexpand_file_name (newname
, Qnil
);
1987 /* If the file name has special constructs in it,
1988 call the corresponding file handler. */
1989 handler
= Ffind_file_name_handler (filename
, Qadd_name_to_file
);
1990 if (!NILP (handler
))
1991 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, filename
,
1992 newname
, ok_if_already_exists
));
1994 if (NILP (ok_if_already_exists
)
1995 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
1996 barf_or_query_if_file_exists (newname
, "make it a new name",
1997 XTYPE (ok_if_already_exists
) == Lisp_Int
);
1998 unlink (XSTRING (newname
)->data
);
1999 if (0 > link (XSTRING (filename
)->data
, XSTRING (newname
)->data
))
2004 report_file_error ("Adding new name", Flist (2, args
));
2006 report_file_error ("Adding new name", Flist (2, &filename
));
2015 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2016 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2017 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2018 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2019 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2020 A number as third arg means request confirmation if NEWNAME already exists.\n\
2021 This happens for interactive use with M-x.")
2022 (filename
, linkname
, ok_if_already_exists
)
2023 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2026 Lisp_Object args
[2];
2028 Lisp_Object handler
;
2029 struct gcpro gcpro1
, gcpro2
;
2031 GCPRO2 (filename
, linkname
);
2032 CHECK_STRING (filename
, 0);
2033 CHECK_STRING (linkname
, 1);
2034 /* If the link target has a ~, we must expand it to get
2035 a truly valid file name. Otherwise, do not expand;
2036 we want to permit links to relative file names. */
2037 if (XSTRING (filename
)->data
[0] == '~')
2038 filename
= Fexpand_file_name (filename
, Qnil
);
2039 linkname
= Fexpand_file_name (linkname
, Qnil
);
2041 /* If the file name has special constructs in it,
2042 call the corresponding file handler. */
2043 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2044 if (!NILP (handler
))
2045 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2046 linkname
, ok_if_already_exists
));
2048 if (NILP (ok_if_already_exists
)
2049 || XTYPE (ok_if_already_exists
) == Lisp_Int
)
2050 barf_or_query_if_file_exists (linkname
, "make it a link",
2051 XTYPE (ok_if_already_exists
) == Lisp_Int
);
2052 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2054 /* If we didn't complain already, silently delete existing file. */
2055 if (errno
== EEXIST
)
2057 unlink (XSTRING (linkname
)->data
);
2058 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2065 report_file_error ("Making symbolic link", Flist (2, args
));
2067 report_file_error ("Making symbolic link", Flist (2, &filename
));
2073 #endif /* S_IFLNK */
2077 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2078 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2079 "Define the job-wide logical name NAME to have the value STRING.\n\
2080 If STRING is nil or a null string, the logical name NAME is deleted.")
2082 Lisp_Object varname
;
2085 CHECK_STRING (varname
, 0);
2087 delete_logical_name (XSTRING (varname
)->data
);
2090 CHECK_STRING (string
, 1);
2092 if (XSTRING (string
)->size
== 0)
2093 delete_logical_name (XSTRING (varname
)->data
);
2095 define_logical_name (XSTRING (varname
)->data
, XSTRING (string
)->data
);
2104 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2105 "Open a network connection to PATH using LOGIN as the login string.")
2107 Lisp_Object path
, login
;
2111 CHECK_STRING (path
, 0);
2112 CHECK_STRING (login
, 0);
2114 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2116 if (netresult
== -1)
2121 #endif /* HPUX_NET */
2123 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2125 "Return t if file FILENAME specifies an absolute path name.\n\
2126 On Unix, this is a name starting with a `/' or a `~'.")
2128 Lisp_Object filename
;
2132 CHECK_STRING (filename
, 0);
2133 ptr
= XSTRING (filename
)->data
;
2134 if (*ptr
== '/' || *ptr
== '~'
2136 /* ??? This criterion is probably wrong for '<'. */
2137 || index (ptr
, ':') || index (ptr
, '<')
2138 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2142 || (*ptr
!= 0 && ptr
[1] == ':' && ptr
[2] == '/')
2150 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2151 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2152 See also `file-readable-p' and `file-attributes'.")
2154 Lisp_Object filename
;
2156 Lisp_Object abspath
;
2157 Lisp_Object handler
;
2159 CHECK_STRING (filename
, 0);
2160 abspath
= Fexpand_file_name (filename
, Qnil
);
2162 /* If the file name has special constructs in it,
2163 call the corresponding file handler. */
2164 handler
= Ffind_file_name_handler (abspath
, Qfile_exists_p
);
2165 if (!NILP (handler
))
2166 return call2 (handler
, Qfile_exists_p
, abspath
);
2168 return (access (XSTRING (abspath
)->data
, 0) >= 0) ? Qt
: Qnil
;
2171 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2172 "Return t if FILENAME can be executed by you.\n\
2173 For a directory, this means you can access files in that directory.")
2175 Lisp_Object filename
;
2178 Lisp_Object abspath
;
2179 Lisp_Object handler
;
2181 CHECK_STRING (filename
, 0);
2182 abspath
= Fexpand_file_name (filename
, Qnil
);
2184 /* If the file name has special constructs in it,
2185 call the corresponding file handler. */
2186 handler
= Ffind_file_name_handler (abspath
, Qfile_executable_p
);
2187 if (!NILP (handler
))
2188 return call2 (handler
, Qfile_executable_p
, abspath
);
2190 return (access (XSTRING (abspath
)->data
, 1) >= 0) ? Qt
: Qnil
;
2193 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2194 "Return t if file FILENAME exists and you can read it.\n\
2195 See also `file-exists-p' and `file-attributes'.")
2197 Lisp_Object filename
;
2199 Lisp_Object abspath
;
2200 Lisp_Object handler
;
2202 CHECK_STRING (filename
, 0);
2203 abspath
= Fexpand_file_name (filename
, Qnil
);
2205 /* If the file name has special constructs in it,
2206 call the corresponding file handler. */
2207 handler
= Ffind_file_name_handler (abspath
, Qfile_readable_p
);
2208 if (!NILP (handler
))
2209 return call2 (handler
, Qfile_readable_p
, abspath
);
2211 return (access (XSTRING (abspath
)->data
, 4) >= 0) ? Qt
: Qnil
;
2214 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2215 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2216 The value is the name of the file to which it is linked.\n\
2217 Otherwise returns nil.")
2219 Lisp_Object filename
;
2226 Lisp_Object handler
;
2228 CHECK_STRING (filename
, 0);
2229 filename
= Fexpand_file_name (filename
, Qnil
);
2231 /* If the file name has special constructs in it,
2232 call the corresponding file handler. */
2233 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2234 if (!NILP (handler
))
2235 return call2 (handler
, Qfile_symlink_p
, filename
);
2240 buf
= (char *) xmalloc (bufsize
);
2241 bzero (buf
, bufsize
);
2242 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2243 if (valsize
< bufsize
) break;
2244 /* Buffer was not long enough */
2253 val
= make_string (buf
, valsize
);
2256 #else /* not S_IFLNK */
2258 #endif /* not S_IFLNK */
2261 #ifdef SOLARIS_BROKEN_ACCESS
2262 /* In Solaris 2.1, the readonly-ness of the filesystem is not
2263 considered by the access system call. This is Sun's bug, but we
2264 still have to make Emacs work. */
2266 #include <sys/statvfs.h>
2272 struct statvfs statvfsb
;
2274 if (statvfs(path
, &statvfsb
))
2275 return 1; /* error from statvfs, be conservative and say not wrtable */
2277 /* Otherwise, fsys is ro if bit is set. */
2278 return statvfsb
.f_flag
& ST_RDONLY
;
2281 /* But on every other os, access has already done the right thing. */
2282 #define ro_fsys(path) 0
2285 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2287 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2288 "Return t if file FILENAME can be written or created by you.")
2290 Lisp_Object filename
;
2292 Lisp_Object abspath
, dir
;
2293 Lisp_Object handler
;
2295 CHECK_STRING (filename
, 0);
2296 abspath
= Fexpand_file_name (filename
, Qnil
);
2298 /* If the file name has special constructs in it,
2299 call the corresponding file handler. */
2300 handler
= Ffind_file_name_handler (abspath
, Qfile_writable_p
);
2301 if (!NILP (handler
))
2302 return call2 (handler
, Qfile_writable_p
, abspath
);
2304 if (access (XSTRING (abspath
)->data
, 0) >= 0)
2305 return ((access (XSTRING (abspath
)->data
, 2) >= 0
2306 && ! ro_fsys ((char *) XSTRING (abspath
)->data
))
2308 dir
= Ffile_name_directory (abspath
);
2311 dir
= Fdirectory_file_name (dir
);
2315 dir
= Fdirectory_file_name (dir
);
2317 return ((access (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "", 2) >= 0
2318 && ! ro_fsys ((char *) XSTRING (dir
)->data
))
2322 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2323 "Return t if file FILENAME is the name of a directory as a file.\n\
2324 A directory name spec may be given instead; then the value is t\n\
2325 if the directory so specified exists and really is a directory.")
2327 Lisp_Object filename
;
2329 register Lisp_Object abspath
;
2331 Lisp_Object handler
;
2333 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2335 /* If the file name has special constructs in it,
2336 call the corresponding file handler. */
2337 handler
= Ffind_file_name_handler (abspath
, Qfile_directory_p
);
2338 if (!NILP (handler
))
2339 return call2 (handler
, Qfile_directory_p
, abspath
);
2341 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2343 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2346 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2347 "Return t if file FILENAME is the name of a directory as a file,\n\
2348 and files in that directory can be opened by you. In order to use a\n\
2349 directory as a buffer's current directory, this predicate must return true.\n\
2350 A directory name spec may be given instead; then the value is t\n\
2351 if the directory so specified exists and really is a readable and\n\
2352 searchable directory.")
2354 Lisp_Object filename
;
2356 Lisp_Object handler
;
2358 /* If the file name has special constructs in it,
2359 call the corresponding file handler. */
2360 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2361 if (!NILP (handler
))
2362 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2364 if (NILP (Ffile_directory_p (filename
))
2365 || NILP (Ffile_executable_p (filename
)))
2371 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2372 "Return mode bits of FILE, as an integer.")
2374 Lisp_Object filename
;
2376 Lisp_Object abspath
;
2378 Lisp_Object handler
;
2380 abspath
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2382 /* If the file name has special constructs in it,
2383 call the corresponding file handler. */
2384 handler
= Ffind_file_name_handler (abspath
, Qfile_modes
);
2385 if (!NILP (handler
))
2386 return call2 (handler
, Qfile_modes
, abspath
);
2388 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2394 if (S_ISREG (st
.st_mode
)
2395 && (len
= XSTRING (abspath
)->size
) >= 5
2396 && (stricmp ((suffix
= XSTRING (abspath
)->data
+ len
-4), ".com") == 0
2397 || stricmp (suffix
, ".exe") == 0
2398 || stricmp (suffix
, ".bat") == 0))
2399 st
.st_mode
|= S_IEXEC
;
2403 return make_number (st
.st_mode
& 07777);
2406 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2407 "Set mode bits of FILE to MODE (an integer).\n\
2408 Only the 12 low bits of MODE are used.")
2410 Lisp_Object filename
, mode
;
2412 Lisp_Object abspath
;
2413 Lisp_Object handler
;
2415 abspath
= Fexpand_file_name (filename
, current_buffer
->directory
);
2416 CHECK_NUMBER (mode
, 1);
2418 /* If the file name has special constructs in it,
2419 call the corresponding file handler. */
2420 handler
= Ffind_file_name_handler (abspath
, Qset_file_modes
);
2421 if (!NILP (handler
))
2422 return call3 (handler
, Qset_file_modes
, abspath
, mode
);
2425 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2426 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2428 if (!egetenv ("USE_DOMAIN_ACLS"))
2431 struct timeval tvp
[2];
2433 /* chmod on apollo also change the file's modtime; need to save the
2434 modtime and then restore it. */
2435 if (stat (XSTRING (abspath
)->data
, &st
) < 0)
2437 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2441 if (chmod (XSTRING (abspath
)->data
, XINT (mode
)) < 0)
2442 report_file_error ("Doing chmod", Fcons (abspath
, Qnil
));
2444 /* reset the old accessed and modified times. */
2445 tvp
[0].tv_sec
= st
.st_atime
+ 1; /* +1 due to an Apollo roundoff bug */
2447 tvp
[1].tv_sec
= st
.st_mtime
+ 1; /* +1 due to an Apollo roundoff bug */
2450 if (utimes (XSTRING (abspath
)->data
, tvp
) < 0)
2451 report_file_error ("Doing utimes", Fcons (abspath
, Qnil
));
2458 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2459 "Set the file permission bits for newly created files.\n\
2460 The argument MODE should be an integer; only the low 9 bits are used.\n\
2461 This setting is inherited by subprocesses.")
2465 CHECK_NUMBER (mode
, 0);
2467 umask ((~ XINT (mode
)) & 0777);
2472 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2473 "Return the default file protection for created files.\n\
2474 The value is an integer.")
2480 realmask
= umask (0);
2483 XSET (value
, Lisp_Int
, (~ realmask
) & 0777);
2489 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2490 "Tell Unix to finish all pending disk updates.")
2499 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2500 "Return t if file FILE1 is newer than file FILE2.\n\
2501 If FILE1 does not exist, the answer is nil;\n\
2502 otherwise, if FILE2 does not exist, the answer is t.")
2504 Lisp_Object file1
, file2
;
2506 Lisp_Object abspath1
, abspath2
;
2509 Lisp_Object handler
;
2510 struct gcpro gcpro1
, gcpro2
;
2512 CHECK_STRING (file1
, 0);
2513 CHECK_STRING (file2
, 0);
2516 GCPRO2 (abspath1
, file2
);
2517 abspath1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2518 abspath2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2521 /* If the file name has special constructs in it,
2522 call the corresponding file handler. */
2523 handler
= Ffind_file_name_handler (abspath1
, Qfile_newer_than_file_p
);
2525 handler
= Ffind_file_name_handler (abspath2
, Qfile_newer_than_file_p
);
2526 if (!NILP (handler
))
2527 return call3 (handler
, Qfile_newer_than_file_p
, abspath1
, abspath2
);
2529 if (stat (XSTRING (abspath1
)->data
, &st
) < 0)
2532 mtime1
= st
.st_mtime
;
2534 if (stat (XSTRING (abspath2
)->data
, &st
) < 0)
2537 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2541 Lisp_Object Qfind_buffer_file_type
;
2544 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2546 "Insert contents of file FILENAME after point.\n\
2547 Returns list of absolute file name and length of data inserted.\n\
2548 If second argument VISIT is non-nil, the buffer's visited filename\n\
2549 and last save file modtime are set, and it is marked unmodified.\n\
2550 If visiting and the file does not exist, visiting is completed\n\
2551 before the error is signaled.\n\n\
2552 The optional third and fourth arguments BEG and END\n\
2553 specify what portion of the file to insert.\n\
2554 If VISIT is non-nil, BEG and END must be nil.\n\
2555 If optional fifth argument REPLACE is non-nil,\n\
2556 it means replace the current buffer contents (in the accessible portion)\n\
2557 with the file contents. This is better than simply deleting and inserting\n\
2558 the whole thing because (1) it preserves some marker positions\n\
2559 and (2) it puts less data in the undo list.")
2560 (filename
, visit
, beg
, end
, replace
)
2561 Lisp_Object filename
, visit
, beg
, end
, replace
;
2565 register int inserted
= 0;
2566 register int how_much
;
2567 int count
= specpdl_ptr
- specpdl
;
2568 struct gcpro gcpro1
, gcpro2
;
2569 Lisp_Object handler
, val
, insval
;
2576 GCPRO2 (filename
, p
);
2577 if (!NILP (current_buffer
->read_only
))
2578 Fbarf_if_buffer_read_only();
2580 CHECK_STRING (filename
, 0);
2581 filename
= Fexpand_file_name (filename
, Qnil
);
2583 /* If the file name has special constructs in it,
2584 call the corresponding file handler. */
2585 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
2586 if (!NILP (handler
))
2588 val
= call6 (handler
, Qinsert_file_contents
, filename
,
2589 visit
, beg
, end
, replace
);
2596 if (stat (XSTRING (filename
)->data
, &st
) < 0)
2598 if ((fd
= open (XSTRING (filename
)->data
, 0)) < 0
2599 || fstat (fd
, &st
) < 0)
2600 #endif /* not APOLLO */
2602 if (fd
>= 0) close (fd
);
2605 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2612 /* This code will need to be changed in order to work on named
2613 pipes, and it's probably just not worth it. So we should at
2614 least signal an error. */
2615 if (!S_ISREG (st
.st_mode
))
2616 Fsignal (Qfile_error
,
2617 Fcons (build_string ("not a regular file"),
2618 Fcons (filename
, Qnil
)));
2622 if ((fd
= open (XSTRING (filename
)->data
, 0)) < 0)
2625 /* Replacement should preserve point as it preserves markers. */
2626 if (!NILP (replace
))
2627 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
2629 record_unwind_protect (close_file_unwind
, make_number (fd
));
2631 /* Supposedly happens on VMS. */
2633 error ("File size is negative");
2635 if (!NILP (beg
) || !NILP (end
))
2637 error ("Attempt to visit less than an entire file");
2640 CHECK_NUMBER (beg
, 0);
2645 CHECK_NUMBER (end
, 0);
2648 XSETINT (end
, st
.st_size
);
2649 if (XINT (end
) != st
.st_size
)
2650 error ("maximum buffer size exceeded");
2653 /* If requested, replace the accessible part of the buffer
2654 with the file contents. Avoid replacing text at the
2655 beginning or end of the buffer that matches the file contents;
2656 that preserves markers pointing to the unchanged parts. */
2658 /* On MSDOS, replace mode doesn't really work, except for binary files,
2659 and it's not worth supporting just for them. */
2660 if (!NILP (replace
))
2664 XFASTINT (end
) = st
.st_size
;
2665 del_range_1 (BEGV
, ZV
, 0);
2668 if (!NILP (replace
))
2670 unsigned char buffer
[1 << 14];
2671 int same_at_start
= BEGV
;
2672 int same_at_end
= ZV
;
2677 /* Count how many chars at the start of the file
2678 match the text at the beginning of the buffer. */
2683 nread
= read (fd
, buffer
, sizeof buffer
);
2685 error ("IO error reading %s: %s",
2686 XSTRING (filename
)->data
, strerror (errno
));
2687 else if (nread
== 0)
2690 while (bufpos
< nread
&& same_at_start
< ZV
2691 && FETCH_CHAR (same_at_start
) == buffer
[bufpos
])
2692 same_at_start
++, bufpos
++;
2693 /* If we found a discrepancy, stop the scan.
2694 Otherwise loop around and scan the next bufferfull. */
2695 if (bufpos
!= nread
)
2699 /* If the file matches the buffer completely,
2700 there's no need to replace anything. */
2701 if (same_at_start
- BEGV
== st
.st_size
)
2705 /* Truncate the buffer to the size of the file. */
2706 del_range_1 (same_at_start
, same_at_end
, 0);
2711 /* Count how many chars at the end of the file
2712 match the text at the end of the buffer. */
2715 int total_read
, nread
, bufpos
, curpos
, trial
;
2717 /* At what file position are we now scanning? */
2718 curpos
= st
.st_size
- (ZV
- same_at_end
);
2719 /* If the entire file matches the buffer tail, stop the scan. */
2722 /* How much can we scan in the next step? */
2723 trial
= min (curpos
, sizeof buffer
);
2724 if (lseek (fd
, curpos
- trial
, 0) < 0)
2725 report_file_error ("Setting file position",
2726 Fcons (filename
, Qnil
));
2729 while (total_read
< trial
)
2731 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
2733 error ("IO error reading %s: %s",
2734 XSTRING (filename
)->data
, strerror (errno
));
2735 total_read
+= nread
;
2737 /* Scan this bufferfull from the end, comparing with
2738 the Emacs buffer. */
2739 bufpos
= total_read
;
2740 /* Compare with same_at_start to avoid counting some buffer text
2741 as matching both at the file's beginning and at the end. */
2742 while (bufpos
> 0 && same_at_end
> same_at_start
2743 && FETCH_CHAR (same_at_end
- 1) == buffer
[bufpos
- 1])
2744 same_at_end
--, bufpos
--;
2745 /* If we found a discrepancy, stop the scan.
2746 Otherwise loop around and scan the preceding bufferfull. */
2752 /* Don't try to reuse the same piece of text twice. */
2753 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
2755 same_at_end
+= overlap
;
2757 /* Arrange to read only the nonmatching middle part of the file. */
2758 XFASTINT (beg
) = same_at_start
- BEGV
;
2759 XFASTINT (end
) = st
.st_size
- (ZV
- same_at_end
);
2761 del_range_1 (same_at_start
, same_at_end
, 0);
2762 /* Insert from the file at the proper position. */
2763 SET_PT (same_at_start
);
2767 total
= XINT (end
) - XINT (beg
);
2770 register Lisp_Object temp
;
2772 /* Make sure point-max won't overflow after this insertion. */
2773 XSET (temp
, Lisp_Int
, total
);
2774 if (total
!= XINT (temp
))
2775 error ("maximum buffer size exceeded");
2778 if (NILP (visit
) && total
> 0)
2779 prepare_to_modify_buffer (point
, point
);
2782 if (GAP_SIZE
< total
)
2783 make_gap (total
- GAP_SIZE
);
2785 if (XINT (beg
) != 0 || !NILP (replace
))
2787 if (lseek (fd
, XINT (beg
), 0) < 0)
2788 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
2792 while (inserted
< total
)
2794 int try = min (total
- inserted
, 64 << 10);
2797 /* Allow quitting out of the actual I/O. */
2800 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, try);
2817 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
2818 /* Determine file type from name and remove LFs from CR-LFs if the file
2819 is deemed to be a text file. */
2821 struct gcpro gcpro1
;
2825 current_buffer
->buffer_file_type
2826 = call1 (Qfind_buffer_file_type
, filename
);
2828 if (NILP (current_buffer
->buffer_file_type
))
2831 = inserted
- crlf_to_lf (inserted
, &FETCH_CHAR (point
- 1) + 1);
2834 GPT
-= reduced_size
;
2835 GAP_SIZE
+= reduced_size
;
2836 inserted
-= reduced_size
;
2843 record_insert (point
, inserted
);
2845 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
2846 offset_intervals (current_buffer
, point
, inserted
);
2852 /* Discard the unwind protect for closing the file. */
2856 error ("IO error reading %s: %s",
2857 XSTRING (filename
)->data
, strerror (errno
));
2864 if (!EQ (current_buffer
->undo_list
, Qt
))
2865 current_buffer
->undo_list
= Qnil
;
2867 stat (XSTRING (filename
)->data
, &st
);
2872 current_buffer
->modtime
= st
.st_mtime
;
2873 current_buffer
->filename
= filename
;
2876 current_buffer
->save_modified
= MODIFF
;
2877 current_buffer
->auto_save_modified
= MODIFF
;
2878 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2879 #ifdef CLASH_DETECTION
2882 if (!NILP (current_buffer
->filename
))
2883 unlock_file (current_buffer
->filename
);
2884 unlock_file (filename
);
2886 #endif /* CLASH_DETECTION */
2887 /* If visiting nonexistent file, return nil. */
2888 if (current_buffer
->modtime
== -1)
2889 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
2892 if (inserted
> 0 && NILP (visit
) && total
> 0)
2893 signal_after_change (point
, 0, inserted
);
2897 p
= Vafter_insert_file_functions
;
2900 insval
= call1 (Fcar (p
), make_number (inserted
));
2903 CHECK_NUMBER (insval
, 0);
2904 inserted
= XFASTINT (insval
);
2912 val
= Fcons (filename
,
2913 Fcons (make_number (inserted
),
2916 RETURN_UNGCPRO (unbind_to (count
, val
));
2919 static Lisp_Object
build_annotations ();
2921 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 5,
2922 "r\nFWrite region to file: ",
2923 "Write current region into specified file.\n\
2924 When called from a program, takes three arguments:\n\
2925 START, END and FILENAME. START and END are buffer positions.\n\
2926 Optional fourth argument APPEND if non-nil means\n\
2927 append to existing file contents (if any).\n\
2928 Optional fifth argument VISIT if t means\n\
2929 set the last-save-file-modtime of buffer to this file's modtime\n\
2930 and mark buffer not modified.\n\
2931 If VISIT is a string, it is a second file name;\n\
2932 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
2933 VISIT is also the file name to lock and unlock for clash detection.\n\
2934 If VISIT is neither t nor nil nor a string,\n\
2935 that means do not print the \"Wrote file\" message.\n\
2936 Kludgy feature: if START is a string, then that string is written\n\
2937 to the file, instead of any buffer contents, and END is ignored.")
2938 (start
, end
, filename
, append
, visit
)
2939 Lisp_Object start
, end
, filename
, append
, visit
;
2947 int count
= specpdl_ptr
- specpdl
;
2949 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
2951 Lisp_Object handler
;
2952 Lisp_Object visit_file
;
2953 Lisp_Object annotations
;
2954 int visiting
, quietly
;
2955 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2957 int buffer_file_type
2958 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
2961 if (!NILP (start
) && !STRINGP (start
))
2962 validate_region (&start
, &end
);
2964 filename
= Fexpand_file_name (filename
, Qnil
);
2965 if (STRINGP (visit
))
2966 visit_file
= Fexpand_file_name (visit
, Qnil
);
2968 visit_file
= filename
;
2970 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
2971 quietly
= !NILP (visit
);
2975 GCPRO4 (start
, filename
, annotations
, visit_file
);
2977 /* If the file name has special constructs in it,
2978 call the corresponding file handler. */
2979 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
2980 /* If FILENAME has no handler, see if VISIT has one. */
2981 if (NILP (handler
) && XTYPE (visit
) == Lisp_String
)
2982 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
2984 if (!NILP (handler
))
2987 val
= call6 (handler
, Qwrite_region
, start
, end
,
2988 filename
, append
, visit
);
2992 current_buffer
->save_modified
= MODIFF
;
2993 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
2994 current_buffer
->filename
= visit_file
;
3000 /* Special kludge to simplify auto-saving. */
3003 XFASTINT (start
) = BEG
;
3007 annotations
= build_annotations (start
, end
);
3009 #ifdef CLASH_DETECTION
3011 lock_file (visit_file
);
3012 #endif /* CLASH_DETECTION */
3014 fn
= XSTRING (filename
)->data
;
3018 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
3020 desc
= open (fn
, O_WRONLY
);
3025 if (auto_saving
) /* Overwrite any previous version of autosave file */
3027 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3028 desc
= open (fn
, O_RDWR
);
3030 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3031 ? XSTRING (current_buffer
->filename
)->data
: 0,
3034 else /* Write to temporary name and rename if no errors */
3036 Lisp_Object temp_name
;
3037 temp_name
= Ffile_name_directory (filename
);
3039 if (!NILP (temp_name
))
3041 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3042 build_string ("$$SAVE$$")));
3043 fname
= XSTRING (filename
)->data
;
3044 fn
= XSTRING (temp_name
)->data
;
3045 desc
= creat_copy_attrs (fname
, fn
);
3048 /* If we can't open the temporary file, try creating a new
3049 version of the original file. VMS "creat" creates a
3050 new version rather than truncating an existing file. */
3053 desc
= creat (fn
, 0666);
3054 #if 0 /* This can clobber an existing file and fail to replace it,
3055 if the user runs out of space. */
3058 /* We can't make a new version;
3059 try to truncate and rewrite existing version if any. */
3061 desc
= open (fn
, O_RDWR
);
3067 desc
= creat (fn
, 0666);
3072 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3073 S_IREAD
| S_IWRITE
);
3074 #else /* not MSDOS */
3075 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3076 #endif /* not MSDOS */
3077 #endif /* not VMS */
3083 #ifdef CLASH_DETECTION
3085 if (!auto_saving
) unlock_file (visit_file
);
3087 #endif /* CLASH_DETECTION */
3088 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
3091 record_unwind_protect (close_file_unwind
, make_number (desc
));
3094 if (lseek (desc
, 0, 2) < 0)
3096 #ifdef CLASH_DETECTION
3097 if (!auto_saving
) unlock_file (visit_file
);
3098 #endif /* CLASH_DETECTION */
3099 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
3104 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3105 * if we do writes that don't end with a carriage return. Furthermore
3106 * it cannot handle writes of more then 16K. The modified
3107 * version of "sys_write" in SYSDEP.C (see comment there) copes with
3108 * this EXCEPT for the last record (iff it doesn't end with a carriage
3109 * return). This implies that if your buffer doesn't end with a carriage
3110 * return, you get one free... tough. However it also means that if
3111 * we make two calls to sys_write (a la the following code) you can
3112 * get one at the gap as well. The easiest way to fix this (honest)
3113 * is to move the gap to the next newline (or the end of the buffer).
3118 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
3119 move_gap (find_next_newline (GPT
, 1));
3125 if (STRINGP (start
))
3127 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
3128 XSTRING (start
)->size
, 0, &annotations
);
3131 else if (XINT (start
) != XINT (end
))
3134 if (XINT (start
) < GPT
)
3136 register int end1
= XINT (end
);
3138 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
),
3139 min (GPT
, end1
) - tem
, tem
, &annotations
);
3140 nwritten
+= min (GPT
, end1
) - tem
;
3144 if (XINT (end
) > GPT
&& !failure
)
3147 tem
= max (tem
, GPT
);
3148 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
,
3150 nwritten
+= XINT (end
) - tem
;
3156 /* If file was empty, still need to write the annotations */
3157 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
);
3165 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3166 Disk full in NFS may be reported here. */
3167 /* mib says that closing the file will try to write as fast as NFS can do
3168 it, and that means the fsync here is not crucial for autosave files. */
3169 if (!auto_saving
&& fsync (desc
) < 0)
3170 failure
= 1, save_errno
= errno
;
3173 /* Spurious "file has changed on disk" warnings have been
3174 observed on Suns as well.
3175 It seems that `close' can change the modtime, under nfs.
3177 (This has supposedly been fixed in Sunos 4,
3178 but who knows about all the other machines with NFS?) */
3181 /* On VMS and APOLLO, must do the stat after the close
3182 since closing changes the modtime. */
3185 /* Recall that #if defined does not work on VMS. */
3192 /* NFS can report a write failure now. */
3193 if (close (desc
) < 0)
3194 failure
= 1, save_errno
= errno
;
3197 /* If we wrote to a temporary name and had no errors, rename to real name. */
3201 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
3209 /* Discard the unwind protect */
3210 specpdl_ptr
= specpdl
+ count
;
3212 #ifdef CLASH_DETECTION
3214 unlock_file (visit_file
);
3215 #endif /* CLASH_DETECTION */
3217 /* Do this before reporting IO error
3218 to avoid a "file has changed on disk" warning on
3219 next attempt to save. */
3221 current_buffer
->modtime
= st
.st_mtime
;
3224 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
3228 current_buffer
->save_modified
= MODIFF
;
3229 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3230 current_buffer
->filename
= visit_file
;
3231 update_mode_lines
++;
3237 message ("Wrote %s", XSTRING (visit_file
)->data
);
3242 Lisp_Object
merge ();
3244 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
3245 "Return t if (car A) is numerically less than (car B).")
3249 return Flss (Fcar (a
), Fcar (b
));
3252 /* Build the complete list of annotations appropriate for writing out
3253 the text between START and END, by calling all the functions in
3254 write-region-annotate-functions and merging the lists they return. */
3257 build_annotations (start
, end
)
3258 Lisp_Object start
, end
;
3260 Lisp_Object annotations
;
3262 struct gcpro gcpro1
, gcpro2
;
3265 p
= Vwrite_region_annotate_functions
;
3266 GCPRO2 (annotations
, p
);
3269 res
= call2 (Fcar (p
), start
, end
);
3270 Flength (res
); /* Check basic validity of return value */
3271 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3278 /* Write to descriptor DESC the LEN characters starting at ADDR,
3279 assuming they start at position POS in the buffer.
3280 Intersperse with them the annotations from *ANNOT
3281 (those which fall within the range of positions POS to POS + LEN),
3282 each at its appropriate position.
3284 Modify *ANNOT by discarding elements as we output them.
3285 The return value is negative in case of system call failure. */
3288 a_write (desc
, addr
, len
, pos
, annot
)
3290 register char *addr
;
3297 int lastpos
= pos
+ len
;
3299 while (CONSP (*annot
))
3301 tem
= Fcar_safe (Fcar (*annot
));
3302 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
3303 nextpos
= XFASTINT (tem
);
3305 return e_write (desc
, addr
, lastpos
- pos
);
3308 if (0 > e_write (desc
, addr
, nextpos
- pos
))
3310 addr
+= nextpos
- pos
;
3313 tem
= Fcdr (Fcar (*annot
));
3316 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
))
3319 *annot
= Fcdr (*annot
);
3324 e_write (desc
, addr
, len
)
3326 register char *addr
;
3329 char buf
[16 * 1024];
3330 register char *p
, *end
;
3332 if (!EQ (current_buffer
->selective_display
, Qt
))
3333 return write (desc
, addr
, len
) - len
;
3337 end
= p
+ sizeof buf
;
3342 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
3351 if (write (desc
, buf
, p
- buf
) != p
- buf
)
3357 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
3358 Sverify_visited_file_modtime
, 1, 1, 0,
3359 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
3360 This means that the file has not been changed since it was visited or saved.")
3366 Lisp_Object handler
;
3368 CHECK_BUFFER (buf
, 0);
3371 if (XTYPE (b
->filename
) != Lisp_String
) return Qt
;
3372 if (b
->modtime
== 0) return Qt
;
3374 /* If the file name has special constructs in it,
3375 call the corresponding file handler. */
3376 handler
= Ffind_file_name_handler (b
->filename
,
3377 Qverify_visited_file_modtime
);
3378 if (!NILP (handler
))
3379 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
3381 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
3383 /* If the file doesn't exist now and didn't exist before,
3384 we say that it isn't modified, provided the error is a tame one. */
3385 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
3390 if (st
.st_mtime
== b
->modtime
3391 /* If both are positive, accept them if they are off by one second. */
3392 || (st
.st_mtime
> 0 && b
->modtime
> 0
3393 && (st
.st_mtime
== b
->modtime
+ 1
3394 || st
.st_mtime
== b
->modtime
- 1)))
3399 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
3400 Sclear_visited_file_modtime
, 0, 0, 0,
3401 "Clear out records of last mod time of visited file.\n\
3402 Next attempt to save will certainly not complain of a discrepancy.")
3405 current_buffer
->modtime
= 0;
3409 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
3410 Svisited_file_modtime
, 0, 0, 0,
3411 "Return the current buffer's recorded visited file modification time.\n\
3412 The value is a list of the form (HIGH . LOW), like the time values\n\
3413 that `file-attributes' returns.")
3416 return long_to_cons (current_buffer
->modtime
);
3419 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
3420 Sset_visited_file_modtime
, 0, 1, 0,
3421 "Update buffer's recorded modification time from the visited file's time.\n\
3422 Useful if the buffer was not read from the file normally\n\
3423 or if the file itself has been changed for some known benign reason.\n\
3424 An argument specifies the modification time value to use\n\
3425 \(instead of that of the visited file), in the form of a list\n\
3426 \(HIGH . LOW) or (HIGH LOW).")
3428 Lisp_Object time_list
;
3430 if (!NILP (time_list
))
3431 current_buffer
->modtime
= cons_to_long (time_list
);
3434 register Lisp_Object filename
;
3436 Lisp_Object handler
;
3438 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
3440 /* If the file name has special constructs in it,
3441 call the corresponding file handler. */
3442 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
3443 if (!NILP (handler
))
3444 /* The handler can find the file name the same way we did. */
3445 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
3446 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
3447 current_buffer
->modtime
= st
.st_mtime
;
3456 unsigned char *name
= XSTRING (current_buffer
->name
)->data
;
3459 message ("Autosaving...error for %s", name
);
3460 Fsleep_for (make_number (1), Qnil
);
3461 message ("Autosaving...error!for %s", name
);
3462 Fsleep_for (make_number (1), Qnil
);
3463 message ("Autosaving...error for %s", name
);
3464 Fsleep_for (make_number (1), Qnil
);
3474 /* Get visited file's mode to become the auto save file's mode. */
3475 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
3476 /* But make sure we can overwrite it later! */
3477 auto_save_mode_bits
= st
.st_mode
| 0600;
3479 auto_save_mode_bits
= 0666;
3482 Fwrite_region (Qnil
, Qnil
,
3483 current_buffer
->auto_save_file_name
,
3488 do_auto_save_unwind (desc
) /* used as unwind-protect function */
3491 close (XINT (desc
));
3495 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
3496 "Auto-save all buffers that need it.\n\
3497 This is all buffers that have auto-saving enabled\n\
3498 and are changed since last auto-saved.\n\
3499 Auto-saving writes the buffer into a file\n\
3500 so that your editing is not lost if the system crashes.\n\
3501 This file is not the file you visited; that changes only when you save.\n\
3502 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
3503 Non-nil first argument means do not print any message if successful.\n\
3504 Non-nil second argument means save only current buffer.")
3505 (no_message
, current_only
)
3506 Lisp_Object no_message
, current_only
;
3508 struct buffer
*old
= current_buffer
, *b
;
3509 Lisp_Object tail
, buf
;
3511 char *omessage
= echo_area_glyphs
;
3512 int omessage_length
= echo_area_glyphs_length
;
3513 extern int minibuf_level
;
3514 int do_handled_files
;
3517 Lisp_Object lispstream
;
3518 int count
= specpdl_ptr
- specpdl
;
3521 /* Ordinarily don't quit within this function,
3522 but don't make it impossible to quit (in case we get hung in I/O). */
3526 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
3527 point to non-strings reached from Vbuffer_alist. */
3533 if (!NILP (Vrun_hooks
))
3534 call1 (Vrun_hooks
, intern ("auto-save-hook"));
3536 if (STRINGP (Vauto_save_list_file_name
))
3539 listdesc
= open (XSTRING (Vauto_save_list_file_name
)->data
,
3540 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
3541 S_IREAD
| S_IWRITE
);
3542 #else /* not MSDOS */
3543 listdesc
= creat (XSTRING (Vauto_save_list_file_name
)->data
, 0666);
3544 #endif /* not MSDOS */
3549 /* Arrange to close that file whether or not we get an error. */
3551 record_unwind_protect (do_auto_save_unwind
, make_number (listdesc
));
3553 /* First, save all files which don't have handlers. If Emacs is
3554 crashing, the handlers may tweak what is causing Emacs to crash
3555 in the first place, and it would be a shame if Emacs failed to
3556 autosave perfectly ordinary files because it couldn't handle some
3558 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
3559 for (tail
= Vbuffer_alist
; XGCTYPE (tail
) == Lisp_Cons
;
3560 tail
= XCONS (tail
)->cdr
)
3562 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
3565 /* Record all the buffers that have auto save mode
3566 in the special file that lists them. */
3567 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
3568 && listdesc
>= 0 && do_handled_files
== 0)
3570 write (listdesc
, XSTRING (b
->auto_save_file_name
)->data
,
3571 XSTRING (b
->auto_save_file_name
)->size
);
3572 write (listdesc
, "\n", 1);
3575 if (!NILP (current_only
)
3576 && b
!= current_buffer
)
3579 /* Check for auto save enabled
3580 and file changed since last auto save
3581 and file changed since last real save. */
3582 if (XTYPE (b
->auto_save_file_name
) == Lisp_String
3583 && b
->save_modified
< BUF_MODIFF (b
)
3584 && b
->auto_save_modified
< BUF_MODIFF (b
)
3585 /* -1 means we've turned off autosaving for a while--see below. */
3586 && XINT (b
->save_length
) >= 0
3587 && (do_handled_files
3588 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
3591 EMACS_TIME before_time
, after_time
;
3593 EMACS_GET_TIME (before_time
);
3595 /* If we had a failure, don't try again for 20 minutes. */
3596 if (b
->auto_save_failure_time
>= 0
3597 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
3600 if ((XFASTINT (b
->save_length
) * 10
3601 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
3602 /* A short file is likely to change a large fraction;
3603 spare the user annoying messages. */
3604 && XFASTINT (b
->save_length
) > 5000
3605 /* These messages are frequent and annoying for `*mail*'. */
3606 && !EQ (b
->filename
, Qnil
)
3607 && NILP (no_message
))
3609 /* It has shrunk too much; turn off auto-saving here. */
3610 message ("Buffer %s has shrunk a lot; auto save turned off there",
3611 XSTRING (b
->name
)->data
);
3612 /* Turn off auto-saving until there's a real save,
3613 and prevent any more warnings. */
3614 XSET (b
->save_length
, Lisp_Int
, -1);
3615 Fsleep_for (make_number (1), Qnil
);
3618 set_buffer_internal (b
);
3619 if (!auto_saved
&& NILP (no_message
))
3620 message1 ("Auto-saving...");
3621 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
3623 b
->auto_save_modified
= BUF_MODIFF (b
);
3624 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3625 set_buffer_internal (old
);
3627 EMACS_GET_TIME (after_time
);
3629 /* If auto-save took more than 60 seconds,
3630 assume it was an NFS failure that got a timeout. */
3631 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
3632 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
3636 /* Prevent another auto save till enough input events come in. */
3637 record_auto_save ();
3639 if (auto_saved
&& NILP (no_message
))
3642 message2 (omessage
, omessage_length
);
3644 message1 ("Auto-saving...done");
3650 unbind_to (count
, Qnil
);
3654 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
3655 Sset_buffer_auto_saved
, 0, 0, 0,
3656 "Mark current buffer as auto-saved with its current text.\n\
3657 No auto-save file will be written until the buffer changes again.")
3660 current_buffer
->auto_save_modified
= MODIFF
;
3661 XFASTINT (current_buffer
->save_length
) = Z
- BEG
;
3662 current_buffer
->auto_save_failure_time
= -1;
3666 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
3667 Sclear_buffer_auto_save_failure
, 0, 0, 0,
3668 "Clear any record of a recent auto-save failure in the current buffer.")
3671 current_buffer
->auto_save_failure_time
= -1;
3675 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
3677 "Return t if buffer has been auto-saved since last read in or saved.")
3680 return (current_buffer
->save_modified
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
3683 /* Reading and completing file names */
3684 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
3686 /* In the string VAL, change each $ to $$ and return the result. */
3689 double_dollars (val
)
3692 register unsigned char *old
, *new;
3696 osize
= XSTRING (val
)->size
;
3697 /* Quote "$" as "$$" to get it past substitute-in-file-name */
3698 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
3699 if (*old
++ == '$') count
++;
3702 old
= XSTRING (val
)->data
;
3703 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
3704 new = XSTRING (val
)->data
;
3705 for (n
= osize
; n
> 0; n
--)
3718 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
3720 "Internal subroutine for read-file-name. Do not call this.")
3721 (string
, dir
, action
)
3722 Lisp_Object string
, dir
, action
;
3723 /* action is nil for complete, t for return list of completions,
3724 lambda for verify final value */
3726 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
3728 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3735 /* No need to protect ACTION--we only compare it with t and nil. */
3736 GCPRO4 (string
, realdir
, name
, specdir
);
3738 if (XSTRING (string
)->size
== 0)
3740 if (EQ (action
, Qlambda
))
3748 orig_string
= string
;
3749 string
= Fsubstitute_in_file_name (string
);
3750 changed
= NILP (Fstring_equal (string
, orig_string
));
3751 name
= Ffile_name_nondirectory (string
);
3752 val
= Ffile_name_directory (string
);
3754 realdir
= Fexpand_file_name (val
, realdir
);
3759 specdir
= Ffile_name_directory (string
);
3760 val
= Ffile_name_completion (name
, realdir
);
3762 if (XTYPE (val
) != Lisp_String
)
3769 if (!NILP (specdir
))
3770 val
= concat2 (specdir
, val
);
3772 return double_dollars (val
);
3775 #endif /* not VMS */
3779 if (EQ (action
, Qt
))
3780 return Ffile_name_all_completions (name
, realdir
);
3781 /* Only other case actually used is ACTION = lambda */
3783 /* Supposedly this helps commands such as `cd' that read directory names,
3784 but can someone explain how it helps them? -- RMS */
3785 if (XSTRING (name
)->size
== 0)
3788 return Ffile_exists_p (string
);
3791 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3792 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
3793 Value is not expanded---you must call `expand-file-name' yourself.\n\
3794 Default name to DEFAULT if user enters a null string.\n\
3795 (If DEFAULT is omitted, the visited file name is used.)\n\
3796 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
3797 Non-nil and non-t means also require confirmation after completion.\n\
3798 Fifth arg INITIAL specifies text to start with.\n\
3799 DIR defaults to current buffer's directory default.")
3800 (prompt
, dir
, defalt
, mustmatch
, initial
)
3801 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3803 Lisp_Object val
, insdef
, insdef1
, tem
;
3804 struct gcpro gcpro1
, gcpro2
;
3805 register char *homedir
;
3809 dir
= current_buffer
->directory
;
3811 defalt
= current_buffer
->filename
;
3813 /* If dir starts with user's homedir, change that to ~. */
3814 homedir
= (char *) egetenv ("HOME");
3816 && XTYPE (dir
) == Lisp_String
3817 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3818 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3820 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3821 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3822 XSTRING (dir
)->data
[0] = '~';
3825 if (insert_default_directory
)
3828 if (!NILP (initial
))
3830 Lisp_Object args
[2], pos
;
3834 insdef
= Fconcat (2, args
);
3835 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
3836 insdef1
= Fcons (double_dollars (insdef
), pos
);
3839 insdef1
= double_dollars (insdef
);
3841 else if (!NILP (initial
))
3844 insdef1
= Fcons (double_dollars (insdef
), 0);
3847 insdef
= Qnil
, insdef1
= Qnil
;
3850 count
= specpdl_ptr
- specpdl
;
3851 specbind (intern ("completion-ignore-case"), Qt
);
3854 GCPRO2 (insdef
, defalt
);
3855 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3856 dir
, mustmatch
, insdef1
,
3857 Qfile_name_history
);
3860 unbind_to (count
, Qnil
);
3865 error ("No file name specified");
3866 tem
= Fstring_equal (val
, insdef
);
3867 if (!NILP (tem
) && !NILP (defalt
))
3869 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
3874 error ("No default file name");
3876 return Fsubstitute_in_file_name (val
);
3879 #if 0 /* Old version */
3880 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
3881 /* Don't confuse make-docfile by having two doc strings for this function.
3882 make-docfile does not pay attention to #if, for good reason! */
3884 (prompt
, dir
, defalt
, mustmatch
, initial
)
3885 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
3887 Lisp_Object val
, insdef
, tem
;
3888 struct gcpro gcpro1
, gcpro2
;
3889 register char *homedir
;
3893 dir
= current_buffer
->directory
;
3895 defalt
= current_buffer
->filename
;
3897 /* If dir starts with user's homedir, change that to ~. */
3898 homedir
= (char *) egetenv ("HOME");
3900 && XTYPE (dir
) == Lisp_String
3901 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
3902 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
3904 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
3905 XSTRING (dir
)->size
- strlen (homedir
) + 1);
3906 XSTRING (dir
)->data
[0] = '~';
3909 if (!NILP (initial
))
3911 else if (insert_default_directory
)
3914 insdef
= build_string ("");
3917 count
= specpdl_ptr
- specpdl
;
3918 specbind (intern ("completion-ignore-case"), Qt
);
3921 GCPRO2 (insdef
, defalt
);
3922 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
3924 insert_default_directory
? insdef
: Qnil
,
3925 Qfile_name_history
);
3928 unbind_to (count
, Qnil
);
3933 error ("No file name specified");
3934 tem
= Fstring_equal (val
, insdef
);
3935 if (!NILP (tem
) && !NILP (defalt
))
3937 return Fsubstitute_in_file_name (val
);
3939 #endif /* Old version */
3943 Qexpand_file_name
= intern ("expand-file-name");
3944 Qdirectory_file_name
= intern ("directory-file-name");
3945 Qfile_name_directory
= intern ("file-name-directory");
3946 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
3947 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
3948 Qfile_name_as_directory
= intern ("file-name-as-directory");
3949 Qcopy_file
= intern ("copy-file");
3950 Qmake_directory
= intern ("make-directory");
3951 Qdelete_directory
= intern ("delete-directory");
3952 Qdelete_file
= intern ("delete-file");
3953 Qrename_file
= intern ("rename-file");
3954 Qadd_name_to_file
= intern ("add-name-to-file");
3955 Qmake_symbolic_link
= intern ("make-symbolic-link");
3956 Qfile_exists_p
= intern ("file-exists-p");
3957 Qfile_executable_p
= intern ("file-executable-p");
3958 Qfile_readable_p
= intern ("file-readable-p");
3959 Qfile_symlink_p
= intern ("file-symlink-p");
3960 Qfile_writable_p
= intern ("file-writable-p");
3961 Qfile_directory_p
= intern ("file-directory-p");
3962 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
3963 Qfile_modes
= intern ("file-modes");
3964 Qset_file_modes
= intern ("set-file-modes");
3965 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
3966 Qinsert_file_contents
= intern ("insert-file-contents");
3967 Qwrite_region
= intern ("write-region");
3968 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
3969 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
3971 staticpro (&Qexpand_file_name
);
3972 staticpro (&Qdirectory_file_name
);
3973 staticpro (&Qfile_name_directory
);
3974 staticpro (&Qfile_name_nondirectory
);
3975 staticpro (&Qunhandled_file_name_directory
);
3976 staticpro (&Qfile_name_as_directory
);
3977 staticpro (&Qcopy_file
);
3978 staticpro (&Qmake_directory
);
3979 staticpro (&Qdelete_directory
);
3980 staticpro (&Qdelete_file
);
3981 staticpro (&Qrename_file
);
3982 staticpro (&Qadd_name_to_file
);
3983 staticpro (&Qmake_symbolic_link
);
3984 staticpro (&Qfile_exists_p
);
3985 staticpro (&Qfile_executable_p
);
3986 staticpro (&Qfile_readable_p
);
3987 staticpro (&Qfile_symlink_p
);
3988 staticpro (&Qfile_writable_p
);
3989 staticpro (&Qfile_directory_p
);
3990 staticpro (&Qfile_accessible_directory_p
);
3991 staticpro (&Qfile_modes
);
3992 staticpro (&Qset_file_modes
);
3993 staticpro (&Qfile_newer_than_file_p
);
3994 staticpro (&Qinsert_file_contents
);
3995 staticpro (&Qwrite_region
);
3996 staticpro (&Qverify_visited_file_modtime
);
3998 Qfile_name_history
= intern ("file-name-history");
3999 Fset (Qfile_name_history
, Qnil
);
4000 staticpro (&Qfile_name_history
);
4002 Qfile_error
= intern ("file-error");
4003 staticpro (&Qfile_error
);
4004 Qfile_already_exists
= intern("file-already-exists");
4005 staticpro (&Qfile_already_exists
);
4008 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
4009 staticpro (&Qfind_buffer_file_type
);
4012 Qcar_less_than_car
= intern ("car-less-than-car");
4013 staticpro (&Qcar_less_than_car
);
4015 Fput (Qfile_error
, Qerror_conditions
,
4016 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
4017 Fput (Qfile_error
, Qerror_message
,
4018 build_string ("File error"));
4020 Fput (Qfile_already_exists
, Qerror_conditions
,
4021 Fcons (Qfile_already_exists
,
4022 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
4023 Fput (Qfile_already_exists
, Qerror_message
,
4024 build_string ("File already exists"));
4026 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
4027 "*Non-nil means when reading a filename start with default dir in minibuffer.");
4028 insert_default_directory
= 1;
4030 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
4031 "*Non-nil means write new files with record format `stmlf'.\n\
4032 nil means use format `var'. This variable is meaningful only on VMS.");
4033 vms_stmlf_recfm
= 0;
4035 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
4036 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
4037 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
4040 The first argument given to HANDLER is the name of the I/O primitive\n\
4041 to be handled; the remaining arguments are the arguments that were\n\
4042 passed to that primitive. For example, if you do\n\
4043 (file-exists-p FILENAME)\n\
4044 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
4045 (funcall HANDLER 'file-exists-p FILENAME)\n\
4046 The function `find-file-name-handler' checks this list for a handler\n\
4047 for its argument.");
4048 Vfile_name_handler_alist
= Qnil
;
4050 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
4051 "A list of functions to be called at the end of `insert-file-contents'.\n\
4052 Each is passed one argument, the number of bytes inserted. It should return\n\
4053 the new byte count, and leave point the same. If `insert-file-contents' is\n\
4054 intercepted by a handler from `file-name-handler-alist', that handler is\n\
4055 responsible for calling the after-insert-file-functions if appropriate.");
4056 Vafter_insert_file_functions
= Qnil
;
4058 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
4059 "A list of functions to be called at the start of `write-region'.\n\
4060 Each is passed two arguments, START and END as for `write-region'. It should\n\
4061 return a list of pairs (POSITION . STRING) of strings to be effectively\n\
4062 inserted at the specified positions of the file being written (1 means to\n\
4063 insert before the first byte written). The POSITIONs must be sorted into\n\
4064 increasing order. If there are several functions in the list, the several\n\
4065 lists are merged destructively.");
4066 Vwrite_region_annotate_functions
= Qnil
;
4068 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
4069 "A list of file name handlers that temporarily should not be used.\n\
4070 This applies only to the operation `inhibit-file-name-operation'.");
4071 Vinhibit_file_name_handlers
= Qnil
;
4073 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
4074 "The operation for which `inhibit-file-name-handlers' is applicable.");
4075 Vinhibit_file_name_operation
= Qnil
;
4077 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
4078 "File name in which we write a list of all auto save file names.");
4079 Vauto_save_list_file_name
= Qnil
;
4081 defsubr (&Sfind_file_name_handler
);
4082 defsubr (&Sfile_name_directory
);
4083 defsubr (&Sfile_name_nondirectory
);
4084 defsubr (&Sunhandled_file_name_directory
);
4085 defsubr (&Sfile_name_as_directory
);
4086 defsubr (&Sdirectory_file_name
);
4087 defsubr (&Smake_temp_name
);
4088 defsubr (&Sexpand_file_name
);
4089 defsubr (&Ssubstitute_in_file_name
);
4090 defsubr (&Scopy_file
);
4091 defsubr (&Smake_directory_internal
);
4092 defsubr (&Sdelete_directory
);
4093 defsubr (&Sdelete_file
);
4094 defsubr (&Srename_file
);
4095 defsubr (&Sadd_name_to_file
);
4097 defsubr (&Smake_symbolic_link
);
4098 #endif /* S_IFLNK */
4100 defsubr (&Sdefine_logical_name
);
4103 defsubr (&Ssysnetunam
);
4104 #endif /* HPUX_NET */
4105 defsubr (&Sfile_name_absolute_p
);
4106 defsubr (&Sfile_exists_p
);
4107 defsubr (&Sfile_executable_p
);
4108 defsubr (&Sfile_readable_p
);
4109 defsubr (&Sfile_writable_p
);
4110 defsubr (&Sfile_symlink_p
);
4111 defsubr (&Sfile_directory_p
);
4112 defsubr (&Sfile_accessible_directory_p
);
4113 defsubr (&Sfile_modes
);
4114 defsubr (&Sset_file_modes
);
4115 defsubr (&Sset_default_file_modes
);
4116 defsubr (&Sdefault_file_modes
);
4117 defsubr (&Sfile_newer_than_file_p
);
4118 defsubr (&Sinsert_file_contents
);
4119 defsubr (&Swrite_region
);
4120 defsubr (&Scar_less_than_car
);
4121 defsubr (&Sverify_visited_file_modtime
);
4122 defsubr (&Sclear_visited_file_modtime
);
4123 defsubr (&Svisited_file_modtime
);
4124 defsubr (&Sset_visited_file_modtime
);
4125 defsubr (&Sdo_auto_save
);
4126 defsubr (&Sset_buffer_auto_saved
);
4127 defsubr (&Sclear_buffer_auto_save_failure
);
4128 defsubr (&Srecent_auto_save_p
);
4130 defsubr (&Sread_file_name_internal
);
4131 defsubr (&Sread_file_name
);
4134 defsubr (&Sunix_sync
);