1 /* File IO for GNU Emacs.
2 Copyright (C) 1985,86,87,88,93,94,95,96,97,1998 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, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
23 #if defined (USG5) || defined (BSD_SYSTEM) || defined (LINUX)
28 #include <sys/types.h>
35 #if !defined (S_ISLNK) && defined (S_IFLNK)
36 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
39 #if !defined (S_ISFIFO) && defined (S_IFIFO)
40 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
43 #if !defined (S_ISREG) && defined (S_IFREG)
44 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
68 extern char *strerror ();
85 #include "intervals.h"
96 #endif /* not WINDOWSNT */
100 #include <sys/param.h>
108 #define CORRECT_DIR_SEPS(s) \
109 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
110 else unixtodos_filename (s); \
112 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
113 redirector allows the six letters between 'Z' and 'a' as well. */
115 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
118 #define IS_DRIVE(x) isalpha (x)
120 /* Need to lower-case the drive letter, or else expanded
121 filenames will sometimes compare inequal, because
122 `expand-file-name' doesn't always down-case the drive letter. */
123 #define DRIVE_LETTER(x) (tolower (x))
152 #define min(a, b) ((a) < (b) ? (a) : (b))
153 #define max(a, b) ((a) > (b) ? (a) : (b))
155 /* Nonzero during writing of auto-save files */
158 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
159 a new file with the same mode as the original */
160 int auto_save_mode_bits
;
162 /* Coding system for file names, or nil if none. */
163 Lisp_Object Vfile_name_coding_system
;
165 /* Coding system for file names used only when
166 Vfile_name_coding_system is nil. */
167 Lisp_Object Vdefault_file_name_coding_system
;
169 /* Alist of elements (REGEXP . HANDLER) for file names
170 whose I/O is done with a special handler. */
171 Lisp_Object Vfile_name_handler_alist
;
173 /* Format for auto-save files */
174 Lisp_Object Vauto_save_file_format
;
176 /* Lisp functions for translating file formats */
177 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
179 /* Function to be called to decide a coding system of a reading file. */
180 Lisp_Object Vset_auto_coding_function
;
182 /* Functions to be called to process text properties in inserted file. */
183 Lisp_Object Vafter_insert_file_functions
;
185 /* Functions to be called to create text property annotations for file. */
186 Lisp_Object Vwrite_region_annotate_functions
;
188 /* During build_annotations, each time an annotation function is called,
189 this holds the annotations made by the previous functions. */
190 Lisp_Object Vwrite_region_annotations_so_far
;
192 /* File name in which we write a list of all our auto save files. */
193 Lisp_Object Vauto_save_list_file_name
;
195 /* Nonzero means, when reading a filename in the minibuffer,
196 start out by inserting the default directory into the minibuffer. */
197 int insert_default_directory
;
199 /* On VMS, nonzero means write new files with record format stmlf.
200 Zero means use var format. */
203 /* On NT, specifies the directory separator character, used (eg.) when
204 expanding file names. This can be bound to / or \. */
205 Lisp_Object Vdirectory_sep_char
;
207 extern Lisp_Object Vuser_login_name
;
209 extern int minibuf_level
;
211 extern int minibuffer_auto_raise
;
213 /* These variables describe handlers that have "already" had a chance
214 to handle the current operation.
216 Vinhibit_file_name_handlers is a list of file name handlers.
217 Vinhibit_file_name_operation is the operation being handled.
218 If we try to handle that operation, we ignore those handlers. */
220 static Lisp_Object Vinhibit_file_name_handlers
;
221 static Lisp_Object Vinhibit_file_name_operation
;
223 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
225 Lisp_Object Qfile_name_history
;
227 Lisp_Object Qcar_less_than_car
;
229 static int a_write
P_ ((int, char *, int, int,
230 Lisp_Object
*, struct coding_system
*));
231 static int e_write
P_ ((int, char *, int, struct coding_system
*));
234 report_file_error (string
, data
)
238 Lisp_Object errstring
;
240 errstring
= build_string (strerror (errno
));
242 /* System error messages are capitalized. Downcase the initial
243 unless it is followed by a slash. */
244 if (XSTRING (errstring
)->data
[1] != '/')
245 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
248 Fsignal (Qfile_error
,
249 Fcons (build_string (string
), Fcons (errstring
, data
)));
253 close_file_unwind (fd
)
256 close (XFASTINT (fd
));
260 /* Restore point, having saved it as a marker. */
263 restore_point_unwind (location
)
264 Lisp_Object location
;
266 Fgoto_char (location
);
267 Fset_marker (location
, Qnil
, Qnil
);
271 Lisp_Object Qexpand_file_name
;
272 Lisp_Object Qsubstitute_in_file_name
;
273 Lisp_Object Qdirectory_file_name
;
274 Lisp_Object Qfile_name_directory
;
275 Lisp_Object Qfile_name_nondirectory
;
276 Lisp_Object Qunhandled_file_name_directory
;
277 Lisp_Object Qfile_name_as_directory
;
278 Lisp_Object Qcopy_file
;
279 Lisp_Object Qmake_directory_internal
;
280 Lisp_Object Qdelete_directory
;
281 Lisp_Object Qdelete_file
;
282 Lisp_Object Qrename_file
;
283 Lisp_Object Qadd_name_to_file
;
284 Lisp_Object Qmake_symbolic_link
;
285 Lisp_Object Qfile_exists_p
;
286 Lisp_Object Qfile_executable_p
;
287 Lisp_Object Qfile_readable_p
;
288 Lisp_Object Qfile_writable_p
;
289 Lisp_Object Qfile_symlink_p
;
290 Lisp_Object Qaccess_file
;
291 Lisp_Object Qfile_directory_p
;
292 Lisp_Object Qfile_regular_p
;
293 Lisp_Object Qfile_accessible_directory_p
;
294 Lisp_Object Qfile_modes
;
295 Lisp_Object Qset_file_modes
;
296 Lisp_Object Qfile_newer_than_file_p
;
297 Lisp_Object Qinsert_file_contents
;
298 Lisp_Object Qwrite_region
;
299 Lisp_Object Qverify_visited_file_modtime
;
300 Lisp_Object Qset_visited_file_modtime
;
302 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
303 "Return FILENAME's handler function for OPERATION, if it has one.\n\
304 Otherwise, return nil.\n\
305 A file name is handled if one of the regular expressions in\n\
306 `file-name-handler-alist' matches it.\n\n\
307 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
308 any handlers that are members of `inhibit-file-name-handlers',\n\
309 but we still do run any other handlers. This lets handlers\n\
310 use the standard functions without calling themselves recursively.")
311 (filename
, operation
)
312 Lisp_Object filename
, operation
;
314 /* This function must not munge the match data. */
315 Lisp_Object chain
, inhibited_handlers
;
317 CHECK_STRING (filename
, 0);
319 if (EQ (operation
, Vinhibit_file_name_operation
))
320 inhibited_handlers
= Vinhibit_file_name_handlers
;
322 inhibited_handlers
= Qnil
;
324 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
325 chain
= XCONS (chain
)->cdr
)
328 elt
= XCONS (chain
)->car
;
332 string
= XCONS (elt
)->car
;
333 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
335 Lisp_Object handler
, tem
;
337 handler
= XCONS (elt
)->cdr
;
338 tem
= Fmemq (handler
, inhibited_handlers
);
349 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
351 "Return the directory component in file name FILENAME.\n\
352 Return nil if FILENAME does not include a directory.\n\
353 Otherwise return a directory spec.\n\
354 Given a Unix syntax file name, returns a string ending in slash;\n\
355 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
357 Lisp_Object filename
;
359 register unsigned char *beg
;
360 register unsigned char *p
;
363 CHECK_STRING (filename
, 0);
365 /* If the file name has special constructs in it,
366 call the corresponding file handler. */
367 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
369 return call2 (handler
, Qfile_name_directory
, filename
);
371 #ifdef FILE_SYSTEM_CASE
372 filename
= FILE_SYSTEM_CASE (filename
);
374 beg
= XSTRING (filename
)->data
;
376 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
378 p
= beg
+ STRING_BYTES (XSTRING (filename
));
380 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
382 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
385 /* only recognise drive specifier at beginning */
386 && !(p
[-1] == ':' && p
== beg
+ 2)
393 /* Expansion of "c:" to drive and default directory. */
394 if (p
== beg
+ 2 && beg
[1] == ':')
396 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
397 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
398 if (getdefdir (toupper (*beg
) - 'A' + 1, res
))
400 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
403 p
= beg
+ strlen (beg
);
406 CORRECT_DIR_SEPS (beg
);
409 if (STRING_MULTIBYTE (filename
))
410 return make_string (beg
, p
- beg
);
411 return make_unibyte_string (beg
, p
- beg
);
414 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
415 Sfile_name_nondirectory
, 1, 1, 0,
416 "Return file name FILENAME sans its directory.\n\
417 For example, in a Unix-syntax file name,\n\
418 this is everything after the last slash,\n\
419 or the entire name if it contains no slash.")
421 Lisp_Object filename
;
423 register unsigned char *beg
, *p
, *end
;
426 CHECK_STRING (filename
, 0);
428 /* If the file name has special constructs in it,
429 call the corresponding file handler. */
430 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
432 return call2 (handler
, Qfile_name_nondirectory
, filename
);
434 beg
= XSTRING (filename
)->data
;
435 end
= p
= beg
+ STRING_BYTES (XSTRING (filename
));
437 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
439 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
442 /* only recognise drive specifier at beginning */
443 && !(p
[-1] == ':' && p
== beg
+ 2)
448 if (STRING_MULTIBYTE (filename
))
449 return make_string (p
, end
- p
);
450 return make_unibyte_string (p
, end
- p
);
453 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
454 Sunhandled_file_name_directory
, 1, 1, 0,
455 "Return a directly usable directory name somehow associated with FILENAME.\n\
456 A `directly usable' directory name is one that may be used without the\n\
457 intervention of any file handler.\n\
458 If FILENAME is a directly usable file itself, return\n\
459 \(file-name-directory FILENAME).\n\
460 The `call-process' and `start-process' functions use this function to\n\
461 get a current directory to run processes in.")
463 Lisp_Object filename
;
467 /* If the file name has special constructs in it,
468 call the corresponding file handler. */
469 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
471 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
473 return Ffile_name_directory (filename
);
478 file_name_as_directory (out
, in
)
481 int size
= strlen (in
) - 1;
494 /* Is it already a directory string? */
495 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
497 /* Is it a VMS directory file name? If so, hack VMS syntax. */
498 else if (! index (in
, '/')
499 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
500 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
501 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
502 || ! strncmp (&in
[size
- 5], ".dir", 4))
503 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
504 && in
[size
] == '1')))
506 register char *p
, *dot
;
510 dir:x.dir --> dir:[x]
511 dir:[x]y.dir --> dir:[x.y] */
513 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
516 strncpy (out
, in
, p
- in
);
535 dot
= index (p
, '.');
538 /* blindly remove any extension */
539 size
= strlen (out
) + (dot
- p
);
540 strncat (out
, p
, dot
- p
);
551 /* For Unix syntax, Append a slash if necessary */
552 if (!IS_DIRECTORY_SEP (out
[size
]))
554 out
[size
+ 1] = DIRECTORY_SEP
;
555 out
[size
+ 2] = '\0';
558 CORRECT_DIR_SEPS (out
);
564 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
565 Sfile_name_as_directory
, 1, 1, 0,
566 "Return a string representing file FILENAME interpreted as a directory.\n\
567 This operation exists because a directory is also a file, but its name as\n\
568 a directory is different from its name as a file.\n\
569 The result can be used as the value of `default-directory'\n\
570 or passed as second argument to `expand-file-name'.\n\
571 For a Unix-syntax file name, just appends a slash.\n\
572 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
579 CHECK_STRING (file
, 0);
583 /* If the file name has special constructs in it,
584 call the corresponding file handler. */
585 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
587 return call2 (handler
, Qfile_name_as_directory
, file
);
589 buf
= (char *) alloca (STRING_BYTES (XSTRING (file
)) + 10);
590 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
594 * Convert from directory name to filename.
596 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
597 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
598 * On UNIX, it's simple: just make sure there isn't a terminating /
600 * Value is nonzero if the string output is different from the input.
604 directory_file_name (src
, dst
)
612 struct FAB fab
= cc$rms_fab
;
613 struct NAM nam
= cc$rms_nam
;
614 char esa
[NAM$C_MAXRSS
];
619 if (! index (src
, '/')
620 && (src
[slen
- 1] == ']'
621 || src
[slen
- 1] == ':'
622 || src
[slen
- 1] == '>'))
624 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
626 fab
.fab$b_fns
= slen
;
627 fab
.fab$l_nam
= &nam
;
628 fab
.fab$l_fop
= FAB$M_NAM
;
631 nam
.nam$b_ess
= sizeof esa
;
632 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
634 /* We call SYS$PARSE to handle such things as [--] for us. */
635 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
637 slen
= nam
.nam$b_esl
;
638 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
643 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
645 /* what about when we have logical_name:???? */
646 if (src
[slen
- 1] == ':')
647 { /* Xlate logical name and see what we get */
648 ptr
= strcpy (dst
, src
); /* upper case for getenv */
651 if ('a' <= *ptr
&& *ptr
<= 'z')
655 dst
[slen
- 1] = 0; /* remove colon */
656 if (!(src
= egetenv (dst
)))
658 /* should we jump to the beginning of this procedure?
659 Good points: allows us to use logical names that xlate
661 Bad points: can be a problem if we just translated to a device
663 For now, I'll punt and always expect VMS names, and hope for
666 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
667 { /* no recursion here! */
673 { /* not a directory spec */
678 bracket
= src
[slen
- 1];
680 /* If bracket is ']' or '>', bracket - 2 is the corresponding
682 ptr
= index (src
, bracket
- 2);
684 { /* no opening bracket */
688 if (!(rptr
= rindex (src
, '.')))
691 strncpy (dst
, src
, slen
);
695 dst
[slen
++] = bracket
;
700 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
701 then translate the device and recurse. */
702 if (dst
[slen
- 1] == ':'
703 && dst
[slen
- 2] != ':' /* skip decnet nodes */
704 && strcmp (src
+ slen
, "[000000]") == 0)
706 dst
[slen
- 1] = '\0';
707 if ((ptr
= egetenv (dst
))
708 && (rlen
= strlen (ptr
) - 1) > 0
709 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
710 && ptr
[rlen
- 1] == '.')
712 char * buf
= (char *) alloca (strlen (ptr
) + 1);
716 return directory_file_name (buf
, dst
);
721 strcat (dst
, "[000000]");
725 rlen
= strlen (rptr
) - 1;
726 strncat (dst
, rptr
, rlen
);
727 dst
[slen
+ rlen
] = '\0';
728 strcat (dst
, ".DIR.1");
732 /* Process as Unix format: just remove any final slash.
733 But leave "/" unchanged; do not change it to "". */
736 /* Handle // as root for apollo's. */
737 if ((slen
> 2 && dst
[slen
- 1] == '/')
738 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
742 && IS_DIRECTORY_SEP (dst
[slen
- 1])
744 && !IS_ANY_SEP (dst
[slen
- 2])
750 CORRECT_DIR_SEPS (dst
);
755 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
757 "Returns the file name of the directory named DIRECTORY.\n\
758 This is the name of the file that holds the data for the directory DIRECTORY.\n\
759 This operation exists because a directory is also a file, but its name as\n\
760 a directory is different from its name as a file.\n\
761 In Unix-syntax, this function just removes the final slash.\n\
762 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
763 it returns a file name such as \"[X]Y.DIR.1\".")
765 Lisp_Object directory
;
770 CHECK_STRING (directory
, 0);
772 if (NILP (directory
))
775 /* If the file name has special constructs in it,
776 call the corresponding file handler. */
777 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
779 return call2 (handler
, Qdirectory_file_name
, directory
);
782 /* 20 extra chars is insufficient for VMS, since we might perform a
783 logical name translation. an equivalence string can be up to 255
784 chars long, so grab that much extra space... - sss */
785 buf
= (char *) alloca (STRING_BYTES (XSTRING (directory
)) + 20 + 255);
787 buf
= (char *) alloca (STRING_BYTES (XSTRING (directory
)) + 20);
789 directory_file_name (XSTRING (directory
)->data
, buf
);
790 return build_string (buf
);
793 static char make_temp_name_tbl
[64] =
795 'A','B','C','D','E','F','G','H',
796 'I','J','K','L','M','N','O','P',
797 'Q','R','S','T','U','V','W','X',
798 'Y','Z','a','b','c','d','e','f',
799 'g','h','i','j','k','l','m','n',
800 'o','p','q','r','s','t','u','v',
801 'w','x','y','z','0','1','2','3',
802 '4','5','6','7','8','9','-','_'
804 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
806 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
807 "Generate temporary file name (string) starting with PREFIX (a string).\n\
808 The Emacs process number forms part of the result,\n\
809 so there is no danger of generating a name being used by another process.\n\
811 In addition, this function makes an attempt to choose a name\n\
812 which has no existing file. To make this work,\n\
813 PREFIX should be an absolute file name.")
820 unsigned char *p
, *data
;
824 CHECK_STRING (prefix
, 0);
826 /* VAL is created by adding 6 characters to PREFIX. The first
827 three are the PID of this process, in base 64, and the second
828 three are incremented if the file already exists. This ensures
829 262144 unique file names per PID per PREFIX. */
831 pid
= (int) getpid ();
833 #ifdef HAVE_LONG_FILE_NAMES
834 sprintf (pidbuf
, "%d", pid
);
835 pidlen
= strlen (pidbuf
);
837 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
838 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
839 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
843 len
= XSTRING (prefix
)->size
;
844 val
= make_uninit_string (len
+ 3 + pidlen
);
845 data
= XSTRING (val
)->data
;
846 bcopy(XSTRING (prefix
)->data
, data
, len
);
849 bcopy (pidbuf
, p
, pidlen
);
852 /* Here we try to minimize useless stat'ing when this function is
853 invoked many times successively with the same PREFIX. We achieve
854 this by initializing count to a random value, and incrementing it
857 We don't want make-temp-name to be called while dumping,
858 because then make_temp_name_count_initialized_p would get set
859 and then make_temp_name_count would not be set when Emacs starts. */
861 if (!make_temp_name_count_initialized_p
)
863 make_temp_name_count
= (unsigned) time (NULL
);
864 make_temp_name_count_initialized_p
= 1;
870 unsigned num
= make_temp_name_count
;
872 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
873 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
874 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
876 /* Poor man's congruential RN generator. Replace with
877 ++make_temp_name_count for debugging. */
878 make_temp_name_count
+= 25229;
879 make_temp_name_count
%= 225307;
881 if (stat (data
, &ignored
) < 0)
883 /* We want to return only if errno is ENOENT. */
887 /* The error here is dubious, but there is little else we
888 can do. The alternatives are to return nil, which is
889 as bad as (and in many cases worse than) throwing the
890 error, or to ignore the error, which will likely result
891 in looping through 225307 stat's, which is not only
892 dog-slow, but also useless since it will fallback to
893 the errow below, anyway. */
894 report_file_error ("Cannot create temporary name for prefix `%s'",
895 Fcons (prefix
, Qnil
));
900 error ("Cannot create temporary name for prefix `%s'",
901 XSTRING (prefix
)->data
);
906 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
907 "Convert filename NAME to absolute, and canonicalize it.\n\
908 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative\n\
909 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,\n\
910 the current buffer's value of default-directory is used.\n\
911 File name components that are `.' are removed, and \n\
912 so are file name components followed by `..', along with the `..' itself;\n\
913 note that these simplifications are done without checking the resulting\n\
914 file names in the file system.\n\
915 An initial `~/' expands to your home directory.\n\
916 An initial `~USER/' expands to USER's home directory.\n\
917 See also the function `substitute-in-file-name'.")
918 (name
, default_directory
)
919 Lisp_Object name
, default_directory
;
923 register unsigned char *newdir
, *p
, *o
;
925 unsigned char *target
;
928 unsigned char * colon
= 0;
929 unsigned char * close
= 0;
930 unsigned char * slash
= 0;
931 unsigned char * brack
= 0;
932 int lbrack
= 0, rbrack
= 0;
937 int collapse_newdir
= 1;
943 CHECK_STRING (name
, 0);
945 /* If the file name has special constructs in it,
946 call the corresponding file handler. */
947 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
949 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
951 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
952 if (NILP (default_directory
))
953 default_directory
= current_buffer
->directory
;
954 if (! STRINGP (default_directory
))
955 default_directory
= build_string ("/");
957 if (!NILP (default_directory
))
959 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
961 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
964 o
= XSTRING (default_directory
)->data
;
966 /* Make sure DEFAULT_DIRECTORY is properly expanded.
967 It would be better to do this down below where we actually use
968 default_directory. Unfortunately, calling Fexpand_file_name recursively
969 could invoke GC, and the strings might be relocated. This would
970 be annoying because we have pointers into strings lying around
971 that would need adjusting, and people would add new pointers to
972 the code and forget to adjust them, resulting in intermittent bugs.
973 Putting this call here avoids all that crud.
975 The EQ test avoids infinite recursion. */
976 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
977 /* Save time in some common cases - as long as default_directory
978 is not relative, it can be canonicalized with name below (if it
979 is needed at all) without requiring it to be expanded now. */
981 /* Detect MSDOS file names with drive specifiers. */
982 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
984 /* Detect Windows file names in UNC format. */
985 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
987 #else /* not DOS_NT */
988 /* Detect Unix absolute file names (/... alone is not absolute on
990 && ! (IS_DIRECTORY_SEP (o
[0]))
991 #endif /* not DOS_NT */
997 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1002 /* Filenames on VMS are always upper case. */
1003 name
= Fupcase (name
);
1005 #ifdef FILE_SYSTEM_CASE
1006 name
= FILE_SYSTEM_CASE (name
);
1009 nm
= XSTRING (name
)->data
;
1012 /* We will force directory separators to be either all \ or /, so make
1013 a local copy to modify, even if there ends up being no change. */
1014 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1016 /* Note if special escape prefix is present, but remove for now. */
1017 if (nm
[0] == '/' && nm
[1] == ':')
1023 /* Find and remove drive specifier if present; this makes nm absolute
1024 even if the rest of the name appears to be relative. Only look for
1025 drive specifier at the beginning. */
1026 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1033 /* If we see "c://somedir", we want to strip the first slash after the
1034 colon when stripping the drive letter. Otherwise, this expands to
1036 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1038 #endif /* WINDOWSNT */
1042 /* Discard any previous drive specifier if nm is now in UNC format. */
1043 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1049 /* If nm is absolute, look for /./ or /../ sequences; if none are
1050 found, we can probably return right away. We will avoid allocating
1051 a new string if name is already fully expanded. */
1053 IS_DIRECTORY_SEP (nm
[0])
1055 && drive
&& !is_escaped
1058 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1065 /* If it turns out that the filename we want to return is just a
1066 suffix of FILENAME, we don't need to go through and edit
1067 things; we just need to construct a new string using data
1068 starting at the middle of FILENAME. If we set lose to a
1069 non-zero value, that means we've discovered that we can't do
1076 /* Since we know the name is absolute, we can assume that each
1077 element starts with a "/". */
1079 /* "." and ".." are hairy. */
1080 if (IS_DIRECTORY_SEP (p
[0])
1082 && (IS_DIRECTORY_SEP (p
[2])
1084 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1091 /* if dev:[dir]/, move nm to / */
1092 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1093 nm
= (brack
? brack
+ 1 : colon
+ 1);
1094 lbrack
= rbrack
= 0;
1102 /* VMS pre V4.4,convert '-'s in filenames. */
1103 if (lbrack
== rbrack
)
1105 if (dots
< 2) /* this is to allow negative version numbers */
1110 if (lbrack
> rbrack
&&
1111 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1112 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1118 /* count open brackets, reset close bracket pointer */
1119 if (p
[0] == '[' || p
[0] == '<')
1120 lbrack
++, brack
= 0;
1121 /* count close brackets, set close bracket pointer */
1122 if (p
[0] == ']' || p
[0] == '>')
1123 rbrack
++, brack
= p
;
1124 /* detect ][ or >< */
1125 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1127 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1128 nm
= p
+ 1, lose
= 1;
1129 if (p
[0] == ':' && (colon
|| slash
))
1130 /* if dev1:[dir]dev2:, move nm to dev2: */
1136 /* if /name/dev:, move nm to dev: */
1139 /* if node::dev:, move colon following dev */
1140 else if (colon
&& colon
[-1] == ':')
1142 /* if dev1:dev2:, move nm to dev2: */
1143 else if (colon
&& colon
[-1] != ':')
1148 if (p
[0] == ':' && !colon
)
1154 if (lbrack
== rbrack
)
1157 else if (p
[0] == '.')
1165 if (index (nm
, '/'))
1166 return build_string (sys_translate_unix (nm
));
1169 /* Make sure directories are all separated with / or \ as
1170 desired, but avoid allocation of a new string when not
1172 CORRECT_DIR_SEPS (nm
);
1174 if (IS_DIRECTORY_SEP (nm
[1]))
1176 if (strcmp (nm
, XSTRING (name
)->data
) != 0)
1177 name
= build_string (nm
);
1181 /* drive must be set, so this is okay */
1182 if (strcmp (nm
- 2, XSTRING (name
)->data
) != 0)
1184 name
= make_string (nm
- 2, p
- nm
+ 2);
1185 XSTRING (name
)->data
[0] = DRIVE_LETTER (drive
);
1186 XSTRING (name
)->data
[1] = ':';
1189 #else /* not DOS_NT */
1190 if (nm
== XSTRING (name
)->data
)
1192 return build_string (nm
);
1193 #endif /* not DOS_NT */
1197 /* At this point, nm might or might not be an absolute file name. We
1198 need to expand ~ or ~user if present, otherwise prefix nm with
1199 default_directory if nm is not absolute, and finally collapse /./
1200 and /foo/../ sequences.
1202 We set newdir to be the appropriate prefix if one is needed:
1203 - the relevant user directory if nm starts with ~ or ~user
1204 - the specified drive's working dir (DOS/NT only) if nm does not
1206 - the value of default_directory.
1208 Note that these prefixes are not guaranteed to be absolute (except
1209 for the working dir of a drive). Therefore, to ensure we always
1210 return an absolute name, if the final prefix is not absolute we
1211 append it to the current working directory. */
1215 if (nm
[0] == '~') /* prefix ~ */
1217 if (IS_DIRECTORY_SEP (nm
[1])
1221 || nm
[1] == 0) /* ~ by itself */
1223 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1224 newdir
= (unsigned char *) "";
1227 collapse_newdir
= 0;
1230 nm
++; /* Don't leave the slash in nm. */
1233 else /* ~user/filename */
1235 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1240 o
= (unsigned char *) alloca (p
- nm
+ 1);
1241 bcopy ((char *) nm
, o
, p
- nm
);
1244 pw
= (struct passwd
*) getpwnam (o
+ 1);
1247 newdir
= (unsigned char *) pw
-> pw_dir
;
1249 nm
= p
+ 1; /* skip the terminator */
1253 collapse_newdir
= 0;
1258 /* If we don't find a user of that name, leave the name
1259 unchanged; don't move nm forward to p. */
1264 /* On DOS and Windows, nm is absolute if a drive name was specified;
1265 use the drive's current directory as the prefix if needed. */
1266 if (!newdir
&& drive
)
1268 /* Get default directory if needed to make nm absolute. */
1269 if (!IS_DIRECTORY_SEP (nm
[0]))
1271 newdir
= alloca (MAXPATHLEN
+ 1);
1272 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1277 /* Either nm starts with /, or drive isn't mounted. */
1278 newdir
= alloca (4);
1279 newdir
[0] = DRIVE_LETTER (drive
);
1287 /* Finally, if no prefix has been specified and nm is not absolute,
1288 then it must be expanded relative to default_directory. */
1292 /* /... alone is not absolute on DOS and Windows. */
1293 && !IS_DIRECTORY_SEP (nm
[0])
1296 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1303 newdir
= XSTRING (default_directory
)->data
;
1305 /* Note if special escape prefix is present, but remove for now. */
1306 if (newdir
[0] == '/' && newdir
[1] == ':')
1317 /* First ensure newdir is an absolute name. */
1319 /* Detect MSDOS file names with drive specifiers. */
1320 ! (IS_DRIVE (newdir
[0])
1321 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1323 /* Detect Windows file names in UNC format. */
1324 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1328 /* Effectively, let newdir be (expand-file-name newdir cwd).
1329 Because of the admonition against calling expand-file-name
1330 when we have pointers into lisp strings, we accomplish this
1331 indirectly by prepending newdir to nm if necessary, and using
1332 cwd (or the wd of newdir's drive) as the new newdir. */
1334 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1339 if (!IS_DIRECTORY_SEP (nm
[0]))
1341 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1342 file_name_as_directory (tmp
, newdir
);
1346 newdir
= alloca (MAXPATHLEN
+ 1);
1349 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1356 /* Strip off drive name from prefix, if present. */
1357 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1363 /* Keep only a prefix from newdir if nm starts with slash
1364 (//server/share for UNC, nothing otherwise). */
1365 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1368 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1370 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1372 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1374 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1386 /* Get rid of any slash at the end of newdir, unless newdir is
1387 just / or // (an incomplete UNC name). */
1388 length
= strlen (newdir
);
1389 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1391 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1395 unsigned char *temp
= (unsigned char *) alloca (length
);
1396 bcopy (newdir
, temp
, length
- 1);
1397 temp
[length
- 1] = 0;
1405 /* Now concatenate the directory and name to new space in the stack frame */
1406 tlen
+= strlen (nm
) + 1;
1408 /* Reserve space for drive specifier and escape prefix, since either
1409 or both may need to be inserted. (The Microsoft x86 compiler
1410 produces incorrect code if the following two lines are combined.) */
1411 target
= (unsigned char *) alloca (tlen
+ 4);
1413 #else /* not DOS_NT */
1414 target
= (unsigned char *) alloca (tlen
);
1415 #endif /* not DOS_NT */
1421 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1424 /* If newdir is effectively "C:/", then the drive letter will have
1425 been stripped and newdir will be "/". Concatenating with an
1426 absolute directory in nm produces "//", which will then be
1427 incorrectly treated as a network share. Ignore newdir in
1428 this case (keeping the drive letter). */
1429 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1430 && newdir
[1] == '\0'))
1432 strcpy (target
, newdir
);
1436 file_name_as_directory (target
, newdir
);
1439 strcat (target
, nm
);
1441 if (index (target
, '/'))
1442 strcpy (target
, sys_translate_unix (target
));
1445 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1447 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1455 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1461 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1462 /* brackets are offset from each other by 2 */
1465 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1466 /* convert [foo][bar] to [bar] */
1467 while (o
[-1] != '[' && o
[-1] != '<')
1469 else if (*p
== '-' && *o
!= '.')
1472 else if (p
[0] == '-' && o
[-1] == '.' &&
1473 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1474 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1478 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1479 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1481 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1483 /* else [foo.-] ==> [-] */
1489 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1490 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1496 if (!IS_DIRECTORY_SEP (*p
))
1500 else if (IS_DIRECTORY_SEP (p
[0])
1502 && (IS_DIRECTORY_SEP (p
[2])
1505 /* If "/." is the entire filename, keep the "/". Otherwise,
1506 just delete the whole "/.". */
1507 if (o
== target
&& p
[2] == '\0')
1511 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1512 /* `/../' is the "superroot" on certain file systems. */
1514 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1516 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1518 /* Keep initial / only if this is the whole name. */
1519 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1527 #endif /* not VMS */
1531 /* At last, set drive name. */
1533 /* Except for network file name. */
1534 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1535 #endif /* WINDOWSNT */
1537 if (!drive
) abort ();
1539 target
[0] = DRIVE_LETTER (drive
);
1542 /* Reinsert the escape prefix if required. */
1549 CORRECT_DIR_SEPS (target
);
1552 return make_string (target
, o
- target
);
1556 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1557 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1558 "Convert FILENAME to absolute, and canonicalize it.\n\
1559 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1560 (does not start with slash); if DEFAULT is nil or missing,\n\
1561 the current buffer's value of default-directory is used.\n\
1562 Filenames containing `.' or `..' as components are simplified;\n\
1563 initial `~/' expands to your home directory.\n\
1564 See also the function `substitute-in-file-name'.")
1566 Lisp_Object name
, defalt
;
1570 register unsigned char *newdir
, *p
, *o
;
1572 unsigned char *target
;
1576 unsigned char * colon
= 0;
1577 unsigned char * close
= 0;
1578 unsigned char * slash
= 0;
1579 unsigned char * brack
= 0;
1580 int lbrack
= 0, rbrack
= 0;
1584 CHECK_STRING (name
, 0);
1587 /* Filenames on VMS are always upper case. */
1588 name
= Fupcase (name
);
1591 nm
= XSTRING (name
)->data
;
1593 /* If nm is absolute, flush ...// and detect /./ and /../.
1594 If no /./ or /../ we can return right away. */
1606 if (p
[0] == '/' && p
[1] == '/'
1608 /* // at start of filename is meaningful on Apollo system. */
1613 if (p
[0] == '/' && p
[1] == '~')
1614 nm
= p
+ 1, lose
= 1;
1615 if (p
[0] == '/' && p
[1] == '.'
1616 && (p
[2] == '/' || p
[2] == 0
1617 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1623 /* if dev:[dir]/, move nm to / */
1624 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1625 nm
= (brack
? brack
+ 1 : colon
+ 1);
1626 lbrack
= rbrack
= 0;
1634 /* VMS pre V4.4,convert '-'s in filenames. */
1635 if (lbrack
== rbrack
)
1637 if (dots
< 2) /* this is to allow negative version numbers */
1642 if (lbrack
> rbrack
&&
1643 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1644 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1650 /* count open brackets, reset close bracket pointer */
1651 if (p
[0] == '[' || p
[0] == '<')
1652 lbrack
++, brack
= 0;
1653 /* count close brackets, set close bracket pointer */
1654 if (p
[0] == ']' || p
[0] == '>')
1655 rbrack
++, brack
= p
;
1656 /* detect ][ or >< */
1657 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1659 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1660 nm
= p
+ 1, lose
= 1;
1661 if (p
[0] == ':' && (colon
|| slash
))
1662 /* if dev1:[dir]dev2:, move nm to dev2: */
1668 /* If /name/dev:, move nm to dev: */
1671 /* If node::dev:, move colon following dev */
1672 else if (colon
&& colon
[-1] == ':')
1674 /* If dev1:dev2:, move nm to dev2: */
1675 else if (colon
&& colon
[-1] != ':')
1680 if (p
[0] == ':' && !colon
)
1686 if (lbrack
== rbrack
)
1689 else if (p
[0] == '.')
1697 if (index (nm
, '/'))
1698 return build_string (sys_translate_unix (nm
));
1700 if (nm
== XSTRING (name
)->data
)
1702 return build_string (nm
);
1706 /* Now determine directory to start with and put it in NEWDIR */
1710 if (nm
[0] == '~') /* prefix ~ */
1715 || nm
[1] == 0)/* ~/filename */
1717 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1718 newdir
= (unsigned char *) "";
1721 nm
++; /* Don't leave the slash in nm. */
1724 else /* ~user/filename */
1726 /* Get past ~ to user */
1727 unsigned char *user
= nm
+ 1;
1728 /* Find end of name. */
1729 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1730 int len
= ptr
? ptr
- user
: strlen (user
);
1732 unsigned char *ptr1
= index (user
, ':');
1733 if (ptr1
!= 0 && ptr1
- user
< len
)
1736 /* Copy the user name into temp storage. */
1737 o
= (unsigned char *) alloca (len
+ 1);
1738 bcopy ((char *) user
, o
, len
);
1741 /* Look up the user name. */
1742 pw
= (struct passwd
*) getpwnam (o
+ 1);
1744 error ("\"%s\" isn't a registered user", o
+ 1);
1746 newdir
= (unsigned char *) pw
->pw_dir
;
1748 /* Discard the user name from NM. */
1755 #endif /* not VMS */
1759 defalt
= current_buffer
->directory
;
1760 CHECK_STRING (defalt
, 1);
1761 newdir
= XSTRING (defalt
)->data
;
1764 /* Now concatenate the directory and name to new space in the stack frame */
1766 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1767 target
= (unsigned char *) alloca (tlen
);
1773 if (nm
[0] == 0 || nm
[0] == '/')
1774 strcpy (target
, newdir
);
1777 file_name_as_directory (target
, newdir
);
1780 strcat (target
, nm
);
1782 if (index (target
, '/'))
1783 strcpy (target
, sys_translate_unix (target
));
1786 /* Now canonicalize by removing /. and /foo/.. if they appear */
1794 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1800 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1801 /* brackets are offset from each other by 2 */
1804 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1805 /* convert [foo][bar] to [bar] */
1806 while (o
[-1] != '[' && o
[-1] != '<')
1808 else if (*p
== '-' && *o
!= '.')
1811 else if (p
[0] == '-' && o
[-1] == '.' &&
1812 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1813 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1817 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1818 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1820 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1822 /* else [foo.-] ==> [-] */
1828 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1829 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1839 else if (!strncmp (p
, "//", 2)
1841 /* // at start of filename is meaningful in Apollo system. */
1849 else if (p
[0] == '/' && p
[1] == '.' &&
1850 (p
[2] == '/' || p
[2] == 0))
1852 else if (!strncmp (p
, "/..", 3)
1853 /* `/../' is the "superroot" on certain file systems. */
1855 && (p
[3] == '/' || p
[3] == 0))
1857 while (o
!= target
&& *--o
!= '/')
1860 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1864 if (o
== target
&& *o
== '/')
1872 #endif /* not VMS */
1875 return make_string (target
, o
- target
);
1879 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1880 Ssubstitute_in_file_name
, 1, 1, 0,
1881 "Substitute environment variables referred to in FILENAME.\n\
1882 `$FOO' where FOO is an environment variable name means to substitute\n\
1883 the value of that variable. The variable name should be terminated\n\
1884 with a character not a letter, digit or underscore; otherwise, enclose\n\
1885 the entire variable name in braces.\n\
1886 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1887 On VMS, `$' substitution is not done; this function does little and only\n\
1888 duplicates what `expand-file-name' does.")
1890 Lisp_Object filename
;
1894 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1895 unsigned char *target
;
1897 int substituted
= 0;
1899 Lisp_Object handler
;
1901 CHECK_STRING (filename
, 0);
1903 /* If the file name has special constructs in it,
1904 call the corresponding file handler. */
1905 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1906 if (!NILP (handler
))
1907 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1909 nm
= XSTRING (filename
)->data
;
1911 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1912 CORRECT_DIR_SEPS (nm
);
1913 substituted
= (strcmp (nm
, XSTRING (filename
)->data
) != 0);
1915 endp
= nm
+ STRING_BYTES (XSTRING (filename
));
1917 /* If /~ or // appears, discard everything through first slash. */
1919 for (p
= nm
; p
!= endp
; p
++)
1922 #if defined (APOLLO) || defined (WINDOWSNT)
1923 /* // at start of file name is meaningful in Apollo and
1924 WindowsNT systems. */
1925 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1926 #else /* not (APOLLO || WINDOWSNT) */
1927 || IS_DIRECTORY_SEP (p
[0])
1928 #endif /* not (APOLLO || WINDOWSNT) */
1933 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1935 || IS_DIRECTORY_SEP (p
[-1])))
1941 /* see comment in expand-file-name about drive specifiers */
1942 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1943 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1952 return build_string (nm
);
1955 /* See if any variables are substituted into the string
1956 and find the total length of their values in `total' */
1958 for (p
= nm
; p
!= endp
;)
1968 /* "$$" means a single "$" */
1977 while (p
!= endp
&& *p
!= '}') p
++;
1978 if (*p
!= '}') goto missingclose
;
1984 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1988 /* Copy out the variable name */
1989 target
= (unsigned char *) alloca (s
- o
+ 1);
1990 strncpy (target
, o
, s
- o
);
1993 strupr (target
); /* $home == $HOME etc. */
1996 /* Get variable value */
1997 o
= (unsigned char *) egetenv (target
);
1998 if (!o
) goto badvar
;
1999 total
+= strlen (o
);
2006 /* If substitution required, recopy the string and do it */
2007 /* Make space in stack frame for the new copy */
2008 xnm
= (unsigned char *) alloca (STRING_BYTES (XSTRING (filename
)) + total
+ 1);
2011 /* Copy the rest of the name through, replacing $ constructs with values */
2028 while (p
!= endp
&& *p
!= '}') p
++;
2029 if (*p
!= '}') goto missingclose
;
2035 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2039 /* Copy out the variable name */
2040 target
= (unsigned char *) alloca (s
- o
+ 1);
2041 strncpy (target
, o
, s
- o
);
2044 strupr (target
); /* $home == $HOME etc. */
2047 /* Get variable value */
2048 o
= (unsigned char *) egetenv (target
);
2052 if (STRING_MULTIBYTE (filename
))
2054 /* If the original string is multibyte,
2055 convert what we substitute into multibyte. */
2056 unsigned char workbuf
[4], *str
;
2062 c
= unibyte_char_to_multibyte (c
);
2063 if (! SINGLE_BYTE_CHAR_P (c
))
2065 len
= CHAR_STRING (c
, workbuf
, str
);
2066 bcopy (str
, x
, len
);
2082 /* If /~ or // appears, discard everything through first slash. */
2084 for (p
= xnm
; p
!= x
; p
++)
2086 #if defined (APOLLO) || defined (WINDOWSNT)
2087 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2088 #else /* not (APOLLO || WINDOWSNT) */
2089 || IS_DIRECTORY_SEP (p
[0])
2090 #endif /* not (APOLLO || WINDOWSNT) */
2092 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2095 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2096 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
2100 if (STRING_MULTIBYTE (filename
))
2101 return make_string (xnm
, x
- xnm
);
2102 return make_unibyte_string (xnm
, x
- xnm
);
2105 error ("Bad format environment-variable substitution");
2107 error ("Missing \"}\" in environment-variable substitution");
2109 error ("Substituting nonexistent environment variable \"%s\"", target
);
2112 #endif /* not VMS */
2115 /* A slightly faster and more convenient way to get
2116 (directory-file-name (expand-file-name FOO)). */
2119 expand_and_dir_to_file (filename
, defdir
)
2120 Lisp_Object filename
, defdir
;
2122 register Lisp_Object absname
;
2124 absname
= Fexpand_file_name (filename
, defdir
);
2127 register int c
= XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
)) - 1];
2128 if (c
== ':' || c
== ']' || c
== '>')
2129 absname
= Fdirectory_file_name (absname
);
2132 /* Remove final slash, if any (unless this is the root dir).
2133 stat behaves differently depending! */
2134 if (XSTRING (absname
)->size
> 1
2135 && IS_DIRECTORY_SEP (XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
)) - 1])
2136 && !IS_DEVICE_SEP (XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
))-2]))
2137 /* We cannot take shortcuts; they might be wrong for magic file names. */
2138 absname
= Fdirectory_file_name (absname
);
2143 /* Signal an error if the file ABSNAME already exists.
2144 If INTERACTIVE is nonzero, ask the user whether to proceed,
2145 and bypass the error if the user says to go ahead.
2146 QUERYSTRING is a name for the action that is being considered
2149 *STATPTR is used to store the stat information if the file exists.
2150 If the file does not exist, STATPTR->st_mode is set to 0.
2151 If STATPTR is null, we don't store into it.
2153 If QUICK is nonzero, we ask for y or n, not yes or no. */
2156 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2157 Lisp_Object absname
;
2158 unsigned char *querystring
;
2160 struct stat
*statptr
;
2163 register Lisp_Object tem
, encoded_filename
;
2164 struct stat statbuf
;
2165 struct gcpro gcpro1
;
2167 encoded_filename
= ENCODE_FILE (absname
);
2169 /* stat is a good way to tell whether the file exists,
2170 regardless of what access permissions it has. */
2171 if (stat (XSTRING (encoded_filename
)->data
, &statbuf
) >= 0)
2174 Fsignal (Qfile_already_exists
,
2175 Fcons (build_string ("File already exists"),
2176 Fcons (absname
, Qnil
)));
2178 tem
= format1 ("File %s already exists; %s anyway? ",
2179 XSTRING (absname
)->data
, querystring
);
2181 tem
= Fy_or_n_p (tem
);
2183 tem
= do_yes_or_no_p (tem
);
2186 Fsignal (Qfile_already_exists
,
2187 Fcons (build_string ("File already exists"),
2188 Fcons (absname
, Qnil
)));
2195 statptr
->st_mode
= 0;
2200 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2201 "fCopy file: \nFCopy %s to file: \np\nP",
2202 "Copy FILE to NEWNAME. Both args must be strings.\n\
2203 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
2204 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
2205 A number as third arg means request confirmation if NEWNAME already exists.\n\
2206 This is what happens in interactive use with M-x.\n\
2207 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
2208 last-modified time as the old one. (This works on only some systems.)\n\
2209 A prefix arg makes KEEP-TIME non-nil.")
2210 (file
, newname
, ok_if_already_exists
, keep_date
)
2211 Lisp_Object file
, newname
, ok_if_already_exists
, keep_date
;
2214 char buf
[16 * 1024];
2215 struct stat st
, out_st
;
2216 Lisp_Object handler
;
2217 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2218 int count
= specpdl_ptr
- specpdl
;
2219 int input_file_statable_p
;
2220 Lisp_Object encoded_file
, encoded_newname
;
2222 encoded_file
= encoded_newname
= Qnil
;
2223 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2224 CHECK_STRING (file
, 0);
2225 CHECK_STRING (newname
, 1);
2227 file
= Fexpand_file_name (file
, Qnil
);
2228 newname
= Fexpand_file_name (newname
, Qnil
);
2230 /* If the input file name has special constructs in it,
2231 call the corresponding file handler. */
2232 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2233 /* Likewise for output file name. */
2235 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2236 if (!NILP (handler
))
2237 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2238 ok_if_already_exists
, keep_date
));
2240 encoded_file
= ENCODE_FILE (file
);
2241 encoded_newname
= ENCODE_FILE (newname
);
2243 if (NILP (ok_if_already_exists
)
2244 || INTEGERP (ok_if_already_exists
))
2245 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2246 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2247 else if (stat (XSTRING (encoded_newname
)->data
, &out_st
) < 0)
2250 ifd
= open (XSTRING (encoded_file
)->data
, O_RDONLY
);
2252 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2254 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2256 /* We can only copy regular files and symbolic links. Other files are not
2258 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2260 #if !defined (DOS_NT) || __DJGPP__ > 1
2261 if (out_st
.st_mode
!= 0
2262 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2265 report_file_error ("Input and output files are the same",
2266 Fcons (file
, Fcons (newname
, Qnil
)));
2270 #if defined (S_ISREG) && defined (S_ISLNK)
2271 if (input_file_statable_p
)
2273 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2275 #if defined (EISDIR)
2276 /* Get a better looking error message. */
2279 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2282 #endif /* S_ISREG && S_ISLNK */
2285 /* Create the copy file with the same record format as the input file */
2286 ofd
= sys_creat (XSTRING (encoded_newname
)->data
, 0666, ifd
);
2289 /* System's default file type was set to binary by _fmode in emacs.c. */
2290 ofd
= creat (XSTRING (encoded_newname
)->data
, S_IREAD
| S_IWRITE
);
2291 #else /* not MSDOS */
2292 ofd
= creat (XSTRING (encoded_newname
)->data
, 0666);
2293 #endif /* not MSDOS */
2296 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2298 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2302 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
2303 if (write (ofd
, buf
, n
) != n
)
2304 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2307 /* Closing the output clobbers the file times on some systems. */
2308 if (close (ofd
) < 0)
2309 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2311 if (input_file_statable_p
)
2313 if (!NILP (keep_date
))
2315 EMACS_TIME atime
, mtime
;
2316 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2317 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2318 if (set_file_times (XSTRING (encoded_newname
)->data
,
2320 Fsignal (Qfile_date_error
,
2321 Fcons (build_string ("Cannot set file date"),
2322 Fcons (newname
, Qnil
)));
2325 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2327 #if defined (__DJGPP__) && __DJGPP__ > 1
2328 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2329 and if it can't, it tells so. Otherwise, under MSDOS we usually
2330 get only the READ bit, which will make the copied file read-only,
2331 so it's better not to chmod at all. */
2332 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2333 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2334 #endif /* DJGPP version 2 or newer */
2340 /* Discard the unwind protects. */
2341 specpdl_ptr
= specpdl
+ count
;
2347 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2348 Smake_directory_internal
, 1, 1, 0,
2349 "Create a new directory named DIRECTORY.")
2351 Lisp_Object directory
;
2354 Lisp_Object handler
;
2355 Lisp_Object encoded_dir
;
2357 CHECK_STRING (directory
, 0);
2358 directory
= Fexpand_file_name (directory
, Qnil
);
2360 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2361 if (!NILP (handler
))
2362 return call2 (handler
, Qmake_directory_internal
, directory
);
2364 encoded_dir
= ENCODE_FILE (directory
);
2366 dir
= XSTRING (encoded_dir
)->data
;
2369 if (mkdir (dir
) != 0)
2371 if (mkdir (dir
, 0777) != 0)
2373 report_file_error ("Creating directory", Flist (1, &directory
));
2378 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2379 "Delete the directory named DIRECTORY.")
2381 Lisp_Object directory
;
2384 Lisp_Object handler
;
2385 Lisp_Object encoded_dir
;
2387 CHECK_STRING (directory
, 0);
2388 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2390 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2391 if (!NILP (handler
))
2392 return call2 (handler
, Qdelete_directory
, directory
);
2394 encoded_dir
= ENCODE_FILE (directory
);
2396 dir
= XSTRING (encoded_dir
)->data
;
2398 if (rmdir (dir
) != 0)
2399 report_file_error ("Removing directory", Flist (1, &directory
));
2404 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2405 "Delete file named FILENAME.\n\
2406 If file has multiple names, it continues to exist with the other names.")
2408 Lisp_Object filename
;
2410 Lisp_Object handler
;
2411 Lisp_Object encoded_file
;
2413 CHECK_STRING (filename
, 0);
2414 filename
= Fexpand_file_name (filename
, Qnil
);
2416 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2417 if (!NILP (handler
))
2418 return call2 (handler
, Qdelete_file
, filename
);
2420 encoded_file
= ENCODE_FILE (filename
);
2422 if (0 > unlink (XSTRING (encoded_file
)->data
))
2423 report_file_error ("Removing old name", Flist (1, &filename
));
2428 internal_delete_file_1 (ignore
)
2434 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2437 internal_delete_file (filename
)
2438 Lisp_Object filename
;
2440 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2441 Qt
, internal_delete_file_1
));
2444 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2445 "fRename file: \nFRename %s to file: \np",
2446 "Rename FILE as NEWNAME. Both args strings.\n\
2447 If file has names other than FILE, it continues to have those names.\n\
2448 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2449 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2450 A number as third arg means request confirmation if NEWNAME already exists.\n\
2451 This is what happens in interactive use with M-x.")
2452 (file
, newname
, ok_if_already_exists
)
2453 Lisp_Object file
, newname
, ok_if_already_exists
;
2456 Lisp_Object args
[2];
2458 Lisp_Object handler
;
2459 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2460 Lisp_Object encoded_file
, encoded_newname
;
2462 encoded_file
= encoded_newname
= Qnil
;
2463 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2464 CHECK_STRING (file
, 0);
2465 CHECK_STRING (newname
, 1);
2466 file
= Fexpand_file_name (file
, Qnil
);
2467 newname
= Fexpand_file_name (newname
, Qnil
);
2469 /* If the file name has special constructs in it,
2470 call the corresponding file handler. */
2471 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2473 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2474 if (!NILP (handler
))
2475 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2476 file
, newname
, ok_if_already_exists
));
2478 encoded_file
= ENCODE_FILE (file
);
2479 encoded_newname
= ENCODE_FILE (newname
);
2481 if (NILP (ok_if_already_exists
)
2482 || INTEGERP (ok_if_already_exists
))
2483 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2484 INTEGERP (ok_if_already_exists
), 0, 0);
2486 if (0 > rename (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2488 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
)
2489 || 0 > unlink (XSTRING (encoded_file
)->data
))
2494 Fcopy_file (file
, newname
,
2495 /* We have already prompted if it was an integer,
2496 so don't have copy-file prompt again. */
2497 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2498 Fdelete_file (file
);
2505 report_file_error ("Renaming", Flist (2, args
));
2508 report_file_error ("Renaming", Flist (2, &file
));
2515 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2516 "fAdd name to file: \nFName to add to %s: \np",
2517 "Give FILE additional name NEWNAME. Both args strings.\n\
2518 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2519 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2520 A number as third arg means request confirmation if NEWNAME already exists.\n\
2521 This is what happens in interactive use with M-x.")
2522 (file
, newname
, ok_if_already_exists
)
2523 Lisp_Object file
, newname
, ok_if_already_exists
;
2526 Lisp_Object args
[2];
2528 Lisp_Object handler
;
2529 Lisp_Object encoded_file
, encoded_newname
;
2530 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2532 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2533 encoded_file
= encoded_newname
= Qnil
;
2534 CHECK_STRING (file
, 0);
2535 CHECK_STRING (newname
, 1);
2536 file
= Fexpand_file_name (file
, Qnil
);
2537 newname
= Fexpand_file_name (newname
, Qnil
);
2539 /* If the file name has special constructs in it,
2540 call the corresponding file handler. */
2541 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2542 if (!NILP (handler
))
2543 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2544 newname
, ok_if_already_exists
));
2546 /* If the new name has special constructs in it,
2547 call the corresponding file handler. */
2548 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2549 if (!NILP (handler
))
2550 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2551 newname
, ok_if_already_exists
));
2553 encoded_file
= ENCODE_FILE (file
);
2554 encoded_newname
= ENCODE_FILE (newname
);
2556 if (NILP (ok_if_already_exists
)
2557 || INTEGERP (ok_if_already_exists
))
2558 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2559 INTEGERP (ok_if_already_exists
), 0, 0);
2561 unlink (XSTRING (newname
)->data
);
2562 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2567 report_file_error ("Adding new name", Flist (2, args
));
2569 report_file_error ("Adding new name", Flist (2, &file
));
2578 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2579 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2580 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2581 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2582 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2583 A number as third arg means request confirmation if LINKNAME already exists.\n\
2584 This happens for interactive use with M-x.")
2585 (filename
, linkname
, ok_if_already_exists
)
2586 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2589 Lisp_Object args
[2];
2591 Lisp_Object handler
;
2592 Lisp_Object encoded_filename
, encoded_linkname
;
2593 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2595 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2596 encoded_filename
= encoded_linkname
= Qnil
;
2597 CHECK_STRING (filename
, 0);
2598 CHECK_STRING (linkname
, 1);
2599 /* If the link target has a ~, we must expand it to get
2600 a truly valid file name. Otherwise, do not expand;
2601 we want to permit links to relative file names. */
2602 if (XSTRING (filename
)->data
[0] == '~')
2603 filename
= Fexpand_file_name (filename
, Qnil
);
2604 linkname
= Fexpand_file_name (linkname
, Qnil
);
2606 /* If the file name has special constructs in it,
2607 call the corresponding file handler. */
2608 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2609 if (!NILP (handler
))
2610 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2611 linkname
, ok_if_already_exists
));
2613 /* If the new link name has special constructs in it,
2614 call the corresponding file handler. */
2615 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2616 if (!NILP (handler
))
2617 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2618 linkname
, ok_if_already_exists
));
2620 encoded_filename
= ENCODE_FILE (filename
);
2621 encoded_linkname
= ENCODE_FILE (linkname
);
2623 if (NILP (ok_if_already_exists
)
2624 || INTEGERP (ok_if_already_exists
))
2625 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2626 INTEGERP (ok_if_already_exists
), 0, 0);
2627 if (0 > symlink (XSTRING (encoded_filename
)->data
,
2628 XSTRING (encoded_linkname
)->data
))
2630 /* If we didn't complain already, silently delete existing file. */
2631 if (errno
== EEXIST
)
2633 unlink (XSTRING (encoded_linkname
)->data
);
2634 if (0 <= symlink (XSTRING (encoded_filename
)->data
,
2635 XSTRING (encoded_linkname
)->data
))
2645 report_file_error ("Making symbolic link", Flist (2, args
));
2647 report_file_error ("Making symbolic link", Flist (2, &filename
));
2653 #endif /* S_IFLNK */
2657 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2658 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2659 "Define the job-wide logical name NAME to have the value STRING.\n\
2660 If STRING is nil or a null string, the logical name NAME is deleted.")
2665 CHECK_STRING (name
, 0);
2667 delete_logical_name (XSTRING (name
)->data
);
2670 CHECK_STRING (string
, 1);
2672 if (XSTRING (string
)->size
== 0)
2673 delete_logical_name (XSTRING (name
)->data
);
2675 define_logical_name (XSTRING (name
)->data
, XSTRING (string
)->data
);
2684 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2685 "Open a network connection to PATH using LOGIN as the login string.")
2687 Lisp_Object path
, login
;
2691 CHECK_STRING (path
, 0);
2692 CHECK_STRING (login
, 0);
2694 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2696 if (netresult
== -1)
2701 #endif /* HPUX_NET */
2703 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2705 "Return t if file FILENAME specifies an absolute file name.\n\
2706 On Unix, this is a name starting with a `/' or a `~'.")
2708 Lisp_Object filename
;
2712 CHECK_STRING (filename
, 0);
2713 ptr
= XSTRING (filename
)->data
;
2714 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2716 /* ??? This criterion is probably wrong for '<'. */
2717 || index (ptr
, ':') || index (ptr
, '<')
2718 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2722 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2730 /* Return nonzero if file FILENAME exists and can be executed. */
2733 check_executable (filename
)
2737 int len
= strlen (filename
);
2740 if (stat (filename
, &st
) < 0)
2742 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2743 return ((st
.st_mode
& S_IEXEC
) != 0);
2745 return (S_ISREG (st
.st_mode
)
2747 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2748 || stricmp (suffix
, ".exe") == 0
2749 || stricmp (suffix
, ".bat") == 0)
2750 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2751 #endif /* not WINDOWSNT */
2752 #else /* not DOS_NT */
2753 #ifdef HAVE_EUIDACCESS
2754 return (euidaccess (filename
, 1) >= 0);
2756 /* Access isn't quite right because it uses the real uid
2757 and we really want to test with the effective uid.
2758 But Unix doesn't give us a right way to do it. */
2759 return (access (filename
, 1) >= 0);
2761 #endif /* not DOS_NT */
2764 /* Return nonzero if file FILENAME exists and can be written. */
2767 check_writable (filename
)
2772 if (stat (filename
, &st
) < 0)
2774 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2775 #else /* not MSDOS */
2776 #ifdef HAVE_EUIDACCESS
2777 return (euidaccess (filename
, 2) >= 0);
2779 /* Access isn't quite right because it uses the real uid
2780 and we really want to test with the effective uid.
2781 But Unix doesn't give us a right way to do it.
2782 Opening with O_WRONLY could work for an ordinary file,
2783 but would lose for directories. */
2784 return (access (filename
, 2) >= 0);
2786 #endif /* not MSDOS */
2789 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2790 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2791 See also `file-readable-p' and `file-attributes'.")
2793 Lisp_Object filename
;
2795 Lisp_Object absname
;
2796 Lisp_Object handler
;
2797 struct stat statbuf
;
2799 CHECK_STRING (filename
, 0);
2800 absname
= Fexpand_file_name (filename
, Qnil
);
2802 /* If the file name has special constructs in it,
2803 call the corresponding file handler. */
2804 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2805 if (!NILP (handler
))
2806 return call2 (handler
, Qfile_exists_p
, absname
);
2808 absname
= ENCODE_FILE (absname
);
2810 return (stat (XSTRING (absname
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2813 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2814 "Return t if FILENAME can be executed by you.\n\
2815 For a directory, this means you can access files in that directory.")
2817 Lisp_Object filename
;
2820 Lisp_Object absname
;
2821 Lisp_Object handler
;
2823 CHECK_STRING (filename
, 0);
2824 absname
= Fexpand_file_name (filename
, Qnil
);
2826 /* If the file name has special constructs in it,
2827 call the corresponding file handler. */
2828 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2829 if (!NILP (handler
))
2830 return call2 (handler
, Qfile_executable_p
, absname
);
2832 absname
= ENCODE_FILE (absname
);
2834 return (check_executable (XSTRING (absname
)->data
) ? Qt
: Qnil
);
2837 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2838 "Return t if file FILENAME exists and you can read it.\n\
2839 See also `file-exists-p' and `file-attributes'.")
2841 Lisp_Object filename
;
2843 Lisp_Object absname
;
2844 Lisp_Object handler
;
2847 struct stat statbuf
;
2849 CHECK_STRING (filename
, 0);
2850 absname
= Fexpand_file_name (filename
, Qnil
);
2852 /* If the file name has special constructs in it,
2853 call the corresponding file handler. */
2854 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2855 if (!NILP (handler
))
2856 return call2 (handler
, Qfile_readable_p
, absname
);
2858 absname
= ENCODE_FILE (absname
);
2861 /* Under MS-DOS and Windows, open does not work for directories. */
2862 if (access (XSTRING (absname
)->data
, 0) == 0)
2865 #else /* not DOS_NT */
2867 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2868 /* Opening a fifo without O_NONBLOCK can wait.
2869 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2870 except in the case of a fifo, on a system which handles it. */
2871 desc
= stat (XSTRING (absname
)->data
, &statbuf
);
2874 if (S_ISFIFO (statbuf
.st_mode
))
2875 flags
|= O_NONBLOCK
;
2877 desc
= open (XSTRING (absname
)->data
, flags
);
2882 #endif /* not DOS_NT */
2885 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2887 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2888 "Return t if file FILENAME can be written or created by you.")
2890 Lisp_Object filename
;
2892 Lisp_Object absname
, dir
, encoded
;
2893 Lisp_Object handler
;
2894 struct stat statbuf
;
2896 CHECK_STRING (filename
, 0);
2897 absname
= Fexpand_file_name (filename
, Qnil
);
2899 /* If the file name has special constructs in it,
2900 call the corresponding file handler. */
2901 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2902 if (!NILP (handler
))
2903 return call2 (handler
, Qfile_writable_p
, absname
);
2905 encoded
= ENCODE_FILE (absname
);
2906 if (stat (XSTRING (encoded
)->data
, &statbuf
) >= 0)
2907 return (check_writable (XSTRING (encoded
)->data
)
2910 dir
= Ffile_name_directory (absname
);
2913 dir
= Fdirectory_file_name (dir
);
2917 dir
= Fdirectory_file_name (dir
);
2920 dir
= ENCODE_FILE (dir
);
2921 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2925 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2926 "Access file FILENAME, and get an error if that does not work.\n\
2927 The second argument STRING is used in the error message.\n\
2928 If there is no error, we return nil.")
2930 Lisp_Object filename
, string
;
2932 Lisp_Object handler
, encoded_filename
;
2935 CHECK_STRING (filename
, 0);
2937 /* If the file name has special constructs in it,
2938 call the corresponding file handler. */
2939 handler
= Ffind_file_name_handler (filename
, Qaccess_file
);
2940 if (!NILP (handler
))
2941 return call3 (handler
, Qaccess_file
, filename
, string
);
2943 encoded_filename
= ENCODE_FILE (filename
);
2945 fd
= open (XSTRING (encoded_filename
)->data
, O_RDONLY
);
2947 report_file_error (XSTRING (string
)->data
, Fcons (filename
, Qnil
));
2953 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2954 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2955 The value is the name of the file to which it is linked.\n\
2956 Otherwise returns nil.")
2958 Lisp_Object filename
;
2965 Lisp_Object handler
;
2967 CHECK_STRING (filename
, 0);
2968 filename
= Fexpand_file_name (filename
, Qnil
);
2970 /* If the file name has special constructs in it,
2971 call the corresponding file handler. */
2972 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2973 if (!NILP (handler
))
2974 return call2 (handler
, Qfile_symlink_p
, filename
);
2976 filename
= ENCODE_FILE (filename
);
2981 buf
= (char *) xmalloc (bufsize
);
2982 bzero (buf
, bufsize
);
2983 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2984 if (valsize
< bufsize
) break;
2985 /* Buffer was not long enough */
2994 val
= make_string (buf
, valsize
);
2996 val
= DECODE_FILE (val
);
2998 #else /* not S_IFLNK */
3000 #endif /* not S_IFLNK */
3003 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3004 "Return t if FILENAME names an existing directory.")
3006 Lisp_Object filename
;
3008 register Lisp_Object absname
;
3010 Lisp_Object handler
;
3012 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3014 /* If the file name has special constructs in it,
3015 call the corresponding file handler. */
3016 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3017 if (!NILP (handler
))
3018 return call2 (handler
, Qfile_directory_p
, absname
);
3020 absname
= ENCODE_FILE (absname
);
3022 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3024 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3027 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3028 "Return t if file FILENAME is the name of a directory as a file,\n\
3029 and files in that directory can be opened by you. In order to use a\n\
3030 directory as a buffer's current directory, this predicate must return true.\n\
3031 A directory name spec may be given instead; then the value is t\n\
3032 if the directory so specified exists and really is a readable and\n\
3033 searchable directory.")
3035 Lisp_Object filename
;
3037 Lisp_Object handler
;
3039 struct gcpro gcpro1
;
3041 /* If the file name has special constructs in it,
3042 call the corresponding file handler. */
3043 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3044 if (!NILP (handler
))
3045 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3047 /* It's an unlikely combination, but yes we really do need to gcpro:
3048 Suppose that file-accessible-directory-p has no handler, but
3049 file-directory-p does have a handler; this handler causes a GC which
3050 relocates the string in `filename'; and finally file-directory-p
3051 returns non-nil. Then we would end up passing a garbaged string
3052 to file-executable-p. */
3054 tem
= (NILP (Ffile_directory_p (filename
))
3055 || NILP (Ffile_executable_p (filename
)));
3057 return tem
? Qnil
: Qt
;
3060 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3061 "Return t if file FILENAME is the name of a regular file.\n\
3062 This is the sort of file that holds an ordinary stream of data bytes.")
3064 Lisp_Object filename
;
3066 register Lisp_Object absname
;
3068 Lisp_Object handler
;
3070 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3072 /* If the file name has special constructs in it,
3073 call the corresponding file handler. */
3074 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3075 if (!NILP (handler
))
3076 return call2 (handler
, Qfile_regular_p
, absname
);
3078 absname
= ENCODE_FILE (absname
);
3080 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3082 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3085 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3086 "Return mode bits of file named FILENAME, as an integer.")
3088 Lisp_Object filename
;
3090 Lisp_Object absname
;
3092 Lisp_Object handler
;
3094 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3096 /* If the file name has special constructs in it,
3097 call the corresponding file handler. */
3098 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3099 if (!NILP (handler
))
3100 return call2 (handler
, Qfile_modes
, absname
);
3102 absname
= ENCODE_FILE (absname
);
3104 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3106 #if defined (MSDOS) && __DJGPP__ < 2
3107 if (check_executable (XSTRING (absname
)->data
))
3108 st
.st_mode
|= S_IEXEC
;
3109 #endif /* MSDOS && __DJGPP__ < 2 */
3111 return make_number (st
.st_mode
& 07777);
3114 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3115 "Set mode bits of file named FILENAME to MODE (an integer).\n\
3116 Only the 12 low bits of MODE are used.")
3118 Lisp_Object filename
, mode
;
3120 Lisp_Object absname
, encoded_absname
;
3121 Lisp_Object handler
;
3123 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3124 CHECK_NUMBER (mode
, 1);
3126 /* If the file name has special constructs in it,
3127 call the corresponding file handler. */
3128 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3129 if (!NILP (handler
))
3130 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3132 encoded_absname
= ENCODE_FILE (absname
);
3134 if (chmod (XSTRING (encoded_absname
)->data
, XINT (mode
)) < 0)
3135 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3140 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3141 "Set the file permission bits for newly created files.\n\
3142 The argument MODE should be an integer; only the low 9 bits are used.\n\
3143 This setting is inherited by subprocesses.")
3147 CHECK_NUMBER (mode
, 0);
3149 umask ((~ XINT (mode
)) & 0777);
3154 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3155 "Return the default file protection for created files.\n\
3156 The value is an integer.")
3162 realmask
= umask (0);
3165 XSETINT (value
, (~ realmask
) & 0777);
3171 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3172 "Tell Unix to finish all pending disk updates.")
3181 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3182 "Return t if file FILE1 is newer than file FILE2.\n\
3183 If FILE1 does not exist, the answer is nil;\n\
3184 otherwise, if FILE2 does not exist, the answer is t.")
3186 Lisp_Object file1
, file2
;
3188 Lisp_Object absname1
, absname2
;
3191 Lisp_Object handler
;
3192 struct gcpro gcpro1
, gcpro2
;
3194 CHECK_STRING (file1
, 0);
3195 CHECK_STRING (file2
, 0);
3198 GCPRO2 (absname1
, file2
);
3199 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3200 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3203 /* If the file name has special constructs in it,
3204 call the corresponding file handler. */
3205 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3207 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3208 if (!NILP (handler
))
3209 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3211 GCPRO2 (absname1
, absname2
);
3212 absname1
= ENCODE_FILE (absname1
);
3213 absname2
= ENCODE_FILE (absname2
);
3216 if (stat (XSTRING (absname1
)->data
, &st
) < 0)
3219 mtime1
= st
.st_mtime
;
3221 if (stat (XSTRING (absname2
)->data
, &st
) < 0)
3224 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3228 Lisp_Object Qfind_buffer_file_type
;
3231 #ifndef READ_BUF_SIZE
3232 #define READ_BUF_SIZE (64 << 10)
3235 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3237 "Insert contents of file FILENAME after point.\n\
3238 Returns list of absolute file name and number of bytes inserted.\n\
3239 If second argument VISIT is non-nil, the buffer's visited filename\n\
3240 and last save file modtime are set, and it is marked unmodified.\n\
3241 If visiting and the file does not exist, visiting is completed\n\
3242 before the error is signaled.\n\
3243 The optional third and fourth arguments BEG and END\n\
3244 specify what portion of the file to insert.\n\
3245 These arguments count bytes in the file, not characters in the buffer.\n\
3246 If VISIT is non-nil, BEG and END must be nil.\n\
3248 If optional fifth argument REPLACE is non-nil,\n\
3249 it means replace the current buffer contents (in the accessible portion)\n\
3250 with the file contents. This is better than simply deleting and inserting\n\
3251 the whole thing because (1) it preserves some marker positions\n\
3252 and (2) it puts less data in the undo list.\n\
3253 When REPLACE is non-nil, the value is the number of characters actually read,\n\
3254 which is often less than the number of characters to be read.\n\
3255 This does code conversion according to the value of\n\
3256 `coding-system-for-read' or `file-coding-system-alist',\n\
3257 and sets the variable `last-coding-system-used' to the coding system\n\
3259 (filename
, visit
, beg
, end
, replace
)
3260 Lisp_Object filename
, visit
, beg
, end
, replace
;
3265 register int how_much
;
3266 register int unprocessed
;
3267 int count
= specpdl_ptr
- specpdl
;
3268 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3269 Lisp_Object handler
, val
, insval
, orig_filename
;
3272 int not_regular
= 0;
3273 unsigned char read_buf
[READ_BUF_SIZE
];
3274 struct coding_system coding
;
3275 unsigned char buffer
[1 << 14];
3276 int replace_handled
= 0;
3277 int set_coding_system
= 0;
3279 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3280 error ("Cannot do file visiting in an indirect buffer");
3282 if (!NILP (current_buffer
->read_only
))
3283 Fbarf_if_buffer_read_only ();
3287 orig_filename
= Qnil
;
3289 GCPRO4 (filename
, val
, p
, orig_filename
);
3291 CHECK_STRING (filename
, 0);
3292 filename
= Fexpand_file_name (filename
, Qnil
);
3294 /* If the file name has special constructs in it,
3295 call the corresponding file handler. */
3296 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3297 if (!NILP (handler
))
3299 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3300 visit
, beg
, end
, replace
);
3304 orig_filename
= filename
;
3305 filename
= ENCODE_FILE (filename
);
3310 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3312 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
3313 || fstat (fd
, &st
) < 0)
3314 #endif /* not APOLLO */
3316 if (fd
>= 0) close (fd
);
3319 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3322 if (!NILP (Vcoding_system_for_read
))
3323 current_buffer
->buffer_file_coding_system
= Vcoding_system_for_read
;
3328 /* This code will need to be changed in order to work on named
3329 pipes, and it's probably just not worth it. So we should at
3330 least signal an error. */
3331 if (!S_ISREG (st
.st_mode
))
3338 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3339 Fsignal (Qfile_error
,
3340 Fcons (build_string ("not a regular file"),
3341 Fcons (orig_filename
, Qnil
)));
3346 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
3349 /* Replacement should preserve point as it preserves markers. */
3350 if (!NILP (replace
))
3351 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3353 record_unwind_protect (close_file_unwind
, make_number (fd
));
3355 /* Supposedly happens on VMS. */
3356 if (! not_regular
&& st
.st_size
< 0)
3357 error ("File size is negative");
3359 if (!NILP (beg
) || !NILP (end
))
3361 error ("Attempt to visit less than an entire file");
3364 CHECK_NUMBER (beg
, 0);
3366 XSETFASTINT (beg
, 0);
3369 CHECK_NUMBER (end
, 0);
3374 XSETINT (end
, st
.st_size
);
3375 if (XINT (end
) != st
.st_size
)
3376 error ("Maximum buffer size exceeded");
3380 /* Decide the coding-system of the file. */
3385 if (!NILP (Vcoding_system_for_read
))
3386 val
= Vcoding_system_for_read
;
3387 else if (! NILP (replace
))
3388 /* In REPLACE mode, we can use the same coding system
3389 that was used to visit the file. */
3390 val
= current_buffer
->buffer_file_coding_system
;
3391 else if (! not_regular
)
3393 /* Don't try looking inside a file for a coding system specification
3394 if it is not seekable. */
3395 if (! NILP (Vset_auto_coding_function
))
3397 /* Find a coding system specified in the heading two lines
3398 or in the tailing several lines of the file. We assume
3399 that the 1K-byte and 3K-byte for heading and tailing
3400 respectively are sufficient fot this purpose. */
3402 int beginning_of_end
, end_of_beginning
;
3404 if (st
.st_size
<= (1024 * 4))
3406 nread
= read (fd
, read_buf
, 1024 * 4);
3407 end_of_beginning
= nread
;
3408 beginning_of_end
= 0;
3412 nread
= read (fd
, read_buf
, 1024);
3413 end_of_beginning
= nread
;
3414 beginning_of_end
= nread
;
3417 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3418 report_file_error ("Setting file position",
3419 Fcons (orig_filename
, Qnil
));
3420 nread
+= read (fd
, read_buf
+ nread
, 1024 * 3);
3425 error ("IO error reading %s: %s",
3426 XSTRING (orig_filename
)->data
, strerror (errno
));
3430 int possible_spec
= 0;
3431 unsigned char *p
, *p1
;
3433 unsigned char *copy
= (unsigned char *) alloca (nread
+ 1);
3435 /* Make a copy of the contents of read_buf in COPY,
3436 and convert it to lower case so we can compare
3437 more efficiently. */
3438 bcopy (read_buf
, copy
, nread
);
3439 for (i
= 0; i
< nread
; i
++)
3440 copy
[i
] = DOWNCASE (copy
[i
]);
3441 /* Ensure various comparisons fail at end of data. */
3444 /* Now test quickly whether the file contains a -*- line. */
3446 while (*p
!= '\n' && p
- copy
< end_of_beginning
)
3448 if (copy
[0] == '#' && copy
[1] == '!')
3449 while (*p
!= '\n' && p
- copy
< end_of_beginning
)
3454 if (p1
[0] == '-' && p1
[1] == '*' && p1
[2] == '-')
3458 if (! bcmp ("coding:", p1
, 7))
3470 /* Test quickly whether the file
3471 contains a local variables list. */
3472 p
= ©
[nread
- 1];
3473 p1
= ©
[beginning_of_end
];
3476 if (p
[0] == '\n' && p
[1] == '\f')
3481 while (p1
- p
>= 16)
3483 if (! bcmp ("local variables:", p
, 16))
3494 /* Always make this a unibyte string
3495 because we have not yet decoded it. */
3496 tem
= make_unibyte_string (read_buf
, nread
);
3497 val
= call1 (Vset_auto_coding_function
, tem
);
3500 /* Rewind the file for the actual read done later. */
3501 if (lseek (fd
, 0, 0) < 0)
3502 report_file_error ("Setting file position",
3503 Fcons (orig_filename
, Qnil
));
3508 Lisp_Object args
[6], coding_systems
;
3510 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3511 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3512 coding_systems
= Ffind_operation_coding_system (6, args
);
3513 if (CONSP (coding_systems
))
3514 val
= XCONS (coding_systems
)->car
;
3518 if (NILP (Vcoding_system_for_read
)
3519 && NILP (current_buffer
->enable_multibyte_characters
))
3521 /* We must suppress all text conversion except for end-of-line
3523 struct coding_system coding_temp
;
3525 setup_coding_system (Fcheck_coding_system (val
), &coding_temp
);
3526 setup_coding_system (Qraw_text
, &coding
);
3527 coding
.eol_type
= coding_temp
.eol_type
;
3530 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3533 /* If requested, replace the accessible part of the buffer
3534 with the file contents. Avoid replacing text at the
3535 beginning or end of the buffer that matches the file contents;
3536 that preserves markers pointing to the unchanged parts.
3538 Here we implement this feature in an optimized way
3539 for the case where code conversion is NOT needed.
3540 The following if-statement handles the case of conversion
3541 in a less optimal way.
3543 If the code conversion is "automatic" then we try using this
3544 method and hope for the best.
3545 But if we discover the need for conversion, we give up on this method
3546 and let the following if-statement handle the replace job. */
3548 && ! CODING_REQUIRE_DECODING (&coding
)
3549 && (coding
.eol_type
== CODING_EOL_UNDECIDED
3550 || coding
.eol_type
== CODING_EOL_LF
))
3552 /* same_at_start and same_at_end count bytes,
3553 because file access counts bytes
3554 and BEG and END count bytes. */
3555 int same_at_start
= BEGV_BYTE
;
3556 int same_at_end
= ZV_BYTE
;
3558 /* There is still a possibility we will find the need to do code
3559 conversion. If that happens, we set this variable to 1 to
3560 give up on handling REPLACE in the optimized way. */
3561 int giveup_match_end
= 0;
3563 if (XINT (beg
) != 0)
3565 if (lseek (fd
, XINT (beg
), 0) < 0)
3566 report_file_error ("Setting file position",
3567 Fcons (orig_filename
, Qnil
));
3572 /* Count how many chars at the start of the file
3573 match the text at the beginning of the buffer. */
3578 nread
= read (fd
, buffer
, sizeof buffer
);
3580 error ("IO error reading %s: %s",
3581 XSTRING (orig_filename
)->data
, strerror (errno
));
3582 else if (nread
== 0)
3585 if (coding
.type
== coding_type_undecided
)
3586 detect_coding (&coding
, buffer
, nread
);
3587 if (CODING_REQUIRE_DECODING (&coding
))
3588 /* We found that the file should be decoded somehow.
3589 Let's give up here. */
3591 giveup_match_end
= 1;
3595 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3596 detect_eol (&coding
, buffer
, nread
);
3597 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3598 && coding
.eol_type
!= CODING_EOL_LF
)
3599 /* We found that the format of eol should be decoded.
3600 Let's give up here. */
3602 giveup_match_end
= 1;
3607 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3608 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3609 same_at_start
++, bufpos
++;
3610 /* If we found a discrepancy, stop the scan.
3611 Otherwise loop around and scan the next bufferful. */
3612 if (bufpos
!= nread
)
3616 /* If the file matches the buffer completely,
3617 there's no need to replace anything. */
3618 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3622 /* Truncate the buffer to the size of the file. */
3623 del_range_1 (same_at_start
, same_at_end
, 0);
3628 /* Count how many chars at the end of the file
3629 match the text at the end of the buffer. But, if we have
3630 already found that decoding is necessary, don't waste time. */
3631 while (!giveup_match_end
)
3633 int total_read
, nread
, bufpos
, curpos
, trial
;
3635 /* At what file position are we now scanning? */
3636 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3637 /* If the entire file matches the buffer tail, stop the scan. */
3640 /* How much can we scan in the next step? */
3641 trial
= min (curpos
, sizeof buffer
);
3642 if (lseek (fd
, curpos
- trial
, 0) < 0)
3643 report_file_error ("Setting file position",
3644 Fcons (orig_filename
, Qnil
));
3647 while (total_read
< trial
)
3649 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
3651 error ("IO error reading %s: %s",
3652 XSTRING (orig_filename
)->data
, strerror (errno
));
3653 total_read
+= nread
;
3655 /* Scan this bufferful from the end, comparing with
3656 the Emacs buffer. */
3657 bufpos
= total_read
;
3658 /* Compare with same_at_start to avoid counting some buffer text
3659 as matching both at the file's beginning and at the end. */
3660 while (bufpos
> 0 && same_at_end
> same_at_start
3661 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3662 same_at_end
--, bufpos
--;
3664 /* If we found a discrepancy, stop the scan.
3665 Otherwise loop around and scan the preceding bufferful. */
3668 /* If this discrepancy is because of code conversion,
3669 we cannot use this method; giveup and try the other. */
3670 if (same_at_end
> same_at_start
3671 && FETCH_BYTE (same_at_end
- 1) >= 0200
3672 && ! NILP (current_buffer
->enable_multibyte_characters
)
3673 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3674 giveup_match_end
= 1;
3680 if (! giveup_match_end
)
3684 /* We win! We can handle REPLACE the optimized way. */
3686 /* Extends the end of non-matching text area to multibyte
3687 character boundary. */
3688 if (! NILP (current_buffer
->enable_multibyte_characters
))
3689 while (same_at_end
< ZV_BYTE
3690 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3693 /* Don't try to reuse the same piece of text twice. */
3694 overlap
= (same_at_start
- BEGV_BYTE
3695 - (same_at_end
+ st
.st_size
- ZV
));
3697 same_at_end
+= overlap
;
3699 /* Arrange to read only the nonmatching middle part of the file. */
3700 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
3701 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
3703 del_range_byte (same_at_start
, same_at_end
, 0);
3704 /* Insert from the file at the proper position. */
3705 temp
= BYTE_TO_CHAR (same_at_start
);
3706 SET_PT_BOTH (temp
, same_at_start
);
3708 /* If display currently starts at beginning of line,
3709 keep it that way. */
3710 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3711 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3713 replace_handled
= 1;
3717 /* If requested, replace the accessible part of the buffer
3718 with the file contents. Avoid replacing text at the
3719 beginning or end of the buffer that matches the file contents;
3720 that preserves markers pointing to the unchanged parts.
3722 Here we implement this feature for the case where code conversion
3723 is needed, in a simple way that needs a lot of memory.
3724 The preceding if-statement handles the case of no conversion
3725 in a more optimized way. */
3726 if (!NILP (replace
) && ! replace_handled
)
3728 int same_at_start
= BEGV_BYTE
;
3729 int same_at_end
= ZV_BYTE
;
3732 /* Make sure that the gap is large enough. */
3733 int bufsize
= 2 * st
.st_size
;
3734 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
3737 /* First read the whole file, performing code conversion into
3738 CONVERSION_BUFFER. */
3740 if (lseek (fd
, XINT (beg
), 0) < 0)
3742 free (conversion_buffer
);
3743 report_file_error ("Setting file position",
3744 Fcons (orig_filename
, Qnil
));
3747 total
= st
.st_size
; /* Total bytes in the file. */
3748 how_much
= 0; /* Bytes read from file so far. */
3749 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3750 unprocessed
= 0; /* Bytes not processed in previous loop. */
3752 while (how_much
< total
)
3754 /* try is reserved in some compilers (Microsoft C) */
3755 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3756 char *destination
= read_buf
+ unprocessed
;
3759 /* Allow quitting out of the actual I/O. */
3762 this = read (fd
, destination
, trytry
);
3765 if (this < 0 || this + unprocessed
== 0)
3773 if (CODING_MAY_REQUIRE_DECODING (&coding
))
3775 int require
, result
;
3777 this += unprocessed
;
3779 /* If we are using more space than estimated,
3780 make CONVERSION_BUFFER bigger. */
3781 require
= decoding_buffer_size (&coding
, this);
3782 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
3784 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
3785 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
3788 /* Convert this batch with results in CONVERSION_BUFFER. */
3789 if (how_much
>= total
) /* This is the last block. */
3790 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3791 result
= decode_coding (&coding
, read_buf
,
3792 conversion_buffer
+ inserted
,
3793 this, bufsize
- inserted
);
3795 /* Save for next iteration whatever we didn't convert. */
3796 unprocessed
= this - coding
.consumed
;
3797 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
3798 this = coding
.produced
;
3804 /* At this point, INSERTED is how many characters (i.e. bytes)
3805 are present in CONVERSION_BUFFER.
3806 HOW_MUCH should equal TOTAL,
3807 or should be <= 0 if we couldn't read the file. */
3811 free (conversion_buffer
);
3814 error ("IO error reading %s: %s",
3815 XSTRING (orig_filename
)->data
, strerror (errno
));
3816 else if (how_much
== -2)
3817 error ("maximum buffer size exceeded");
3820 /* Compare the beginning of the converted file
3821 with the buffer text. */
3824 while (bufpos
< inserted
&& same_at_start
< same_at_end
3825 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
3826 same_at_start
++, bufpos
++;
3828 /* If the file matches the buffer completely,
3829 there's no need to replace anything. */
3831 if (bufpos
== inserted
)
3833 free (conversion_buffer
);
3836 /* Truncate the buffer to the size of the file. */
3837 del_range_1 (same_at_start
, same_at_end
, 0);
3841 /* Scan this bufferful from the end, comparing with
3842 the Emacs buffer. */
3845 /* Compare with same_at_start to avoid counting some buffer text
3846 as matching both at the file's beginning and at the end. */
3847 while (bufpos
> 0 && same_at_end
> same_at_start
3848 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
3849 same_at_end
--, bufpos
--;
3851 /* Don't try to reuse the same piece of text twice. */
3852 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
3854 same_at_end
+= overlap
;
3856 /* If display currently starts at beginning of line,
3857 keep it that way. */
3858 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3859 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3861 /* Replace the chars that we need to replace,
3862 and update INSERTED to equal the number of bytes
3863 we are taking from the file. */
3864 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
3865 del_range_byte (same_at_start
, same_at_end
, 0);
3866 if (same_at_end
!= same_at_start
)
3867 SET_PT_BOTH (GPT
, GPT_BYTE
);
3870 /* Insert from the file at the proper position. */
3871 temp
= BYTE_TO_CHAR (same_at_start
);
3872 SET_PT_BOTH (temp
, same_at_start
);
3875 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
3878 free (conversion_buffer
);
3887 register Lisp_Object temp
;
3889 total
= XINT (end
) - XINT (beg
);
3891 /* Make sure point-max won't overflow after this insertion. */
3892 XSETINT (temp
, total
);
3893 if (total
!= XINT (temp
))
3894 error ("Maximum buffer size exceeded");
3897 /* For a special file, all we can do is guess. */
3898 total
= READ_BUF_SIZE
;
3900 if (NILP (visit
) && total
> 0)
3901 prepare_to_modify_buffer (PT
, PT
, NULL
);
3904 if (GAP_SIZE
< total
)
3905 make_gap (total
- GAP_SIZE
);
3907 if (XINT (beg
) != 0 || !NILP (replace
))
3909 if (lseek (fd
, XINT (beg
), 0) < 0)
3910 report_file_error ("Setting file position",
3911 Fcons (orig_filename
, Qnil
));
3914 /* In the following loop, HOW_MUCH contains the total bytes read so
3915 far for a regular file, and not changed for a special file. But,
3916 before exiting the loop, it is set to a negative value if I/O
3919 /* Total bytes inserted. */
3921 /* Here, we don't do code conversion in the loop. It is done by
3922 code_convert_region after all data are read into the buffer. */
3923 while (how_much
< total
)
3925 /* try is reserved in some compilers (Microsoft C) */
3926 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
3929 /* For a special file, GAP_SIZE should be checked every time. */
3930 if (not_regular
&& GAP_SIZE
< trytry
)
3931 make_gap (total
- GAP_SIZE
);
3933 /* Allow quitting out of the actual I/O. */
3936 this = read (fd
, BYTE_POS_ADDR (PT_BYTE
+ inserted
- 1) + 1, trytry
);
3953 /* For a regular file, where TOTAL is the real size,
3954 count HOW_MUCH to compare with it.
3955 For a special file, where TOTAL is just a buffer size,
3956 so don't bother counting in HOW_MUCH.
3957 (INSERTED is where we count the number of characters inserted.) */
3964 /* Put an anchor to ensure multi-byte form ends at gap. */
3969 /* Discard the unwind protect for closing the file. */
3973 error ("IO error reading %s: %s",
3974 XSTRING (orig_filename
)->data
, strerror (errno
));
3978 if (CODING_MAY_REQUIRE_DECODING (&coding
))
3980 /* Here, we don't have to consider byte combining (see the
3981 comment below) because code_convert_region takes care of
3983 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
3985 inserted
= (NILP (current_buffer
->enable_multibyte_characters
)
3986 ? coding
.produced
: coding
.produced_char
);
3988 else if (!NILP (current_buffer
->enable_multibyte_characters
))
3990 int inserted_byte
= inserted
;
3992 /* There's a possibility that we must combine bytes at the
3993 head (resp. the tail) of the just inserted text with the
3994 bytes before (resp. after) the gap to form a single
3996 inserted
= multibyte_chars_in_text (GPT_ADDR
- inserted
, inserted
);
3997 adjust_after_insert (PT
, PT_BYTE
,
3998 PT
+ inserted_byte
, PT_BYTE
+ inserted_byte
,
4002 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4006 /* Use the conversion type to determine buffer-file-type
4007 (find-buffer-file-type is now used to help determine the
4009 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4010 || coding
.eol_type
== CODING_EOL_LF
)
4011 && ! CODING_REQUIRE_DECODING (&coding
))
4012 current_buffer
->buffer_file_type
= Qt
;
4014 current_buffer
->buffer_file_type
= Qnil
;
4018 set_coding_system
= 1;
4025 if (!EQ (current_buffer
->undo_list
, Qt
))
4026 current_buffer
->undo_list
= Qnil
;
4028 stat (XSTRING (filename
)->data
, &st
);
4033 current_buffer
->modtime
= st
.st_mtime
;
4034 current_buffer
->filename
= orig_filename
;
4037 SAVE_MODIFF
= MODIFF
;
4038 current_buffer
->auto_save_modified
= MODIFF
;
4039 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4040 #ifdef CLASH_DETECTION
4043 if (!NILP (current_buffer
->file_truename
))
4044 unlock_file (current_buffer
->file_truename
);
4045 unlock_file (filename
);
4047 #endif /* CLASH_DETECTION */
4049 Fsignal (Qfile_error
,
4050 Fcons (build_string ("not a regular file"),
4051 Fcons (orig_filename
, Qnil
)));
4053 /* If visiting nonexistent file, return nil. */
4054 if (current_buffer
->modtime
== -1)
4055 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4058 /* Decode file format */
4061 insval
= call3 (Qformat_decode
,
4062 Qnil
, make_number (inserted
), visit
);
4063 CHECK_NUMBER (insval
, 0);
4064 inserted
= XFASTINT (insval
);
4067 /* Call after-change hooks for the inserted text, aside from the case
4068 of normal visiting (not with REPLACE), which is done in a new buffer
4069 "before" the buffer is changed. */
4070 if (inserted
> 0 && total
> 0
4071 && (NILP (visit
) || !NILP (replace
)))
4072 signal_after_change (PT
, 0, inserted
);
4074 if (set_coding_system
)
4075 Vlast_coding_system_used
= coding
.symbol
;
4079 p
= Vafter_insert_file_functions
;
4082 insval
= call1 (Fcar (p
), make_number (inserted
));
4085 CHECK_NUMBER (insval
, 0);
4086 inserted
= XFASTINT (insval
);
4093 /* ??? Retval needs to be dealt with in all cases consistently. */
4095 val
= Fcons (orig_filename
,
4096 Fcons (make_number (inserted
),
4099 RETURN_UNGCPRO (unbind_to (count
, val
));
4102 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
,
4105 /* If build_annotations switched buffers, switch back to BUF.
4106 Kill the temporary buffer that was selected in the meantime.
4108 Since this kill only the last temporary buffer, some buffers remain
4109 not killed if build_annotations switched buffers more than once.
4113 build_annotations_unwind (buf
)
4118 if (XBUFFER (buf
) == current_buffer
)
4120 tembuf
= Fcurrent_buffer ();
4122 Fkill_buffer (tembuf
);
4126 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4127 "r\nFWrite region to file: \ni\ni\ni\np",
4128 "Write current region into specified file.\n\
4129 When called from a program, takes three arguments:\n\
4130 START, END and FILENAME. START and END are buffer positions.\n\
4131 Optional fourth argument APPEND if non-nil means\n\
4132 append to existing file contents (if any).\n\
4133 Optional fifth argument VISIT if t means\n\
4134 set the last-save-file-modtime of buffer to this file's modtime\n\
4135 and mark buffer not modified.\n\
4136 If VISIT is a string, it is a second file name;\n\
4137 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
4138 VISIT is also the file name to lock and unlock for clash detection.\n\
4139 If VISIT is neither t nor nil nor a string,\n\
4140 that means do not print the \"Wrote file\" message.\n\
4141 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
4142 use for locking and unlocking, overriding FILENAME and VISIT.\n\
4143 The optional seventh arg CONFIRM, if non-nil, says ask for confirmation\n\
4144 before overwriting an existing file.\n\
4145 Kludgy feature: if START is a string, then that string is written\n\
4146 to the file, instead of any buffer contents, and END is ignored.")
4147 (start
, end
, filename
, append
, visit
, lockname
, confirm
)
4148 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, confirm
;
4156 int count
= specpdl_ptr
- specpdl
;
4159 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4161 Lisp_Object handler
;
4162 Lisp_Object visit_file
;
4163 Lisp_Object annotations
;
4164 Lisp_Object encoded_filename
;
4165 int visiting
, quietly
;
4166 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4167 struct buffer
*given_buffer
;
4169 int buffer_file_type
= O_BINARY
;
4171 struct coding_system coding
;
4173 if (current_buffer
->base_buffer
&& ! NILP (visit
))
4174 error ("Cannot do file visiting in an indirect buffer");
4176 if (!NILP (start
) && !STRINGP (start
))
4177 validate_region (&start
, &end
);
4179 GCPRO4 (start
, filename
, visit
, lockname
);
4181 /* Decide the coding-system to encode the data with. */
4187 else if (!NILP (Vcoding_system_for_write
))
4188 val
= Vcoding_system_for_write
;
4189 else if (NILP (current_buffer
->enable_multibyte_characters
))
4191 /* If the variable `buffer-file-coding-system' is set locally,
4192 it means that the file was read with some kind of code
4193 conversion or the varialbe is explicitely set by users. We
4194 had better write it out with the same coding system even if
4195 `enable-multibyte-characters' is nil.
4197 If it is not set locally, we anyway have to convert EOL
4198 format if the default value of `buffer-file-coding-system'
4199 tells that it is not Unix-like (LF only) format. */
4200 val
= current_buffer
->buffer_file_coding_system
;
4201 if (NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4203 struct coding_system coding_temp
;
4205 setup_coding_system (Fcheck_coding_system (val
), &coding_temp
);
4206 if (coding_temp
.eol_type
== CODING_EOL_CRLF
4207 || coding_temp
.eol_type
== CODING_EOL_CR
)
4209 setup_coding_system (Qraw_text
, &coding
);
4210 coding
.eol_type
= coding_temp
.eol_type
;
4211 goto done_setup_coding
;
4218 Lisp_Object args
[7], coding_systems
;
4220 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4221 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4223 coding_systems
= Ffind_operation_coding_system (7, args
);
4224 val
= (CONSP (coding_systems
) && !NILP (XCONS (coding_systems
)->cdr
)
4225 ? XCONS (coding_systems
)->cdr
4226 : current_buffer
->buffer_file_coding_system
);
4227 /* Confirm that VAL can surely encode the current region. */
4228 if (!NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4229 val
= call3 (Vselect_safe_coding_system_function
, start
, end
, val
);
4231 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4234 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4235 coding
.mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4238 Vlast_coding_system_used
= coding
.symbol
;
4240 filename
= Fexpand_file_name (filename
, Qnil
);
4242 if (! NILP (confirm
))
4243 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4245 if (STRINGP (visit
))
4246 visit_file
= Fexpand_file_name (visit
, Qnil
);
4248 visit_file
= filename
;
4251 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4252 quietly
= !NILP (visit
);
4256 if (NILP (lockname
))
4257 lockname
= visit_file
;
4259 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4261 /* If the file name has special constructs in it,
4262 call the corresponding file handler. */
4263 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4264 /* If FILENAME has no handler, see if VISIT has one. */
4265 if (NILP (handler
) && STRINGP (visit
))
4266 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4268 if (!NILP (handler
))
4271 val
= call6 (handler
, Qwrite_region
, start
, end
,
4272 filename
, append
, visit
);
4276 SAVE_MODIFF
= MODIFF
;
4277 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4278 current_buffer
->filename
= visit_file
;
4284 /* Special kludge to simplify auto-saving. */
4287 XSETFASTINT (start
, BEG
);
4288 XSETFASTINT (end
, Z
);
4291 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4292 count1
= specpdl_ptr
- specpdl
;
4294 given_buffer
= current_buffer
;
4295 annotations
= build_annotations (start
, end
, coding
.pre_write_conversion
);
4296 if (current_buffer
!= given_buffer
)
4298 XSETFASTINT (start
, BEGV
);
4299 XSETFASTINT (end
, ZV
);
4302 #ifdef CLASH_DETECTION
4305 #if 0 /* This causes trouble for GNUS. */
4306 /* If we've locked this file for some other buffer,
4307 query before proceeding. */
4308 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4309 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4312 lock_file (lockname
);
4314 #endif /* CLASH_DETECTION */
4316 encoded_filename
= ENCODE_FILE (filename
);
4318 fn
= XSTRING (encoded_filename
)->data
;
4322 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
4323 #else /* not DOS_NT */
4324 desc
= open (fn
, O_WRONLY
);
4325 #endif /* not DOS_NT */
4327 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4329 if (auto_saving
) /* Overwrite any previous version of autosave file */
4331 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4332 desc
= open (fn
, O_RDWR
);
4334 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4335 ? XSTRING (current_buffer
->filename
)->data
: 0,
4338 else /* Write to temporary name and rename if no errors */
4340 Lisp_Object temp_name
;
4341 temp_name
= Ffile_name_directory (filename
);
4343 if (!NILP (temp_name
))
4345 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4346 build_string ("$$SAVE$$")));
4347 fname
= XSTRING (filename
)->data
;
4348 fn
= XSTRING (temp_name
)->data
;
4349 desc
= creat_copy_attrs (fname
, fn
);
4352 /* If we can't open the temporary file, try creating a new
4353 version of the original file. VMS "creat" creates a
4354 new version rather than truncating an existing file. */
4357 desc
= creat (fn
, 0666);
4358 #if 0 /* This can clobber an existing file and fail to replace it,
4359 if the user runs out of space. */
4362 /* We can't make a new version;
4363 try to truncate and rewrite existing version if any. */
4365 desc
= open (fn
, O_RDWR
);
4371 desc
= creat (fn
, 0666);
4376 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
4377 S_IREAD
| S_IWRITE
);
4378 #else /* not DOS_NT */
4379 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
4380 #endif /* not DOS_NT */
4381 #endif /* not VMS */
4387 #ifdef CLASH_DETECTION
4389 if (!auto_saving
) unlock_file (lockname
);
4391 #endif /* CLASH_DETECTION */
4392 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4395 record_unwind_protect (close_file_unwind
, make_number (desc
));
4398 if (lseek (desc
, 0, 2) < 0)
4400 #ifdef CLASH_DETECTION
4401 if (!auto_saving
) unlock_file (lockname
);
4402 #endif /* CLASH_DETECTION */
4403 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4408 * Kludge Warning: The VMS C RTL likes to insert carriage returns
4409 * if we do writes that don't end with a carriage return. Furthermore
4410 * it cannot handle writes of more then 16K. The modified
4411 * version of "sys_write" in SYSDEP.C (see comment there) copes with
4412 * this EXCEPT for the last record (iff it doesn't end with a carriage
4413 * return). This implies that if your buffer doesn't end with a carriage
4414 * return, you get one free... tough. However it also means that if
4415 * we make two calls to sys_write (a la the following code) you can
4416 * get one at the gap as well. The easiest way to fix this (honest)
4417 * is to move the gap to the next newline (or the end of the buffer).
4422 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4423 move_gap (find_next_newline (GPT
, 1));
4425 /* Whether VMS or not, we must move the gap to the next of newline
4426 when we must put designation sequences at beginning of line. */
4427 if (INTEGERP (start
)
4428 && coding
.type
== coding_type_iso2022
4429 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
4430 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4432 int opoint
= PT
, opoint_byte
= PT_BYTE
;
4433 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
4434 move_gap_both (PT
, PT_BYTE
);
4435 SET_PT_BOTH (opoint
, opoint_byte
);
4442 if (STRINGP (start
))
4444 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
4445 STRING_BYTES (XSTRING (start
)), 0, &annotations
,
4449 else if (XINT (start
) != XINT (end
))
4451 register int end1
= CHAR_TO_BYTE (XINT (end
));
4453 tem
= CHAR_TO_BYTE (XINT (start
));
4455 if (XINT (start
) < GPT
)
4457 failure
= 0 > a_write (desc
, BYTE_POS_ADDR (tem
),
4458 min (GPT_BYTE
, end1
) - tem
, tem
, &annotations
,
4463 if (XINT (end
) > GPT
&& !failure
)
4465 tem
= max (tem
, GPT_BYTE
);
4466 failure
= 0 > a_write (desc
, BYTE_POS_ADDR (tem
), end1
- tem
,
4467 tem
, &annotations
, &coding
);
4473 /* If file was empty, still need to write the annotations */
4474 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4475 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
, &coding
);
4479 if (CODING_REQUIRE_FLUSHING (&coding
)
4480 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
4483 /* We have to flush out a data. */
4484 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4485 failure
= 0 > e_write (desc
, "", 0, &coding
);
4492 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4493 Disk full in NFS may be reported here. */
4494 /* mib says that closing the file will try to write as fast as NFS can do
4495 it, and that means the fsync here is not crucial for autosave files. */
4496 if (!auto_saving
&& fsync (desc
) < 0)
4498 /* If fsync fails with EINTR, don't treat that as serious. */
4500 failure
= 1, save_errno
= errno
;
4504 /* Spurious "file has changed on disk" warnings have been
4505 observed on Suns as well.
4506 It seems that `close' can change the modtime, under nfs.
4508 (This has supposedly been fixed in Sunos 4,
4509 but who knows about all the other machines with NFS?) */
4512 /* On VMS and APOLLO, must do the stat after the close
4513 since closing changes the modtime. */
4516 /* Recall that #if defined does not work on VMS. */
4523 /* NFS can report a write failure now. */
4524 if (close (desc
) < 0)
4525 failure
= 1, save_errno
= errno
;
4528 /* If we wrote to a temporary name and had no errors, rename to real name. */
4532 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
4540 /* Discard the unwind protect for close_file_unwind. */
4541 specpdl_ptr
= specpdl
+ count1
;
4542 /* Restore the original current buffer. */
4543 visit_file
= unbind_to (count
, visit_file
);
4545 #ifdef CLASH_DETECTION
4547 unlock_file (lockname
);
4548 #endif /* CLASH_DETECTION */
4550 /* Do this before reporting IO error
4551 to avoid a "file has changed on disk" warning on
4552 next attempt to save. */
4554 current_buffer
->modtime
= st
.st_mtime
;
4557 error ("IO error writing %s: %s", XSTRING (filename
)->data
,
4558 strerror (save_errno
));
4562 SAVE_MODIFF
= MODIFF
;
4563 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4564 current_buffer
->filename
= visit_file
;
4565 update_mode_lines
++;
4571 message_with_string ("Wrote %s", visit_file
, 1);
4576 Lisp_Object
merge ();
4578 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4579 "Return t if (car A) is numerically less than (car B).")
4583 return Flss (Fcar (a
), Fcar (b
));
4586 /* Build the complete list of annotations appropriate for writing out
4587 the text between START and END, by calling all the functions in
4588 write-region-annotate-functions and merging the lists they return.
4589 If one of these functions switches to a different buffer, we assume
4590 that buffer contains altered text. Therefore, the caller must
4591 make sure to restore the current buffer in all cases,
4592 as save-excursion would do. */
4595 build_annotations (start
, end
, pre_write_conversion
)
4596 Lisp_Object start
, end
, pre_write_conversion
;
4598 Lisp_Object annotations
;
4600 struct gcpro gcpro1
, gcpro2
;
4601 Lisp_Object original_buffer
;
4603 XSETBUFFER (original_buffer
, current_buffer
);
4606 p
= Vwrite_region_annotate_functions
;
4607 GCPRO2 (annotations
, p
);
4610 struct buffer
*given_buffer
= current_buffer
;
4611 Vwrite_region_annotations_so_far
= annotations
;
4612 res
= call2 (Fcar (p
), start
, end
);
4613 /* If the function makes a different buffer current,
4614 assume that means this buffer contains altered text to be output.
4615 Reset START and END from the buffer bounds
4616 and discard all previous annotations because they should have
4617 been dealt with by this function. */
4618 if (current_buffer
!= given_buffer
)
4620 XSETFASTINT (start
, BEGV
);
4621 XSETFASTINT (end
, ZV
);
4624 Flength (res
); /* Check basic validity of return value */
4625 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4629 /* Now do the same for annotation functions implied by the file-format */
4630 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
4631 p
= Vauto_save_file_format
;
4633 p
= current_buffer
->file_format
;
4636 struct buffer
*given_buffer
= current_buffer
;
4637 Vwrite_region_annotations_so_far
= annotations
;
4638 res
= call4 (Qformat_annotate_function
, Fcar (p
), start
, end
,
4640 if (current_buffer
!= given_buffer
)
4642 XSETFASTINT (start
, BEGV
);
4643 XSETFASTINT (end
, ZV
);
4647 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4651 /* At last, do the same for the function PRE_WRITE_CONVERSION
4652 implied by the current coding-system. */
4653 if (!NILP (pre_write_conversion
))
4655 struct buffer
*given_buffer
= current_buffer
;
4656 Vwrite_region_annotations_so_far
= annotations
;
4657 res
= call2 (pre_write_conversion
, start
, end
);
4659 annotations
= (current_buffer
!= given_buffer
4661 : merge (annotations
, res
, Qcar_less_than_car
));
4668 /* Write to descriptor DESC the NBYTES bytes starting at ADDR,
4669 assuming they start at byte position BYTEPOS in the buffer.
4670 Intersperse with them the annotations from *ANNOT
4671 which fall within the range of byte positions BYTEPOS to BYTEPOS + NBYTES,
4672 each at its appropriate position.
4674 We modify *ANNOT by discarding elements as we use them up.
4676 The return value is negative in case of system call failure. */
4679 a_write (desc
, addr
, nbytes
, bytepos
, annot
, coding
)
4681 register char *addr
;
4682 register int nbytes
;
4685 struct coding_system
*coding
;
4689 int lastpos
= bytepos
+ nbytes
;
4691 while (NILP (*annot
) || CONSP (*annot
))
4693 tem
= Fcar_safe (Fcar (*annot
));
4694 nextpos
= bytepos
- 1;
4696 nextpos
= CHAR_TO_BYTE (XFASTINT (tem
));
4698 /* If there are no more annotations in this range,
4699 output the rest of the range all at once. */
4700 if (! (nextpos
>= bytepos
&& nextpos
<= lastpos
))
4701 return e_write (desc
, addr
, lastpos
- bytepos
, coding
);
4703 /* Output buffer text up to the next annotation's position. */
4704 if (nextpos
> bytepos
)
4706 if (0 > e_write (desc
, addr
, nextpos
- bytepos
, coding
))
4708 addr
+= nextpos
- bytepos
;
4711 /* Output the annotation. */
4712 tem
= Fcdr (Fcar (*annot
));
4715 if (0 > e_write (desc
, XSTRING (tem
)->data
, STRING_BYTES (XSTRING (tem
)),
4719 *annot
= Fcdr (*annot
);
4724 #ifndef WRITE_BUF_SIZE
4725 #define WRITE_BUF_SIZE (16 * 1024)
4728 /* Write NBYTES bytes starting at ADDR into descriptor DESC,
4729 encoding them with coding system CODING. */
4732 e_write (desc
, addr
, nbytes
, coding
)
4734 register char *addr
;
4735 register int nbytes
;
4736 struct coding_system
*coding
;
4738 char buf
[WRITE_BUF_SIZE
];
4740 /* We used to have a code for handling selective display here. But,
4741 now it is handled within encode_coding. */
4744 encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
4745 nbytes
-= coding
->consumed
, addr
+= coding
->consumed
;
4746 if (coding
->produced
> 0)
4748 coding
->produced
-= write (desc
, buf
, coding
->produced
);
4749 if (coding
->produced
) return -1;
4757 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
4758 Sverify_visited_file_modtime
, 1, 1, 0,
4759 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
4760 This means that the file has not been changed since it was visited or saved.")
4766 Lisp_Object handler
;
4767 Lisp_Object filename
;
4769 CHECK_BUFFER (buf
, 0);
4772 if (!STRINGP (b
->filename
)) return Qt
;
4773 if (b
->modtime
== 0) return Qt
;
4775 /* If the file name has special constructs in it,
4776 call the corresponding file handler. */
4777 handler
= Ffind_file_name_handler (b
->filename
,
4778 Qverify_visited_file_modtime
);
4779 if (!NILP (handler
))
4780 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
4782 filename
= ENCODE_FILE (b
->filename
);
4784 if (stat (XSTRING (filename
)->data
, &st
) < 0)
4786 /* If the file doesn't exist now and didn't exist before,
4787 we say that it isn't modified, provided the error is a tame one. */
4788 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
4793 if (st
.st_mtime
== b
->modtime
4794 /* If both are positive, accept them if they are off by one second. */
4795 || (st
.st_mtime
> 0 && b
->modtime
> 0
4796 && (st
.st_mtime
== b
->modtime
+ 1
4797 || st
.st_mtime
== b
->modtime
- 1)))
4802 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
4803 Sclear_visited_file_modtime
, 0, 0, 0,
4804 "Clear out records of last mod time of visited file.\n\
4805 Next attempt to save will certainly not complain of a discrepancy.")
4808 current_buffer
->modtime
= 0;
4812 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
4813 Svisited_file_modtime
, 0, 0, 0,
4814 "Return the current buffer's recorded visited file modification time.\n\
4815 The value is a list of the form (HIGH . LOW), like the time values\n\
4816 that `file-attributes' returns.")
4819 return long_to_cons ((unsigned long) current_buffer
->modtime
);
4822 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
4823 Sset_visited_file_modtime
, 0, 1, 0,
4824 "Update buffer's recorded modification time from the visited file's time.\n\
4825 Useful if the buffer was not read from the file normally\n\
4826 or if the file itself has been changed for some known benign reason.\n\
4827 An argument specifies the modification time value to use\n\
4828 \(instead of that of the visited file), in the form of a list\n\
4829 \(HIGH . LOW) or (HIGH LOW).")
4831 Lisp_Object time_list
;
4833 if (!NILP (time_list
))
4834 current_buffer
->modtime
= cons_to_long (time_list
);
4837 register Lisp_Object filename
;
4839 Lisp_Object handler
;
4841 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
4843 /* If the file name has special constructs in it,
4844 call the corresponding file handler. */
4845 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
4846 if (!NILP (handler
))
4847 /* The handler can find the file name the same way we did. */
4848 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
4850 filename
= ENCODE_FILE (filename
);
4852 if (stat (XSTRING (filename
)->data
, &st
) >= 0)
4853 current_buffer
->modtime
= st
.st_mtime
;
4863 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 1);
4864 Fsleep_for (make_number (1), Qnil
);
4865 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
4866 Fsleep_for (make_number (1), Qnil
);
4867 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
4868 Fsleep_for (make_number (1), Qnil
);
4878 /* Get visited file's mode to become the auto save file's mode. */
4879 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
4880 /* But make sure we can overwrite it later! */
4881 auto_save_mode_bits
= st
.st_mode
| 0600;
4883 auto_save_mode_bits
= 0666;
4886 Fwrite_region (Qnil
, Qnil
,
4887 current_buffer
->auto_save_file_name
,
4888 Qnil
, Qlambda
, Qnil
, Qnil
);
4892 do_auto_save_unwind (stream
) /* used as unwind-protect function */
4897 fclose ((FILE *) (XFASTINT (XCONS (stream
)->car
) << 16
4898 | XFASTINT (XCONS (stream
)->cdr
)));
4903 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
4906 minibuffer_auto_raise
= XINT (value
);
4910 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
4911 "Auto-save all buffers that need it.\n\
4912 This is all buffers that have auto-saving enabled\n\
4913 and are changed since last auto-saved.\n\
4914 Auto-saving writes the buffer into a file\n\
4915 so that your editing is not lost if the system crashes.\n\
4916 This file is not the file you visited; that changes only when you save.\n\
4917 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
4918 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
4919 A non-nil CURRENT-ONLY argument means save only current buffer.")
4920 (no_message
, current_only
)
4921 Lisp_Object no_message
, current_only
;
4923 struct buffer
*old
= current_buffer
, *b
;
4924 Lisp_Object tail
, buf
;
4926 char *omessage
= echo_area_glyphs
;
4927 int omessage_length
= echo_area_glyphs_length
;
4928 int oldmultibyte
= message_enable_multibyte
;
4929 int do_handled_files
;
4932 Lisp_Object lispstream
;
4933 int count
= specpdl_ptr
- specpdl
;
4935 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
4937 /* Ordinarily don't quit within this function,
4938 but don't make it impossible to quit (in case we get hung in I/O). */
4942 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
4943 point to non-strings reached from Vbuffer_alist. */
4948 if (!NILP (Vrun_hooks
))
4949 call1 (Vrun_hooks
, intern ("auto-save-hook"));
4951 if (STRINGP (Vauto_save_list_file_name
))
4953 Lisp_Object listfile
;
4954 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
4955 stream
= fopen (XSTRING (listfile
)->data
, "w");
4958 /* Arrange to close that file whether or not we get an error.
4959 Also reset auto_saving to 0. */
4960 lispstream
= Fcons (Qnil
, Qnil
);
4961 XSETFASTINT (XCONS (lispstream
)->car
, (EMACS_UINT
)stream
>> 16);
4962 XSETFASTINT (XCONS (lispstream
)->cdr
, (EMACS_UINT
)stream
& 0xffff);
4973 record_unwind_protect (do_auto_save_unwind
, lispstream
);
4974 record_unwind_protect (do_auto_save_unwind_1
,
4975 make_number (minibuffer_auto_raise
));
4976 minibuffer_auto_raise
= 0;
4979 /* First, save all files which don't have handlers. If Emacs is
4980 crashing, the handlers may tweak what is causing Emacs to crash
4981 in the first place, and it would be a shame if Emacs failed to
4982 autosave perfectly ordinary files because it couldn't handle some
4984 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
4985 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
4987 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
4990 /* Record all the buffers that have auto save mode
4991 in the special file that lists them. For each of these buffers,
4992 Record visited name (if any) and auto save name. */
4993 if (STRINGP (b
->auto_save_file_name
)
4994 && stream
!= NULL
&& do_handled_files
== 0)
4996 if (!NILP (b
->filename
))
4998 fwrite (XSTRING (b
->filename
)->data
, 1,
4999 STRING_BYTES (XSTRING (b
->filename
)), stream
);
5001 putc ('\n', stream
);
5002 fwrite (XSTRING (b
->auto_save_file_name
)->data
, 1,
5003 STRING_BYTES (XSTRING (b
->auto_save_file_name
)), stream
);
5004 putc ('\n', stream
);
5007 if (!NILP (current_only
)
5008 && b
!= current_buffer
)
5011 /* Don't auto-save indirect buffers.
5012 The base buffer takes care of it. */
5016 /* Check for auto save enabled
5017 and file changed since last auto save
5018 and file changed since last real save. */
5019 if (STRINGP (b
->auto_save_file_name
)
5020 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5021 && b
->auto_save_modified
< BUF_MODIFF (b
)
5022 /* -1 means we've turned off autosaving for a while--see below. */
5023 && XINT (b
->save_length
) >= 0
5024 && (do_handled_files
5025 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5028 EMACS_TIME before_time
, after_time
;
5030 EMACS_GET_TIME (before_time
);
5032 /* If we had a failure, don't try again for 20 minutes. */
5033 if (b
->auto_save_failure_time
>= 0
5034 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5037 if ((XFASTINT (b
->save_length
) * 10
5038 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5039 /* A short file is likely to change a large fraction;
5040 spare the user annoying messages. */
5041 && XFASTINT (b
->save_length
) > 5000
5042 /* These messages are frequent and annoying for `*mail*'. */
5043 && !EQ (b
->filename
, Qnil
)
5044 && NILP (no_message
))
5046 /* It has shrunk too much; turn off auto-saving here. */
5047 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5048 message_with_string ("Buffer %s has shrunk a lot; auto save turned off there",
5050 minibuffer_auto_raise
= 0;
5051 /* Turn off auto-saving until there's a real save,
5052 and prevent any more warnings. */
5053 XSETINT (b
->save_length
, -1);
5054 Fsleep_for (make_number (1), Qnil
);
5057 set_buffer_internal (b
);
5058 if (!auto_saved
&& NILP (no_message
))
5059 message1 ("Auto-saving...");
5060 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5062 b
->auto_save_modified
= BUF_MODIFF (b
);
5063 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5064 set_buffer_internal (old
);
5066 EMACS_GET_TIME (after_time
);
5068 /* If auto-save took more than 60 seconds,
5069 assume it was an NFS failure that got a timeout. */
5070 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5071 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5075 /* Prevent another auto save till enough input events come in. */
5076 record_auto_save ();
5078 if (auto_saved
&& NILP (no_message
))
5082 sit_for (1, 0, 0, 0, 0);
5083 message2 (omessage
, omessage_length
, oldmultibyte
);
5086 message1 ("Auto-saving...done");
5091 unbind_to (count
, Qnil
);
5095 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5096 Sset_buffer_auto_saved
, 0, 0, 0,
5097 "Mark current buffer as auto-saved with its current text.\n\
5098 No auto-save file will be written until the buffer changes again.")
5101 current_buffer
->auto_save_modified
= MODIFF
;
5102 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5103 current_buffer
->auto_save_failure_time
= -1;
5107 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5108 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5109 "Clear any record of a recent auto-save failure in the current buffer.")
5112 current_buffer
->auto_save_failure_time
= -1;
5116 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5118 "Return t if buffer has been auto-saved since last read in or saved.")
5121 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5124 /* Reading and completing file names */
5125 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
5127 /* In the string VAL, change each $ to $$ and return the result. */
5130 double_dollars (val
)
5133 register unsigned char *old
, *new;
5137 osize
= STRING_BYTES (XSTRING (val
));
5139 /* Count the number of $ characters. */
5140 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
5141 if (*old
++ == '$') count
++;
5144 old
= XSTRING (val
)->data
;
5145 val
= make_uninit_multibyte_string (XSTRING (val
)->size
+ count
,
5147 new = XSTRING (val
)->data
;
5148 for (n
= osize
; n
> 0; n
--)
5161 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
5163 "Internal subroutine for read-file-name. Do not call this.")
5164 (string
, dir
, action
)
5165 Lisp_Object string
, dir
, action
;
5166 /* action is nil for complete, t for return list of completions,
5167 lambda for verify final value */
5169 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
5171 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5173 CHECK_STRING (string
, 0);
5180 /* No need to protect ACTION--we only compare it with t and nil. */
5181 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
5183 if (XSTRING (string
)->size
== 0)
5185 if (EQ (action
, Qlambda
))
5193 orig_string
= string
;
5194 string
= Fsubstitute_in_file_name (string
);
5195 changed
= NILP (Fstring_equal (string
, orig_string
));
5196 name
= Ffile_name_nondirectory (string
);
5197 val
= Ffile_name_directory (string
);
5199 realdir
= Fexpand_file_name (val
, realdir
);
5204 specdir
= Ffile_name_directory (string
);
5205 val
= Ffile_name_completion (name
, realdir
);
5210 return double_dollars (string
);
5214 if (!NILP (specdir
))
5215 val
= concat2 (specdir
, val
);
5217 return double_dollars (val
);
5220 #endif /* not VMS */
5224 if (EQ (action
, Qt
))
5225 return Ffile_name_all_completions (name
, realdir
);
5226 /* Only other case actually used is ACTION = lambda */
5228 /* Supposedly this helps commands such as `cd' that read directory names,
5229 but can someone explain how it helps them? -- RMS */
5230 if (XSTRING (name
)->size
== 0)
5233 return Ffile_exists_p (string
);
5236 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
5237 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
5238 Value is not expanded---you must call `expand-file-name' yourself.\n\
5239 Default name to DEFAULT-FILENAME if user enters a null string.\n\
5240 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
5241 except that if INITIAL is specified, that combined with DIR is used.)\n\
5242 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
5243 Non-nil and non-t means also require confirmation after completion.\n\
5244 Fifth arg INITIAL specifies text to start with.\n\
5245 DIR defaults to current buffer's directory default.")
5246 (prompt
, dir
, default_filename
, mustmatch
, initial
)
5247 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
5249 Lisp_Object val
, insdef
, insdef1
, tem
;
5250 struct gcpro gcpro1
, gcpro2
;
5251 register char *homedir
;
5252 int replace_in_history
= 0;
5253 int add_to_history
= 0;
5257 dir
= current_buffer
->directory
;
5258 if (NILP (default_filename
))
5260 if (! NILP (initial
))
5261 default_filename
= Fexpand_file_name (initial
, dir
);
5263 default_filename
= current_buffer
->filename
;
5266 /* If dir starts with user's homedir, change that to ~. */
5267 homedir
= (char *) egetenv ("HOME");
5269 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
5270 CORRECT_DIR_SEPS (homedir
);
5274 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
5275 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
5277 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
5278 STRING_BYTES (XSTRING (dir
)) - strlen (homedir
) + 1);
5279 XSTRING (dir
)->data
[0] = '~';
5282 if (insert_default_directory
&& STRINGP (dir
))
5285 if (!NILP (initial
))
5287 Lisp_Object args
[2], pos
;
5291 insdef
= Fconcat (2, args
);
5292 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
5293 insdef1
= Fcons (double_dollars (insdef
), pos
);
5296 insdef1
= double_dollars (insdef
);
5298 else if (STRINGP (initial
))
5301 insdef1
= Fcons (double_dollars (insdef
), make_number (0));
5304 insdef
= Qnil
, insdef1
= Qnil
;
5307 count
= specpdl_ptr
- specpdl
;
5308 specbind (intern ("completion-ignore-case"), Qt
);
5311 GCPRO2 (insdef
, default_filename
);
5312 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
5313 dir
, mustmatch
, insdef1
,
5314 Qfile_name_history
, default_filename
, Qnil
);
5316 tem
= Fsymbol_value (Qfile_name_history
);
5317 if (CONSP (tem
) && EQ (XCONS (tem
)->car
, val
))
5318 replace_in_history
= 1;
5320 /* If Fcompleting_read returned the inserted default string itself
5321 (rather than a new string with the same contents),
5322 it has to mean that the user typed RET with the minibuffer empty.
5323 In that case, we really want to return ""
5324 so that commands such as set-visited-file-name can distinguish. */
5325 if (EQ (val
, default_filename
))
5327 /* In this case, Fcompleting_read has not added an element
5328 to the history. Maybe we should. */
5329 if (! replace_in_history
)
5332 val
= build_string ("");
5336 unbind_to (count
, Qnil
);
5341 error ("No file name specified");
5343 tem
= Fstring_equal (val
, insdef
);
5345 if (!NILP (tem
) && !NILP (default_filename
))
5346 val
= default_filename
;
5347 else if (XSTRING (val
)->size
== 0 && NILP (insdef
))
5349 if (!NILP (default_filename
))
5350 val
= default_filename
;
5352 error ("No default file name");
5354 val
= Fsubstitute_in_file_name (val
);
5356 if (replace_in_history
)
5357 /* Replace what Fcompleting_read added to the history
5358 with what we will actually return. */
5359 XCONS (Fsymbol_value (Qfile_name_history
))->car
= val
;
5360 else if (add_to_history
)
5362 /* Add the value to the history--but not if it matches
5363 the last value already there. */
5364 tem
= Fsymbol_value (Qfile_name_history
);
5365 if (! CONSP (tem
) || NILP (Fequal (XCONS (tem
)->car
, val
)))
5366 Fset (Qfile_name_history
,
5375 Qexpand_file_name
= intern ("expand-file-name");
5376 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
5377 Qdirectory_file_name
= intern ("directory-file-name");
5378 Qfile_name_directory
= intern ("file-name-directory");
5379 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
5380 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
5381 Qfile_name_as_directory
= intern ("file-name-as-directory");
5382 Qcopy_file
= intern ("copy-file");
5383 Qmake_directory_internal
= intern ("make-directory-internal");
5384 Qdelete_directory
= intern ("delete-directory");
5385 Qdelete_file
= intern ("delete-file");
5386 Qrename_file
= intern ("rename-file");
5387 Qadd_name_to_file
= intern ("add-name-to-file");
5388 Qmake_symbolic_link
= intern ("make-symbolic-link");
5389 Qfile_exists_p
= intern ("file-exists-p");
5390 Qfile_executable_p
= intern ("file-executable-p");
5391 Qfile_readable_p
= intern ("file-readable-p");
5392 Qfile_writable_p
= intern ("file-writable-p");
5393 Qfile_symlink_p
= intern ("file-symlink-p");
5394 Qaccess_file
= intern ("access-file");
5395 Qfile_directory_p
= intern ("file-directory-p");
5396 Qfile_regular_p
= intern ("file-regular-p");
5397 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
5398 Qfile_modes
= intern ("file-modes");
5399 Qset_file_modes
= intern ("set-file-modes");
5400 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
5401 Qinsert_file_contents
= intern ("insert-file-contents");
5402 Qwrite_region
= intern ("write-region");
5403 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
5404 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
5406 staticpro (&Qexpand_file_name
);
5407 staticpro (&Qsubstitute_in_file_name
);
5408 staticpro (&Qdirectory_file_name
);
5409 staticpro (&Qfile_name_directory
);
5410 staticpro (&Qfile_name_nondirectory
);
5411 staticpro (&Qunhandled_file_name_directory
);
5412 staticpro (&Qfile_name_as_directory
);
5413 staticpro (&Qcopy_file
);
5414 staticpro (&Qmake_directory_internal
);
5415 staticpro (&Qdelete_directory
);
5416 staticpro (&Qdelete_file
);
5417 staticpro (&Qrename_file
);
5418 staticpro (&Qadd_name_to_file
);
5419 staticpro (&Qmake_symbolic_link
);
5420 staticpro (&Qfile_exists_p
);
5421 staticpro (&Qfile_executable_p
);
5422 staticpro (&Qfile_readable_p
);
5423 staticpro (&Qfile_writable_p
);
5424 staticpro (&Qaccess_file
);
5425 staticpro (&Qfile_symlink_p
);
5426 staticpro (&Qfile_directory_p
);
5427 staticpro (&Qfile_regular_p
);
5428 staticpro (&Qfile_accessible_directory_p
);
5429 staticpro (&Qfile_modes
);
5430 staticpro (&Qset_file_modes
);
5431 staticpro (&Qfile_newer_than_file_p
);
5432 staticpro (&Qinsert_file_contents
);
5433 staticpro (&Qwrite_region
);
5434 staticpro (&Qverify_visited_file_modtime
);
5435 staticpro (&Qset_visited_file_modtime
);
5437 Qfile_name_history
= intern ("file-name-history");
5438 Fset (Qfile_name_history
, Qnil
);
5439 staticpro (&Qfile_name_history
);
5441 Qfile_error
= intern ("file-error");
5442 staticpro (&Qfile_error
);
5443 Qfile_already_exists
= intern ("file-already-exists");
5444 staticpro (&Qfile_already_exists
);
5445 Qfile_date_error
= intern ("file-date-error");
5446 staticpro (&Qfile_date_error
);
5449 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
5450 staticpro (&Qfind_buffer_file_type
);
5453 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
5454 "*Coding system for encoding file names.\n\
5455 If it is nil, default-file-name-coding-system (which see) is used.");
5456 Vfile_name_coding_system
= Qnil
;
5458 DEFVAR_LISP ("default-file-name-coding-system",
5459 &Vdefault_file_name_coding_system
,
5460 "Default coding system for encoding file names.\n\
5461 This variable is used only when file-name-coding-system is nil.\n\
5463 This variable is set/changed by the command set-language-environment.\n\
5464 User should not set this variable manually,\n\
5465 instead use file-name-coding-system to get a constant encoding\n\
5466 of file names regardless of the current language environment.");
5467 Vdefault_file_name_coding_system
= Qnil
;
5469 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
5470 "*Format in which to write auto-save files.\n\
5471 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
5472 If it is t, which is the default, auto-save files are written in the\n\
5473 same format as a regular save would use.");
5474 Vauto_save_file_format
= Qt
;
5476 Qformat_decode
= intern ("format-decode");
5477 staticpro (&Qformat_decode
);
5478 Qformat_annotate_function
= intern ("format-annotate-function");
5479 staticpro (&Qformat_annotate_function
);
5481 Qcar_less_than_car
= intern ("car-less-than-car");
5482 staticpro (&Qcar_less_than_car
);
5484 Fput (Qfile_error
, Qerror_conditions
,
5485 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
5486 Fput (Qfile_error
, Qerror_message
,
5487 build_string ("File error"));
5489 Fput (Qfile_already_exists
, Qerror_conditions
,
5490 Fcons (Qfile_already_exists
,
5491 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5492 Fput (Qfile_already_exists
, Qerror_message
,
5493 build_string ("File already exists"));
5495 Fput (Qfile_date_error
, Qerror_conditions
,
5496 Fcons (Qfile_date_error
,
5497 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5498 Fput (Qfile_date_error
, Qerror_message
,
5499 build_string ("Cannot set file date"));
5501 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
5502 "*Non-nil means when reading a filename start with default dir in minibuffer.");
5503 insert_default_directory
= 1;
5505 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
5506 "*Non-nil means write new files with record format `stmlf'.\n\
5507 nil means use format `var'. This variable is meaningful only on VMS.");
5508 vms_stmlf_recfm
= 0;
5510 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
5511 "Directory separator character for built-in functions that return file names.\n\
5512 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
5513 This variable affects the built-in functions only on Windows,\n\
5514 on other platforms, it is initialized so that Lisp code can find out\n\
5515 what the normal separator is.");
5516 XSETFASTINT (Vdirectory_sep_char
, '/');
5518 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5519 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
5520 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
5523 The first argument given to HANDLER is the name of the I/O primitive\n\
5524 to be handled; the remaining arguments are the arguments that were\n\
5525 passed to that primitive. For example, if you do\n\
5526 (file-exists-p FILENAME)\n\
5527 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
5528 (funcall HANDLER 'file-exists-p FILENAME)\n\
5529 The function `find-file-name-handler' checks this list for a handler\n\
5530 for its argument.");
5531 Vfile_name_handler_alist
= Qnil
;
5533 DEFVAR_LISP ("set-auto-coding-function",
5534 &Vset_auto_coding_function
,
5535 "If non-nil, a function to call to decide a coding system of file.\n\
5536 One argument is passed to this function: the string of concatination\n\
5537 or the heading 1K-byte and the tailing 3K-byte of a file to be read.\n\
5538 This function should return a coding system to decode the file contents\n\
5539 specified in the heading lines with the format:\n\
5540 -*- ... coding: CODING-SYSTEM; ... -*-\n\
5541 or local variable spec of the tailing lines with `coding:' tag.");
5542 Vset_auto_coding_function
= Qnil
;
5544 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5545 "A list of functions to be called at the end of `insert-file-contents'.\n\
5546 Each is passed one argument, the number of bytes inserted. It should return\n\
5547 the new byte count, and leave point the same. If `insert-file-contents' is\n\
5548 intercepted by a handler from `file-name-handler-alist', that handler is\n\
5549 responsible for calling the after-insert-file-functions if appropriate.");
5550 Vafter_insert_file_functions
= Qnil
;
5552 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5553 "A list of functions to be called at the start of `write-region'.\n\
5554 Each is passed two arguments, START and END as for `write-region'.\n\
5555 These are usually two numbers but not always; see the documentation\n\
5556 for `write-region'. The function should return a list of pairs\n\
5557 of the form (POSITION . STRING), consisting of strings to be effectively\n\
5558 inserted at the specified positions of the file being written (1 means to\n\
5559 insert before the first byte written). The POSITIONs must be sorted into\n\
5560 increasing order. If there are several functions in the list, the several\n\
5561 lists are merged destructively.");
5562 Vwrite_region_annotate_functions
= Qnil
;
5564 DEFVAR_LISP ("write-region-annotations-so-far",
5565 &Vwrite_region_annotations_so_far
,
5566 "When an annotation function is called, this holds the previous annotations.\n\
5567 These are the annotations made by other annotation functions\n\
5568 that were already called. See also `write-region-annotate-functions'.");
5569 Vwrite_region_annotations_so_far
= Qnil
;
5571 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5572 "A list of file name handlers that temporarily should not be used.\n\
5573 This applies only to the operation `inhibit-file-name-operation'.");
5574 Vinhibit_file_name_handlers
= Qnil
;
5576 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5577 "The operation for which `inhibit-file-name-handlers' is applicable.");
5578 Vinhibit_file_name_operation
= Qnil
;
5580 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5581 "File name in which we write a list of all auto save file names.\n\
5582 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
5583 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
5585 Vauto_save_list_file_name
= Qnil
;
5587 defsubr (&Sfind_file_name_handler
);
5588 defsubr (&Sfile_name_directory
);
5589 defsubr (&Sfile_name_nondirectory
);
5590 defsubr (&Sunhandled_file_name_directory
);
5591 defsubr (&Sfile_name_as_directory
);
5592 defsubr (&Sdirectory_file_name
);
5593 defsubr (&Smake_temp_name
);
5594 defsubr (&Sexpand_file_name
);
5595 defsubr (&Ssubstitute_in_file_name
);
5596 defsubr (&Scopy_file
);
5597 defsubr (&Smake_directory_internal
);
5598 defsubr (&Sdelete_directory
);
5599 defsubr (&Sdelete_file
);
5600 defsubr (&Srename_file
);
5601 defsubr (&Sadd_name_to_file
);
5603 defsubr (&Smake_symbolic_link
);
5604 #endif /* S_IFLNK */
5606 defsubr (&Sdefine_logical_name
);
5609 defsubr (&Ssysnetunam
);
5610 #endif /* HPUX_NET */
5611 defsubr (&Sfile_name_absolute_p
);
5612 defsubr (&Sfile_exists_p
);
5613 defsubr (&Sfile_executable_p
);
5614 defsubr (&Sfile_readable_p
);
5615 defsubr (&Sfile_writable_p
);
5616 defsubr (&Saccess_file
);
5617 defsubr (&Sfile_symlink_p
);
5618 defsubr (&Sfile_directory_p
);
5619 defsubr (&Sfile_accessible_directory_p
);
5620 defsubr (&Sfile_regular_p
);
5621 defsubr (&Sfile_modes
);
5622 defsubr (&Sset_file_modes
);
5623 defsubr (&Sset_default_file_modes
);
5624 defsubr (&Sdefault_file_modes
);
5625 defsubr (&Sfile_newer_than_file_p
);
5626 defsubr (&Sinsert_file_contents
);
5627 defsubr (&Swrite_region
);
5628 defsubr (&Scar_less_than_car
);
5629 defsubr (&Sverify_visited_file_modtime
);
5630 defsubr (&Sclear_visited_file_modtime
);
5631 defsubr (&Svisited_file_modtime
);
5632 defsubr (&Sset_visited_file_modtime
);
5633 defsubr (&Sdo_auto_save
);
5634 defsubr (&Sset_buffer_auto_saved
);
5635 defsubr (&Sclear_buffer_auto_save_failure
);
5636 defsubr (&Srecent_auto_save_p
);
5638 defsubr (&Sread_file_name_internal
);
5639 defsubr (&Sread_file_name
);
5642 defsubr (&Sunix_sync
);