1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996,
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
29 #include <sys/types.h>
36 #if !defined (S_ISLNK) && defined (S_IFLNK)
37 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
40 #if !defined (S_ISFIFO) && defined (S_IFIFO)
41 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
44 #if !defined (S_ISREG) && defined (S_IFREG)
45 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
70 #include "intervals.h"
72 #include "character.h"
75 #include "blockinput.h"
77 #include "dispextern.h"
84 #endif /* not WINDOWSNT */
88 #include <sys/param.h>
96 #define CORRECT_DIR_SEPS(s) \
97 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
98 else unixtodos_filename (s); \
100 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
101 redirector allows the six letters between 'Z' and 'a' as well. */
103 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
106 #define IS_DRIVE(x) isalpha (x)
108 /* Need to lower-case the drive letter, or else expanded
109 filenames will sometimes compare inequal, because
110 `expand-file-name' doesn't always down-case the drive letter. */
111 #define DRIVE_LETTER(x) (tolower (x))
127 #include "commands.h"
128 extern int use_dialog_box
;
129 extern int use_file_dialog
;
143 #ifndef FILE_SYSTEM_CASE
144 #define FILE_SYSTEM_CASE(filename) (filename)
147 /* Nonzero during writing of auto-save files */
150 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
151 a new file with the same mode as the original */
152 int auto_save_mode_bits
;
154 /* Set by auto_save_1 if an error occurred during the last auto-save. */
155 int auto_save_error_occurred
;
157 /* The symbol bound to coding-system-for-read when
158 insert-file-contents is called for recovering a file. This is not
159 an actual coding system name, but just an indicator to tell
160 insert-file-contents to use `emacs-mule' with a special flag for
161 auto saving and recovering a file. */
162 Lisp_Object Qauto_save_coding
;
164 /* Coding system for file names, or nil if none. */
165 Lisp_Object Vfile_name_coding_system
;
167 /* Coding system for file names used only when
168 Vfile_name_coding_system is nil. */
169 Lisp_Object Vdefault_file_name_coding_system
;
171 /* Alist of elements (REGEXP . HANDLER) for file names
172 whose I/O is done with a special handler. */
173 Lisp_Object Vfile_name_handler_alist
;
175 /* Property name of a file name handler,
176 which gives a list of operations it handles.. */
177 Lisp_Object Qoperations
;
179 /* Lisp functions for translating file formats */
180 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
182 /* Function to be called to decide a coding system of a reading file. */
183 Lisp_Object Vset_auto_coding_function
;
185 /* Functions to be called to process text properties in inserted file. */
186 Lisp_Object Vafter_insert_file_functions
;
188 /* Lisp function for setting buffer-file-coding-system and the
189 multibyteness of the current buffer after inserting a file. */
190 Lisp_Object Qafter_insert_file_set_coding
;
192 /* Functions to be called to create text property annotations for file. */
193 Lisp_Object Vwrite_region_annotate_functions
;
194 Lisp_Object Qwrite_region_annotate_functions
;
196 /* During build_annotations, each time an annotation function is called,
197 this holds the annotations made by the previous functions. */
198 Lisp_Object Vwrite_region_annotations_so_far
;
200 /* File name in which we write a list of all our auto save files. */
201 Lisp_Object Vauto_save_list_file_name
;
203 /* On VMS, nonzero means write new files with record format stmlf.
204 Zero means use var format. */
207 /* On NT, specifies the directory separator character, used (eg.) when
208 expanding file names. This can be bound to / or \. */
209 Lisp_Object Vdirectory_sep_char
;
212 /* Nonzero means skip the call to fsync in Fwrite-region. */
213 int write_region_inhibit_fsync
;
216 extern Lisp_Object Vuser_login_name
;
219 extern Lisp_Object Vw32_get_true_file_attributes
;
222 extern int minibuf_level
;
224 extern int minibuffer_auto_raise
;
226 extern int history_delete_duplicates
;
228 /* These variables describe handlers that have "already" had a chance
229 to handle the current operation.
231 Vinhibit_file_name_handlers is a list of file name handlers.
232 Vinhibit_file_name_operation is the operation being handled.
233 If we try to handle that operation, we ignore those handlers. */
235 static Lisp_Object Vinhibit_file_name_handlers
;
236 static Lisp_Object Vinhibit_file_name_operation
;
238 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
240 Lisp_Object Qfile_name_history
;
242 Lisp_Object Qcar_less_than_car
;
244 static int a_write
P_ ((int, Lisp_Object
, int, int,
245 Lisp_Object
*, struct coding_system
*));
246 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
250 report_file_error (string
, data
)
254 Lisp_Object errstring
;
258 synchronize_system_messages_locale ();
259 str
= strerror (errorno
);
260 errstring
= code_convert_string_norecord (make_unibyte_string (str
,
262 Vlocale_coding_system
, 0);
268 xsignal (Qfile_already_exists
, Fcons (errstring
, data
));
271 /* System error messages are capitalized. Downcase the initial
272 unless it is followed by a slash. */
273 if (SREF (errstring
, 1) != '/')
274 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
276 xsignal (Qfile_error
,
277 Fcons (build_string (string
), Fcons (errstring
, data
)));
282 close_file_unwind (fd
)
285 emacs_close (XFASTINT (fd
));
289 /* Restore point, having saved it as a marker. */
292 restore_point_unwind (location
)
293 Lisp_Object location
;
295 Fgoto_char (location
);
296 Fset_marker (location
, Qnil
, Qnil
);
301 Lisp_Object Qexpand_file_name
;
302 Lisp_Object Qsubstitute_in_file_name
;
303 Lisp_Object Qdirectory_file_name
;
304 Lisp_Object Qfile_name_directory
;
305 Lisp_Object Qfile_name_nondirectory
;
306 Lisp_Object Qunhandled_file_name_directory
;
307 Lisp_Object Qfile_name_as_directory
;
308 Lisp_Object Qcopy_file
;
309 Lisp_Object Qmake_directory_internal
;
310 Lisp_Object Qmake_directory
;
311 Lisp_Object Qdelete_directory
;
312 Lisp_Object Qdelete_file
;
313 Lisp_Object Qrename_file
;
314 Lisp_Object Qadd_name_to_file
;
315 Lisp_Object Qmake_symbolic_link
;
316 Lisp_Object Qfile_exists_p
;
317 Lisp_Object Qfile_executable_p
;
318 Lisp_Object Qfile_readable_p
;
319 Lisp_Object Qfile_writable_p
;
320 Lisp_Object Qfile_symlink_p
;
321 Lisp_Object Qaccess_file
;
322 Lisp_Object Qfile_directory_p
;
323 Lisp_Object Qfile_regular_p
;
324 Lisp_Object Qfile_accessible_directory_p
;
325 Lisp_Object Qfile_modes
;
326 Lisp_Object Qset_file_modes
;
327 Lisp_Object Qset_file_times
;
328 Lisp_Object Qfile_newer_than_file_p
;
329 Lisp_Object Qinsert_file_contents
;
330 Lisp_Object Qwrite_region
;
331 Lisp_Object Qverify_visited_file_modtime
;
332 Lisp_Object Qset_visited_file_modtime
;
334 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
335 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
336 Otherwise, return nil.
337 A file name is handled if one of the regular expressions in
338 `file-name-handler-alist' matches it.
340 If OPERATION equals `inhibit-file-name-operation', then we ignore
341 any handlers that are members of `inhibit-file-name-handlers',
342 but we still do run any other handlers. This lets handlers
343 use the standard functions without calling themselves recursively. */)
344 (filename
, operation
)
345 Lisp_Object filename
, operation
;
347 /* This function must not munge the match data. */
348 Lisp_Object chain
, inhibited_handlers
, result
;
352 CHECK_STRING (filename
);
354 if (EQ (operation
, Vinhibit_file_name_operation
))
355 inhibited_handlers
= Vinhibit_file_name_handlers
;
357 inhibited_handlers
= Qnil
;
359 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
360 chain
= XCDR (chain
))
366 Lisp_Object string
= XCAR (elt
);
368 Lisp_Object handler
= XCDR (elt
);
369 Lisp_Object operations
= Qnil
;
371 if (SYMBOLP (handler
))
372 operations
= Fget (handler
, Qoperations
);
375 && (match_pos
= fast_string_match (string
, filename
)) > pos
376 && (NILP (operations
) || ! NILP (Fmemq (operation
, operations
))))
380 handler
= XCDR (elt
);
381 tem
= Fmemq (handler
, inhibited_handlers
);
395 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
397 doc
: /* Return the directory component in file name FILENAME.
398 Return nil if FILENAME does not include a directory.
399 Otherwise return a directory name.
400 Given a Unix syntax file name, returns a string ending in slash;
401 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
403 Lisp_Object filename
;
406 register const unsigned char *beg
;
408 register unsigned char *beg
;
410 register const unsigned char *p
;
413 CHECK_STRING (filename
);
415 /* If the file name has special constructs in it,
416 call the corresponding file handler. */
417 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
419 return call2 (handler
, Qfile_name_directory
, filename
);
421 filename
= FILE_SYSTEM_CASE (filename
);
422 beg
= SDATA (filename
);
424 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
426 p
= beg
+ SBYTES (filename
);
428 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
430 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
433 /* only recognise drive specifier at the beginning */
435 /* handle the "/:d:foo" and "/:foo" cases correctly */
436 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
437 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
444 /* Expansion of "c:" to drive and default directory. */
447 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
448 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
449 unsigned char *r
= res
;
451 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
453 strncpy (res
, beg
, 2);
458 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
460 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
463 p
= beg
+ strlen (beg
);
466 CORRECT_DIR_SEPS (beg
);
469 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
472 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
473 Sfile_name_nondirectory
, 1, 1, 0,
474 doc
: /* Return file name FILENAME sans its directory.
475 For example, in a Unix-syntax file name,
476 this is everything after the last slash,
477 or the entire name if it contains no slash. */)
479 Lisp_Object filename
;
481 register const unsigned char *beg
, *p
, *end
;
484 CHECK_STRING (filename
);
486 /* If the file name has special constructs in it,
487 call the corresponding file handler. */
488 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
490 return call2 (handler
, Qfile_name_nondirectory
, filename
);
492 beg
= SDATA (filename
);
493 end
= p
= beg
+ SBYTES (filename
);
495 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
497 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
500 /* only recognise drive specifier at beginning */
502 /* handle the "/:d:foo" case correctly */
503 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
508 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
511 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
512 Sunhandled_file_name_directory
, 1, 1, 0,
513 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
514 A `directly usable' directory name is one that may be used without the
515 intervention of any file handler.
516 If FILENAME is a directly usable file itself, return
517 \(file-name-directory FILENAME).
518 If FILENAME refers to a file which is not accessible from a local process,
519 then this should return nil.
520 The `call-process' and `start-process' functions use this function to
521 get a current directory to run processes in. */)
523 Lisp_Object filename
;
527 /* If the file name has special constructs in it,
528 call the corresponding file handler. */
529 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
531 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
533 return Ffile_name_directory (filename
);
538 file_name_as_directory (out
, in
)
541 int size
= strlen (in
) - 1;
554 /* Is it already a directory string? */
555 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
557 /* Is it a VMS directory file name? If so, hack VMS syntax. */
558 else if (! index (in
, '/')
559 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
560 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
561 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
562 || ! strncmp (&in
[size
- 5], ".dir", 4))
563 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
564 && in
[size
] == '1')))
566 register char *p
, *dot
;
570 dir:x.dir --> dir:[x]
571 dir:[x]y.dir --> dir:[x.y] */
573 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
576 strncpy (out
, in
, p
- in
);
595 dot
= index (p
, '.');
598 /* blindly remove any extension */
599 size
= strlen (out
) + (dot
- p
);
600 strncat (out
, p
, dot
- p
);
611 /* For Unix syntax, Append a slash if necessary */
612 if (!IS_DIRECTORY_SEP (out
[size
]))
614 /* Cannot use DIRECTORY_SEP, which could have any value */
616 out
[size
+ 2] = '\0';
619 CORRECT_DIR_SEPS (out
);
625 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
626 Sfile_name_as_directory
, 1, 1, 0,
627 doc
: /* Return a string representing the file name FILE interpreted as a directory.
628 This operation exists because a directory is also a file, but its name as
629 a directory is different from its name as a file.
630 The result can be used as the value of `default-directory'
631 or passed as second argument to `expand-file-name'.
632 For a Unix-syntax file name, just appends a slash.
633 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
644 /* If the file name has special constructs in it,
645 call the corresponding file handler. */
646 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
648 return call2 (handler
, Qfile_name_as_directory
, file
);
650 buf
= (char *) alloca (SBYTES (file
) + 10);
651 file_name_as_directory (buf
, SDATA (file
));
652 return make_specified_string (buf
, -1, strlen (buf
),
653 STRING_MULTIBYTE (file
));
657 * Convert from directory name to filename.
659 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
660 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
661 * On UNIX, it's simple: just make sure there isn't a terminating /
663 * Value is nonzero if the string output is different from the input.
667 directory_file_name (src
, dst
)
675 struct FAB fab
= cc$rms_fab
;
676 struct NAM nam
= cc$rms_nam
;
677 char esa
[NAM$C_MAXRSS
];
682 if (! index (src
, '/')
683 && (src
[slen
- 1] == ']'
684 || src
[slen
- 1] == ':'
685 || src
[slen
- 1] == '>'))
687 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
689 fab
.fab$b_fns
= slen
;
690 fab
.fab$l_nam
= &nam
;
691 fab
.fab$l_fop
= FAB$M_NAM
;
694 nam
.nam$b_ess
= sizeof esa
;
695 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
697 /* We call SYS$PARSE to handle such things as [--] for us. */
698 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
700 slen
= nam
.nam$b_esl
;
701 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
706 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
708 /* what about when we have logical_name:???? */
709 if (src
[slen
- 1] == ':')
710 { /* Xlate logical name and see what we get */
711 ptr
= strcpy (dst
, src
); /* upper case for getenv */
714 if ('a' <= *ptr
&& *ptr
<= 'z')
718 dst
[slen
- 1] = 0; /* remove colon */
719 if (!(src
= egetenv (dst
)))
721 /* should we jump to the beginning of this procedure?
722 Good points: allows us to use logical names that xlate
724 Bad points: can be a problem if we just translated to a device
726 For now, I'll punt and always expect VMS names, and hope for
729 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
730 { /* no recursion here! */
736 { /* not a directory spec */
741 bracket
= src
[slen
- 1];
743 /* If bracket is ']' or '>', bracket - 2 is the corresponding
745 ptr
= index (src
, bracket
- 2);
747 { /* no opening bracket */
751 if (!(rptr
= rindex (src
, '.')))
754 strncpy (dst
, src
, slen
);
758 dst
[slen
++] = bracket
;
763 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
764 then translate the device and recurse. */
765 if (dst
[slen
- 1] == ':'
766 && dst
[slen
- 2] != ':' /* skip decnet nodes */
767 && strcmp (src
+ slen
, "[000000]") == 0)
769 dst
[slen
- 1] = '\0';
770 if ((ptr
= egetenv (dst
))
771 && (rlen
= strlen (ptr
) - 1) > 0
772 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
773 && ptr
[rlen
- 1] == '.')
775 char * buf
= (char *) alloca (strlen (ptr
) + 1);
779 return directory_file_name (buf
, dst
);
784 strcat (dst
, "[000000]");
788 rlen
= strlen (rptr
) - 1;
789 strncat (dst
, rptr
, rlen
);
790 dst
[slen
+ rlen
] = '\0';
791 strcat (dst
, ".DIR.1");
795 /* Process as Unix format: just remove any final slash.
796 But leave "/" unchanged; do not change it to "". */
799 && IS_DIRECTORY_SEP (dst
[slen
- 1])
801 && !IS_ANY_SEP (dst
[slen
- 2])
806 CORRECT_DIR_SEPS (dst
);
811 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
813 doc
: /* Returns the file name of the directory named DIRECTORY.
814 This is the name of the file that holds the data for the directory DIRECTORY.
815 This operation exists because a directory is also a file, but its name as
816 a directory is different from its name as a file.
817 In Unix-syntax, this function just removes the final slash.
818 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
819 it returns a file name such as \"[X]Y.DIR.1\". */)
821 Lisp_Object directory
;
826 CHECK_STRING (directory
);
828 if (NILP (directory
))
831 /* If the file name has special constructs in it,
832 call the corresponding file handler. */
833 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
835 return call2 (handler
, Qdirectory_file_name
, directory
);
838 /* 20 extra chars is insufficient for VMS, since we might perform a
839 logical name translation. an equivalence string can be up to 255
840 chars long, so grab that much extra space... - sss */
841 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
843 buf
= (char *) alloca (SBYTES (directory
) + 20);
845 directory_file_name (SDATA (directory
), buf
);
846 return make_specified_string (buf
, -1, strlen (buf
),
847 STRING_MULTIBYTE (directory
));
850 static char make_temp_name_tbl
[64] =
852 'A','B','C','D','E','F','G','H',
853 'I','J','K','L','M','N','O','P',
854 'Q','R','S','T','U','V','W','X',
855 'Y','Z','a','b','c','d','e','f',
856 'g','h','i','j','k','l','m','n',
857 'o','p','q','r','s','t','u','v',
858 'w','x','y','z','0','1','2','3',
859 '4','5','6','7','8','9','-','_'
862 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
864 /* Value is a temporary file name starting with PREFIX, a string.
866 The Emacs process number forms part of the result, so there is
867 no danger of generating a name being used by another process.
868 In addition, this function makes an attempt to choose a name
869 which has no existing file. To make this work, PREFIX should be
870 an absolute file name.
872 BASE64_P non-zero means add the pid as 3 characters in base64
873 encoding. In this case, 6 characters will be added to PREFIX to
874 form the file name. Otherwise, if Emacs is running on a system
875 with long file names, add the pid as a decimal number.
877 This function signals an error if no unique file name could be
881 make_temp_name (prefix
, base64_p
)
888 unsigned char *p
, *data
;
892 CHECK_STRING (prefix
);
894 /* VAL is created by adding 6 characters to PREFIX. The first
895 three are the PID of this process, in base 64, and the second
896 three are incremented if the file already exists. This ensures
897 262144 unique file names per PID per PREFIX. */
899 pid
= (int) getpid ();
903 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
904 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
905 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
910 #ifdef HAVE_LONG_FILE_NAMES
911 sprintf (pidbuf
, "%d", pid
);
912 pidlen
= strlen (pidbuf
);
914 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
915 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
916 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
921 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
922 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
923 if (!STRING_MULTIBYTE (prefix
))
924 STRING_SET_UNIBYTE (val
);
926 bcopy(SDATA (prefix
), data
, len
);
929 bcopy (pidbuf
, p
, pidlen
);
932 /* Here we try to minimize useless stat'ing when this function is
933 invoked many times successively with the same PREFIX. We achieve
934 this by initializing count to a random value, and incrementing it
937 We don't want make-temp-name to be called while dumping,
938 because then make_temp_name_count_initialized_p would get set
939 and then make_temp_name_count would not be set when Emacs starts. */
941 if (!make_temp_name_count_initialized_p
)
943 make_temp_name_count
= (unsigned) time (NULL
);
944 make_temp_name_count_initialized_p
= 1;
950 unsigned num
= make_temp_name_count
;
952 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
953 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
954 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
956 /* Poor man's congruential RN generator. Replace with
957 ++make_temp_name_count for debugging. */
958 make_temp_name_count
+= 25229;
959 make_temp_name_count
%= 225307;
961 if (stat (data
, &ignored
) < 0)
963 /* We want to return only if errno is ENOENT. */
967 /* The error here is dubious, but there is little else we
968 can do. The alternatives are to return nil, which is
969 as bad as (and in many cases worse than) throwing the
970 error, or to ignore the error, which will likely result
971 in looping through 225307 stat's, which is not only
972 dog-slow, but also useless since it will fallback to
973 the errow below, anyway. */
974 report_file_error ("Cannot create temporary name for prefix",
975 Fcons (prefix
, Qnil
));
980 error ("Cannot create temporary name for prefix `%s'",
986 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
987 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
988 The Emacs process number forms part of the result,
989 so there is no danger of generating a name being used by another process.
991 In addition, this function makes an attempt to choose a name
992 which has no existing file. To make this work,
993 PREFIX should be an absolute file name.
995 There is a race condition between calling `make-temp-name' and creating the
996 file which opens all kinds of security holes. For that reason, you should
997 probably use `make-temp-file' instead, except in three circumstances:
999 * If you are creating the file in the user's home directory.
1000 * If you are creating a directory rather than an ordinary file.
1001 * If you are taking special precautions as `make-temp-file' does. */)
1005 return make_temp_name (prefix
, 0);
1010 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1011 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1012 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1013 \(does not start with slash or tilde); if DEFAULT-DIRECTORY is nil or missing,
1014 the current buffer's value of `default-directory' is used.
1015 File name components that are `.' are removed, and
1016 so are file name components followed by `..', along with the `..' itself;
1017 note that these simplifications are done without checking the resulting
1018 file names in the file system.
1019 An initial `~/' expands to your home directory.
1020 An initial `~USER/' expands to USER's home directory.
1021 See also the function `substitute-in-file-name'. */)
1022 (name
, default_directory
)
1023 Lisp_Object name
, default_directory
;
1025 /* These point to SDATA and need to be careful with string-relocation
1026 during GC (via DECODE_FILE). */
1027 unsigned char *nm
, *newdir
;
1029 /* This should only point to alloca'd data. */
1030 unsigned char *target
;
1035 unsigned char * colon
= 0;
1036 unsigned char * close
= 0;
1037 unsigned char * slash
= 0;
1038 unsigned char * brack
= 0;
1039 int lbrack
= 0, rbrack
= 0;
1044 int collapse_newdir
= 1;
1048 Lisp_Object handler
, result
;
1052 CHECK_STRING (name
);
1054 /* If the file name has special constructs in it,
1055 call the corresponding file handler. */
1056 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1057 if (!NILP (handler
))
1058 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1060 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1061 if (NILP (default_directory
))
1062 default_directory
= current_buffer
->directory
;
1063 if (! STRINGP (default_directory
))
1066 /* "/" is not considered a root directory on DOS_NT, so using "/"
1067 here causes an infinite recursion in, e.g., the following:
1069 (let (default-directory)
1070 (expand-file-name "a"))
1072 To avoid this, we set default_directory to the root of the
1074 extern char *emacs_root_dir (void);
1076 default_directory
= build_string (emacs_root_dir ());
1078 default_directory
= build_string ("/");
1082 if (!NILP (default_directory
))
1084 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1085 if (!NILP (handler
))
1086 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1090 unsigned char *o
= SDATA (default_directory
);
1092 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1093 It would be better to do this down below where we actually use
1094 default_directory. Unfortunately, calling Fexpand_file_name recursively
1095 could invoke GC, and the strings might be relocated. This would
1096 be annoying because we have pointers into strings lying around
1097 that would need adjusting, and people would add new pointers to
1098 the code and forget to adjust them, resulting in intermittent bugs.
1099 Putting this call here avoids all that crud.
1101 The EQ test avoids infinite recursion. */
1102 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1103 /* Save time in some common cases - as long as default_directory
1104 is not relative, it can be canonicalized with name below (if it
1105 is needed at all) without requiring it to be expanded now. */
1107 /* Detect MSDOS file names with drive specifiers. */
1108 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1])
1109 && IS_DIRECTORY_SEP (o
[2]))
1111 /* Detect Windows file names in UNC format. */
1112 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1114 #else /* not DOS_NT */
1115 /* Detect Unix absolute file names (/... alone is not absolute on
1117 && ! (IS_DIRECTORY_SEP (o
[0]))
1118 #endif /* not DOS_NT */
1121 struct gcpro gcpro1
;
1124 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1128 name
= FILE_SYSTEM_CASE (name
);
1129 multibyte
= STRING_MULTIBYTE (name
);
1130 if (multibyte
!= STRING_MULTIBYTE (default_directory
))
1133 default_directory
= string_to_multibyte (default_directory
);
1136 name
= string_to_multibyte (name
);
1145 /* We will force directory separators to be either all \ or /, so make
1146 a local copy to modify, even if there ends up being no change. */
1147 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1150 /* Note if special escape prefix is present, but remove for now. */
1151 if (nm
[0] == '/' && nm
[1] == ':')
1157 /* Find and remove drive specifier if present; this makes nm absolute
1158 even if the rest of the name appears to be relative. Only look for
1159 drive specifier at the beginning. */
1160 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1167 /* If we see "c://somedir", we want to strip the first slash after the
1168 colon when stripping the drive letter. Otherwise, this expands to
1170 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1173 /* Discard any previous drive specifier if nm is now in UNC format. */
1174 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1178 #endif /* WINDOWSNT */
1181 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1182 none are found, we can probably return right away. We will avoid
1183 allocating a new string if name is already fully expanded. */
1185 IS_DIRECTORY_SEP (nm
[0])
1187 && drive
&& !is_escaped
1190 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1197 /* If it turns out that the filename we want to return is just a
1198 suffix of FILENAME, we don't need to go through and edit
1199 things; we just need to construct a new string using data
1200 starting at the middle of FILENAME. If we set lose to a
1201 non-zero value, that means we've discovered that we can't do
1204 unsigned char *p
= nm
;
1208 /* Since we know the name is absolute, we can assume that each
1209 element starts with a "/". */
1211 /* "." and ".." are hairy. */
1212 if (IS_DIRECTORY_SEP (p
[0])
1214 && (IS_DIRECTORY_SEP (p
[2])
1216 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1219 /* We want to replace multiple `/' in a row with a single
1222 && IS_DIRECTORY_SEP (p
[0])
1223 && IS_DIRECTORY_SEP (p
[1]))
1230 /* if dev:[dir]/, move nm to / */
1231 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1232 nm
= (brack
? brack
+ 1 : colon
+ 1);
1233 lbrack
= rbrack
= 0;
1240 #ifdef NO_HYPHENS_IN_FILENAMES
1241 if (lbrack
== rbrack
)
1243 /* Avoid clobbering negative version numbers. */
1248 #endif /* NO_HYPHENS_IN_FILENAMES */
1250 && ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<')
1251 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1253 #ifdef NO_HYPHENS_IN_FILENAMES
1256 #endif /* NO_HYPHENS_IN_FILENAMES */
1257 /* count open brackets, reset close bracket pointer */
1258 if (p
[0] == '[' || p
[0] == '<')
1259 lbrack
++, brack
= 0;
1260 /* count close brackets, set close bracket pointer */
1261 if (p
[0] == ']' || p
[0] == '>')
1262 rbrack
++, brack
= p
;
1263 /* detect ][ or >< */
1264 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1266 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1267 nm
= p
+ 1, lose
= 1;
1268 if (p
[0] == ':' && (colon
|| slash
))
1269 /* if dev1:[dir]dev2:, move nm to dev2: */
1275 /* if /name/dev:, move nm to dev: */
1278 /* if node::dev:, move colon following dev */
1279 else if (colon
&& colon
[-1] == ':')
1281 /* if dev1:dev2:, move nm to dev2: */
1282 else if (colon
&& colon
[-1] != ':')
1287 if (p
[0] == ':' && !colon
)
1293 if (lbrack
== rbrack
)
1296 else if (p
[0] == '.')
1304 if (index (nm
, '/'))
1306 nm
= sys_translate_unix (nm
);
1308 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1312 /* Make sure directories are all separated with / or \ as
1313 desired, but avoid allocation of a new string when not
1315 CORRECT_DIR_SEPS (nm
);
1317 if (IS_DIRECTORY_SEP (nm
[1]))
1319 if (strcmp (nm
, SDATA (name
)) != 0)
1320 name
= make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1324 /* drive must be set, so this is okay */
1325 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1329 name
= make_specified_string (nm
, -1, p
- nm
, multibyte
);
1330 temp
[0] = DRIVE_LETTER (drive
);
1331 name
= concat2 (build_string (temp
), name
);
1334 #else /* not DOS_NT */
1335 if (nm
== SDATA (name
))
1337 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1338 #endif /* not DOS_NT */
1342 /* At this point, nm might or might not be an absolute file name. We
1343 need to expand ~ or ~user if present, otherwise prefix nm with
1344 default_directory if nm is not absolute, and finally collapse /./
1345 and /foo/../ sequences.
1347 We set newdir to be the appropriate prefix if one is needed:
1348 - the relevant user directory if nm starts with ~ or ~user
1349 - the specified drive's working dir (DOS/NT only) if nm does not
1351 - the value of default_directory.
1353 Note that these prefixes are not guaranteed to be absolute (except
1354 for the working dir of a drive). Therefore, to ensure we always
1355 return an absolute name, if the final prefix is not absolute we
1356 append it to the current working directory. */
1360 if (nm
[0] == '~') /* prefix ~ */
1362 if (IS_DIRECTORY_SEP (nm
[1])
1366 || nm
[1] == 0) /* ~ by itself */
1370 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1371 newdir
= (unsigned char *) "";
1373 /* egetenv may return a unibyte string, which will bite us since
1374 we expect the directory to be multibyte. */
1375 tem
= build_string (newdir
);
1376 if (!STRING_MULTIBYTE (tem
))
1378 /* FIXME: DECODE_FILE may GC, which may move SDATA(name),
1379 after which `nm' won't point to the right place any more. */
1380 int offset
= nm
- SDATA (name
);
1381 hdir
= DECODE_FILE (tem
);
1382 newdir
= SDATA (hdir
);
1384 nm
= SDATA (name
) + offset
;
1387 collapse_newdir
= 0;
1390 nm
++; /* Don't leave the slash in nm. */
1393 else /* ~user/filename */
1395 unsigned char *o
, *p
;
1396 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1401 o
= alloca (p
- nm
+ 1);
1402 bcopy ((char *) nm
, o
, p
- nm
);
1406 pw
= (struct passwd
*) getpwnam (o
+ 1);
1410 newdir
= (unsigned char *) pw
-> pw_dir
;
1412 nm
= p
+ 1; /* skip the terminator */
1416 collapse_newdir
= 0;
1421 /* If we don't find a user of that name, leave the name
1422 unchanged; don't move nm forward to p. */
1427 /* On DOS and Windows, nm is absolute if a drive name was specified;
1428 use the drive's current directory as the prefix if needed. */
1429 if (!newdir
&& drive
)
1431 /* Get default directory if needed to make nm absolute. */
1432 if (!IS_DIRECTORY_SEP (nm
[0]))
1434 newdir
= alloca (MAXPATHLEN
+ 1);
1435 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1440 /* Either nm starts with /, or drive isn't mounted. */
1441 newdir
= alloca (4);
1442 newdir
[0] = DRIVE_LETTER (drive
);
1450 /* Finally, if no prefix has been specified and nm is not absolute,
1451 then it must be expanded relative to default_directory. */
1455 /* /... alone is not absolute on DOS and Windows. */
1456 && !IS_DIRECTORY_SEP (nm
[0])
1459 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1466 newdir
= SDATA (default_directory
);
1468 /* Note if special escape prefix is present, but remove for now. */
1469 if (newdir
[0] == '/' && newdir
[1] == ':')
1480 /* First ensure newdir is an absolute name. */
1482 /* Detect MSDOS file names with drive specifiers. */
1483 ! (IS_DRIVE (newdir
[0])
1484 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1486 /* Detect Windows file names in UNC format. */
1487 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1491 /* Effectively, let newdir be (expand-file-name newdir cwd).
1492 Because of the admonition against calling expand-file-name
1493 when we have pointers into lisp strings, we accomplish this
1494 indirectly by prepending newdir to nm if necessary, and using
1495 cwd (or the wd of newdir's drive) as the new newdir. */
1497 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1502 if (!IS_DIRECTORY_SEP (nm
[0]))
1504 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1505 file_name_as_directory (tmp
, newdir
);
1509 newdir
= alloca (MAXPATHLEN
+ 1);
1512 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1519 /* Strip off drive name from prefix, if present. */
1520 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1526 /* Keep only a prefix from newdir if nm starts with slash
1527 (//server/share for UNC, nothing otherwise). */
1528 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1531 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1534 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1536 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1538 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1550 /* Get rid of any slash at the end of newdir, unless newdir is
1551 just / or // (an incomplete UNC name). */
1552 length
= strlen (newdir
);
1553 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1555 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1559 unsigned char *temp
= (unsigned char *) alloca (length
);
1560 bcopy (newdir
, temp
, length
- 1);
1561 temp
[length
- 1] = 0;
1569 /* Now concatenate the directory and name to new space in the stack frame */
1570 tlen
+= strlen (nm
) + 1;
1572 /* Reserve space for drive specifier and escape prefix, since either
1573 or both may need to be inserted. (The Microsoft x86 compiler
1574 produces incorrect code if the following two lines are combined.) */
1575 target
= (unsigned char *) alloca (tlen
+ 4);
1577 #else /* not DOS_NT */
1578 target
= (unsigned char *) alloca (tlen
);
1579 #endif /* not DOS_NT */
1585 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1588 /* If newdir is effectively "C:/", then the drive letter will have
1589 been stripped and newdir will be "/". Concatenating with an
1590 absolute directory in nm produces "//", which will then be
1591 incorrectly treated as a network share. Ignore newdir in
1592 this case (keeping the drive letter). */
1593 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1594 && newdir
[1] == '\0'))
1596 strcpy (target
, newdir
);
1600 file_name_as_directory (target
, newdir
);
1603 strcat (target
, nm
);
1605 if (index (target
, '/'))
1606 strcpy (target
, sys_translate_unix (target
));
1609 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1611 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1615 unsigned char *p
= target
;
1616 unsigned char *o
= target
;
1621 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1627 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1628 /* brackets are offset from each other by 2 */
1631 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1632 /* convert [foo][bar] to [bar] */
1633 while (o
[-1] != '[' && o
[-1] != '<')
1635 else if (*p
== '-' && *o
!= '.')
1638 else if (p
[0] == '-' && o
[-1] == '.'
1639 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1640 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1644 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1645 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1647 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1649 /* else [foo.-] ==> [-] */
1653 #ifdef NO_HYPHENS_IN_FILENAMES
1655 && o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.'
1656 && p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1658 #endif /* NO_HYPHENS_IN_FILENAMES */
1662 if (!IS_DIRECTORY_SEP (*p
))
1666 else if (p
[1] == '.'
1667 && (IS_DIRECTORY_SEP (p
[2])
1670 /* If "/." is the entire filename, keep the "/". Otherwise,
1671 just delete the whole "/.". */
1672 if (o
== target
&& p
[2] == '\0')
1676 else if (p
[1] == '.' && p
[2] == '.'
1677 /* `/../' is the "superroot" on certain file systems.
1678 Turned off on DOS_NT systems because they have no
1679 "superroot" and because this causes us to produce
1680 file names like "d:/../foo" which fail file-related
1681 functions of the underlying OS. (To reproduce, try a
1682 long series of "../../" in default_directory, longer
1683 than the number of levels from the root.) */
1687 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1689 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1691 /* Keep initial / only if this is the whole name. */
1692 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1696 else if (p
> target
&& IS_DIRECTORY_SEP (p
[1]))
1697 /* Collapse multiple `/' in a row. */
1703 #endif /* not VMS */
1707 /* At last, set drive name. */
1709 /* Except for network file name. */
1710 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1711 #endif /* WINDOWSNT */
1713 if (!drive
) abort ();
1715 target
[0] = DRIVE_LETTER (drive
);
1718 /* Reinsert the escape prefix if required. */
1725 CORRECT_DIR_SEPS (target
);
1728 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1731 /* Again look to see if the file name has special constructs in it
1732 and perhaps call the corresponding file handler. This is needed
1733 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1734 the ".." component gives us "/user@host:/bar/../baz" which needs
1735 to be expanded again. */
1736 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1737 if (!NILP (handler
))
1738 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1744 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1745 This is the old version of expand-file-name, before it was thoroughly
1746 rewritten for Emacs 10.31. We leave this version here commented-out,
1747 because the code is very complex and likely to have subtle bugs. If
1748 bugs _are_ found, it might be of interest to look at the old code and
1749 see what did it do in the relevant situation.
1751 Don't remove this code: it's true that it will be accessible via CVS,
1752 but a few years from deletion, people will forget it is there. */
1754 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1755 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1756 "Convert FILENAME to absolute, and canonicalize it.\n\
1757 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1758 \(does not start with slash); if DEFAULT is nil or missing,\n\
1759 the current buffer's value of default-directory is used.\n\
1760 Filenames containing `.' or `..' as components are simplified;\n\
1761 initial `~/' expands to your home directory.\n\
1762 See also the function `substitute-in-file-name'.")
1764 Lisp_Object name
, defalt
;
1768 register unsigned char *newdir
, *p
, *o
;
1770 unsigned char *target
;
1774 unsigned char * colon
= 0;
1775 unsigned char * close
= 0;
1776 unsigned char * slash
= 0;
1777 unsigned char * brack
= 0;
1778 int lbrack
= 0, rbrack
= 0;
1782 CHECK_STRING (name
);
1785 /* Filenames on VMS are always upper case. */
1786 name
= Fupcase (name
);
1791 /* If nm is absolute, flush ...// and detect /./ and /../.
1792 If no /./ or /../ we can return right away. */
1804 if (p
[0] == '/' && p
[1] == '/'
1807 if (p
[0] == '/' && p
[1] == '~')
1808 nm
= p
+ 1, lose
= 1;
1809 if (p
[0] == '/' && p
[1] == '.'
1810 && (p
[2] == '/' || p
[2] == 0
1811 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1817 /* if dev:[dir]/, move nm to / */
1818 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1819 nm
= (brack
? brack
+ 1 : colon
+ 1);
1820 lbrack
= rbrack
= 0;
1828 /* VMS pre V4.4,convert '-'s in filenames. */
1829 if (lbrack
== rbrack
)
1831 if (dots
< 2) /* this is to allow negative version numbers */
1837 && ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<')
1838 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1844 /* count open brackets, reset close bracket pointer */
1845 if (p
[0] == '[' || p
[0] == '<')
1846 lbrack
++, brack
= 0;
1847 /* count close brackets, set close bracket pointer */
1848 if (p
[0] == ']' || p
[0] == '>')
1849 rbrack
++, brack
= p
;
1850 /* detect ][ or >< */
1851 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1853 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1854 nm
= p
+ 1, lose
= 1;
1855 if (p
[0] == ':' && (colon
|| slash
))
1856 /* if dev1:[dir]dev2:, move nm to dev2: */
1862 /* If /name/dev:, move nm to dev: */
1865 /* If node::dev:, move colon following dev */
1866 else if (colon
&& colon
[-1] == ':')
1868 /* If dev1:dev2:, move nm to dev2: */
1869 else if (colon
&& colon
[-1] != ':')
1874 if (p
[0] == ':' && !colon
)
1880 if (lbrack
== rbrack
)
1883 else if (p
[0] == '.')
1891 if (index (nm
, '/'))
1892 return build_string (sys_translate_unix (nm
));
1894 if (nm
== SDATA (name
))
1896 return build_string (nm
);
1900 /* Now determine directory to start with and put it in NEWDIR */
1904 if (nm
[0] == '~') /* prefix ~ */
1909 || nm
[1] == 0)/* ~/filename */
1911 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1912 newdir
= (unsigned char *) "";
1915 nm
++; /* Don't leave the slash in nm. */
1918 else /* ~user/filename */
1920 /* Get past ~ to user */
1921 unsigned char *user
= nm
+ 1;
1922 /* Find end of name. */
1923 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1924 int len
= ptr
? ptr
- user
: strlen (user
);
1926 unsigned char *ptr1
= index (user
, ':');
1927 if (ptr1
!= 0 && ptr1
- user
< len
)
1930 /* Copy the user name into temp storage. */
1931 o
= (unsigned char *) alloca (len
+ 1);
1932 bcopy ((char *) user
, o
, len
);
1935 /* Look up the user name. */
1937 pw
= (struct passwd
*) getpwnam (o
+ 1);
1940 error ("\"%s\" isn't a registered user", o
+ 1);
1942 newdir
= (unsigned char *) pw
->pw_dir
;
1944 /* Discard the user name from NM. */
1951 #endif /* not VMS */
1955 defalt
= current_buffer
->directory
;
1956 CHECK_STRING (defalt
);
1957 newdir
= SDATA (defalt
);
1960 /* Now concatenate the directory and name to new space in the stack frame */
1962 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1963 target
= (unsigned char *) alloca (tlen
);
1969 if (nm
[0] == 0 || nm
[0] == '/')
1970 strcpy (target
, newdir
);
1973 file_name_as_directory (target
, newdir
);
1976 strcat (target
, nm
);
1978 if (index (target
, '/'))
1979 strcpy (target
, sys_translate_unix (target
));
1982 /* Now canonicalize by removing /. and /foo/.. if they appear */
1990 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1996 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1997 /* brackets are offset from each other by 2 */
2000 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
2001 /* convert [foo][bar] to [bar] */
2002 while (o
[-1] != '[' && o
[-1] != '<')
2004 else if (*p
== '-' && *o
!= '.')
2007 else if (p
[0] == '-' && o
[-1] == '.'
2008 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
2009 /* flush .foo.- ; leave - if stopped by '[' or '<' */
2013 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
2014 if (p
[1] == '.') /* foo.-.bar ==> bar. */
2016 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
2018 /* else [foo.-] ==> [-] */
2024 && o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.'
2025 && p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2035 else if (!strncmp (p
, "//", 2)
2041 else if (p
[0] == '/' && p
[1] == '.'
2042 && (p
[2] == '/' || p
[2] == 0))
2044 else if (!strncmp (p
, "/..", 3)
2045 /* `/../' is the "superroot" on certain file systems. */
2047 && (p
[3] == '/' || p
[3] == 0))
2049 while (o
!= target
&& *--o
!= '/')
2051 if (o
== target
&& *o
== '/')
2059 #endif /* not VMS */
2062 return make_string (target
, o
- target
);
2066 /* If /~ or // appears, discard everything through first slash. */
2068 file_name_absolute_p (filename
)
2069 const unsigned char *filename
;
2072 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
2074 /* ??? This criterion is probably wrong for '<'. */
2075 || index (filename
, ':') || index (filename
, '<')
2076 || (*filename
== '[' && (filename
[1] != '-'
2077 || (filename
[2] != '.' && filename
[2] != ']'))
2078 && filename
[1] != '.')
2081 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
2082 && IS_DIRECTORY_SEP (filename
[2]))
2087 static unsigned char *
2088 search_embedded_absfilename (nm
, endp
)
2089 unsigned char *nm
, *endp
;
2091 unsigned char *p
, *s
;
2093 for (p
= nm
+ 1; p
< endp
; p
++)
2097 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2099 || IS_DIRECTORY_SEP (p
[-1]))
2100 && file_name_absolute_p (p
)
2101 #if defined (WINDOWSNT) || defined(CYGWIN)
2102 /* // at start of file name is meaningful in Apollo,
2103 WindowsNT and Cygwin systems. */
2104 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
2105 #endif /* not (WINDOWSNT || CYGWIN) */
2108 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2113 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2115 unsigned char *o
= alloca (s
- p
+ 1);
2117 bcopy (p
, o
, s
- p
);
2120 /* If we have ~user and `user' exists, discard
2121 everything up to ~. But if `user' does not exist, leave
2122 ~user alone, it might be a literal file name. */
2124 pw
= getpwnam (o
+ 1);
2136 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2137 Ssubstitute_in_file_name
, 1, 1, 0,
2138 doc
: /* Substitute environment variables referred to in FILENAME.
2139 `$FOO' where FOO is an environment variable name means to substitute
2140 the value of that variable. The variable name should be terminated
2141 with a character not a letter, digit or underscore; otherwise, enclose
2142 the entire variable name in braces.
2143 If `/~' appears, all of FILENAME through that `/' is discarded.
2145 On VMS, `$' substitution is not done; this function does little and only
2146 duplicates what `expand-file-name' does. */)
2148 Lisp_Object filename
;
2152 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2153 unsigned char *target
= NULL
;
2155 int substituted
= 0;
2157 Lisp_Object handler
;
2159 CHECK_STRING (filename
);
2161 /* If the file name has special constructs in it,
2162 call the corresponding file handler. */
2163 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2164 if (!NILP (handler
))
2165 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2167 nm
= SDATA (filename
);
2169 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2170 CORRECT_DIR_SEPS (nm
);
2171 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2173 endp
= nm
+ SBYTES (filename
);
2175 /* If /~ or // appears, discard everything through first slash. */
2176 p
= search_embedded_absfilename (nm
, endp
);
2178 /* Start over with the new string, so we check the file-name-handler
2179 again. Important with filenames like "/home/foo//:/hello///there"
2180 which whould substitute to "/:/hello///there" rather than "/there". */
2181 return Fsubstitute_in_file_name
2182 (make_specified_string (p
, -1, endp
- p
,
2183 STRING_MULTIBYTE (filename
)));
2189 /* See if any variables are substituted into the string
2190 and find the total length of their values in `total' */
2192 for (p
= nm
; p
!= endp
;)
2202 /* "$$" means a single "$" */
2211 while (p
!= endp
&& *p
!= '}') p
++;
2212 if (*p
!= '}') goto missingclose
;
2218 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2222 /* Copy out the variable name */
2223 target
= (unsigned char *) alloca (s
- o
+ 1);
2224 strncpy (target
, o
, s
- o
);
2227 strupr (target
); /* $home == $HOME etc. */
2230 /* Get variable value */
2231 o
= (unsigned char *) egetenv (target
);
2233 { /* Eight-bit chars occupy upto 2 bytes in multibyte. */
2234 total
+= strlen (o
) * (STRING_MULTIBYTE (filename
) ? 2 : 1);
2244 /* If substitution required, recopy the string and do it */
2245 /* Make space in stack frame for the new copy */
2246 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2249 /* Copy the rest of the name through, replacing $ constructs with values */
2266 while (p
!= endp
&& *p
!= '}') p
++;
2267 if (*p
!= '}') goto missingclose
;
2273 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2277 /* Copy out the variable name */
2278 target
= (unsigned char *) alloca (s
- o
+ 1);
2279 strncpy (target
, o
, s
- o
);
2282 strupr (target
); /* $home == $HOME etc. */
2285 /* Get variable value */
2286 o
= (unsigned char *) egetenv (target
);
2290 strcpy (x
, target
); x
+= strlen (target
);
2292 else if (STRING_MULTIBYTE (filename
))
2294 /* If the original string is multibyte,
2295 convert what we substitute into multibyte. */
2299 c
= unibyte_char_to_multibyte (c
);
2300 x
+= CHAR_STRING (c
, x
);
2312 /* If /~ or // appears, discard everything through first slash. */
2313 while ((p
= search_embedded_absfilename (xnm
, x
)))
2314 /* This time we do not start over because we've already expanded envvars
2315 and replaced $$ with $. Maybe we should start over as well, but we'd
2316 need to quote some $ to $$ first. */
2319 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2322 error ("Bad format environment-variable substitution");
2324 error ("Missing \"}\" in environment-variable substitution");
2326 error ("Substituting nonexistent environment variable \"%s\"", target
);
2329 #endif /* not VMS */
2333 /* A slightly faster and more convenient way to get
2334 (directory-file-name (expand-file-name FOO)). */
2337 expand_and_dir_to_file (filename
, defdir
)
2338 Lisp_Object filename
, defdir
;
2340 register Lisp_Object absname
;
2342 absname
= Fexpand_file_name (filename
, defdir
);
2345 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2346 if (c
== ':' || c
== ']' || c
== '>')
2347 absname
= Fdirectory_file_name (absname
);
2350 /* Remove final slash, if any (unless this is the root dir).
2351 stat behaves differently depending! */
2352 if (SCHARS (absname
) > 1
2353 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2354 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2355 /* We cannot take shortcuts; they might be wrong for magic file names. */
2356 absname
= Fdirectory_file_name (absname
);
2361 /* Signal an error if the file ABSNAME already exists.
2362 If INTERACTIVE is nonzero, ask the user whether to proceed,
2363 and bypass the error if the user says to go ahead.
2364 QUERYSTRING is a name for the action that is being considered
2367 *STATPTR is used to store the stat information if the file exists.
2368 If the file does not exist, STATPTR->st_mode is set to 0.
2369 If STATPTR is null, we don't store into it.
2371 If QUICK is nonzero, we ask for y or n, not yes or no. */
2374 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2375 Lisp_Object absname
;
2376 unsigned char *querystring
;
2378 struct stat
*statptr
;
2381 register Lisp_Object tem
, encoded_filename
;
2382 struct stat statbuf
;
2383 struct gcpro gcpro1
;
2385 encoded_filename
= ENCODE_FILE (absname
);
2387 /* stat is a good way to tell whether the file exists,
2388 regardless of what access permissions it has. */
2389 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
2392 xsignal2 (Qfile_already_exists
,
2393 build_string ("File already exists"), absname
);
2395 tem
= format2 ("File %s already exists; %s anyway? ",
2396 absname
, build_string (querystring
));
2398 tem
= Fy_or_n_p (tem
);
2400 tem
= do_yes_or_no_p (tem
);
2403 xsignal2 (Qfile_already_exists
,
2404 build_string ("File already exists"), absname
);
2411 statptr
->st_mode
= 0;
2416 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 5,
2417 "fCopy file: \nGCopy %s to file: \np\nP",
2418 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2419 If NEWNAME names a directory, copy FILE there.
2421 This function always sets the file modes of the output file to match
2424 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
2425 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
2426 signal a `file-already-exists' error without overwriting. If
2427 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
2428 about overwriting; this is what happens in interactive use with M-x.
2429 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
2432 Fourth arg KEEP-TIME non-nil means give the output file the same
2433 last-modified time as the old one. (This works on only some systems.)
2435 A prefix arg makes KEEP-TIME non-nil.
2437 If PRESERVE-UID-GID is non-nil, we try to transfer the
2438 uid and gid of FILE to NEWNAME. */)
2439 (file
, newname
, ok_if_already_exists
, keep_time
, preserve_uid_gid
)
2440 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2441 Lisp_Object preserve_uid_gid
;
2444 char buf
[16 * 1024];
2445 struct stat st
, out_st
;
2446 Lisp_Object handler
;
2447 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2448 int count
= SPECPDL_INDEX ();
2449 int input_file_statable_p
;
2450 Lisp_Object encoded_file
, encoded_newname
;
2452 encoded_file
= encoded_newname
= Qnil
;
2453 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2454 CHECK_STRING (file
);
2455 CHECK_STRING (newname
);
2457 if (!NILP (Ffile_directory_p (newname
)))
2458 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2460 newname
= Fexpand_file_name (newname
, Qnil
);
2462 file
= Fexpand_file_name (file
, Qnil
);
2464 /* If the input file name has special constructs in it,
2465 call the corresponding file handler. */
2466 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2467 /* Likewise for output file name. */
2469 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2470 if (!NILP (handler
))
2471 RETURN_UNGCPRO (call6 (handler
, Qcopy_file
, file
, newname
,
2472 ok_if_already_exists
, keep_time
, preserve_uid_gid
));
2474 encoded_file
= ENCODE_FILE (file
);
2475 encoded_newname
= ENCODE_FILE (newname
);
2477 if (NILP (ok_if_already_exists
)
2478 || INTEGERP (ok_if_already_exists
))
2479 barf_or_query_if_file_exists (newname
, "copy to it",
2480 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2481 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2485 if (!CopyFile (SDATA (encoded_file
),
2486 SDATA (encoded_newname
),
2488 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2489 /* CopyFile retains the timestamp by default. */
2490 else if (NILP (keep_time
))
2496 EMACS_GET_TIME (now
);
2497 filename
= SDATA (encoded_newname
);
2499 /* Ensure file is writable while its modified time is set. */
2500 attributes
= GetFileAttributes (filename
);
2501 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2502 if (set_file_times (filename
, now
, now
))
2504 /* Restore original attributes. */
2505 SetFileAttributes (filename
, attributes
);
2506 xsignal2 (Qfile_date_error
,
2507 build_string ("Cannot set file date"), newname
);
2509 /* Restore original attributes. */
2510 SetFileAttributes (filename
, attributes
);
2512 #else /* not WINDOWSNT */
2514 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2518 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2520 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2522 /* We can only copy regular files and symbolic links. Other files are not
2524 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2526 #if !defined (MSDOS) || __DJGPP__ > 1
2527 if (out_st
.st_mode
!= 0
2528 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2531 report_file_error ("Input and output files are the same",
2532 Fcons (file
, Fcons (newname
, Qnil
)));
2536 #if defined (S_ISREG) && defined (S_ISLNK)
2537 if (input_file_statable_p
)
2539 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2541 #if defined (EISDIR)
2542 /* Get a better looking error message. */
2545 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2548 #endif /* S_ISREG && S_ISLNK */
2551 /* Create the copy file with the same record format as the input file */
2552 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2555 /* System's default file type was set to binary by _fmode in emacs.c. */
2556 ofd
= emacs_open (SDATA (encoded_newname
),
2557 O_WRONLY
| O_TRUNC
| O_CREAT
2558 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2559 S_IREAD
| S_IWRITE
);
2560 #else /* not MSDOS */
2561 ofd
= emacs_open (SDATA (encoded_newname
),
2562 O_WRONLY
| O_TRUNC
| O_CREAT
2563 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2565 #endif /* not MSDOS */
2568 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2570 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2574 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2575 if (emacs_write (ofd
, buf
, n
) != n
)
2576 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2580 /* Preserve the original file modes, and if requested, also its
2582 if (input_file_statable_p
)
2584 if (! NILP (preserve_uid_gid
))
2585 fchown (ofd
, st
.st_uid
, st
.st_gid
);
2586 fchmod (ofd
, st
.st_mode
& 07777);
2588 #endif /* not MSDOS */
2590 /* Closing the output clobbers the file times on some systems. */
2591 if (emacs_close (ofd
) < 0)
2592 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2594 if (input_file_statable_p
)
2596 if (!NILP (keep_time
))
2598 EMACS_TIME atime
, mtime
;
2599 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2600 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2601 if (set_file_times (SDATA (encoded_newname
),
2603 xsignal2 (Qfile_date_error
,
2604 build_string ("Cannot set file date"), newname
);
2610 #if defined (__DJGPP__) && __DJGPP__ > 1
2611 if (input_file_statable_p
)
2613 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2614 and if it can't, it tells so. Otherwise, under MSDOS we usually
2615 get only the READ bit, which will make the copied file read-only,
2616 so it's better not to chmod at all. */
2617 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2618 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2620 #endif /* DJGPP version 2 or newer */
2621 #endif /* not WINDOWSNT */
2623 /* Discard the unwind protects. */
2624 specpdl_ptr
= specpdl
+ count
;
2630 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2631 Smake_directory_internal
, 1, 1, 0,
2632 doc
: /* Create a new directory named DIRECTORY. */)
2634 Lisp_Object directory
;
2636 const unsigned char *dir
;
2637 Lisp_Object handler
;
2638 Lisp_Object encoded_dir
;
2640 CHECK_STRING (directory
);
2641 directory
= Fexpand_file_name (directory
, Qnil
);
2643 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2644 if (!NILP (handler
))
2645 return call2 (handler
, Qmake_directory_internal
, directory
);
2647 encoded_dir
= ENCODE_FILE (directory
);
2649 dir
= SDATA (encoded_dir
);
2652 if (mkdir (dir
) != 0)
2654 if (mkdir (dir
, 0777) != 0)
2656 report_file_error ("Creating directory", list1 (directory
));
2661 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2662 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2664 Lisp_Object directory
;
2666 const unsigned char *dir
;
2667 Lisp_Object handler
;
2668 Lisp_Object encoded_dir
;
2670 CHECK_STRING (directory
);
2671 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2673 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2674 if (!NILP (handler
))
2675 return call2 (handler
, Qdelete_directory
, directory
);
2677 encoded_dir
= ENCODE_FILE (directory
);
2679 dir
= SDATA (encoded_dir
);
2681 if (rmdir (dir
) != 0)
2682 report_file_error ("Removing directory", list1 (directory
));
2687 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2688 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2689 If file has multiple names, it continues to exist with the other names. */)
2691 Lisp_Object filename
;
2693 Lisp_Object handler
;
2694 Lisp_Object encoded_file
;
2695 struct gcpro gcpro1
;
2698 if (!NILP (Ffile_directory_p (filename
))
2699 && NILP (Ffile_symlink_p (filename
)))
2700 xsignal2 (Qfile_error
,
2701 build_string ("Removing old name: is a directory"),
2704 filename
= Fexpand_file_name (filename
, Qnil
);
2706 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2707 if (!NILP (handler
))
2708 return call2 (handler
, Qdelete_file
, filename
);
2710 encoded_file
= ENCODE_FILE (filename
);
2712 if (0 > unlink (SDATA (encoded_file
)))
2713 report_file_error ("Removing old name", list1 (filename
));
2718 internal_delete_file_1 (ignore
)
2724 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2727 internal_delete_file (filename
)
2728 Lisp_Object filename
;
2731 tem
= internal_condition_case_1 (Fdelete_file
, filename
,
2732 Qt
, internal_delete_file_1
);
2736 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2737 "fRename file: \nGRename %s to file: \np",
2738 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2739 If file has names other than FILE, it continues to have those names.
2740 Signals a `file-already-exists' error if a file NEWNAME already exists
2741 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2742 A number as third arg means request confirmation if NEWNAME already exists.
2743 This is what happens in interactive use with M-x. */)
2744 (file
, newname
, ok_if_already_exists
)
2745 Lisp_Object file
, newname
, ok_if_already_exists
;
2747 Lisp_Object handler
;
2748 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2749 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2751 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2752 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2753 CHECK_STRING (file
);
2754 CHECK_STRING (newname
);
2755 file
= Fexpand_file_name (file
, Qnil
);
2757 if ((!NILP (Ffile_directory_p (newname
)))
2759 /* If the file names are identical but for the case,
2760 don't attempt to move directory to itself. */
2761 && (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2764 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2766 newname
= Fexpand_file_name (newname
, Qnil
);
2768 /* If the file name has special constructs in it,
2769 call the corresponding file handler. */
2770 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2772 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2773 if (!NILP (handler
))
2774 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2775 file
, newname
, ok_if_already_exists
));
2777 encoded_file
= ENCODE_FILE (file
);
2778 encoded_newname
= ENCODE_FILE (newname
);
2781 /* If the file names are identical but for the case, don't ask for
2782 confirmation: they simply want to change the letter-case of the
2784 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2786 if (NILP (ok_if_already_exists
)
2787 || INTEGERP (ok_if_already_exists
))
2788 barf_or_query_if_file_exists (newname
, "rename to it",
2789 INTEGERP (ok_if_already_exists
), 0, 0);
2790 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2795 symlink_target
= Ffile_symlink_p (file
);
2796 if (! NILP (symlink_target
))
2797 Fmake_symbolic_link (symlink_target
, newname
,
2798 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2801 Fcopy_file (file
, newname
,
2802 /* We have already prompted if it was an integer,
2803 so don't have copy-file prompt again. */
2804 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2807 Fdelete_file (file
);
2810 report_file_error ("Renaming", list2 (file
, newname
));
2816 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2817 "fAdd name to file: \nGName to add to %s: \np",
2818 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2819 Signals a `file-already-exists' error if a file NEWNAME already exists
2820 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2821 A number as third arg means request confirmation if NEWNAME already exists.
2822 This is what happens in interactive use with M-x. */)
2823 (file
, newname
, ok_if_already_exists
)
2824 Lisp_Object file
, newname
, ok_if_already_exists
;
2826 Lisp_Object handler
;
2827 Lisp_Object encoded_file
, encoded_newname
;
2828 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2830 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2831 encoded_file
= encoded_newname
= Qnil
;
2832 CHECK_STRING (file
);
2833 CHECK_STRING (newname
);
2834 file
= Fexpand_file_name (file
, Qnil
);
2836 if (!NILP (Ffile_directory_p (newname
)))
2837 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2839 newname
= Fexpand_file_name (newname
, Qnil
);
2841 /* If the file name has special constructs in it,
2842 call the corresponding file handler. */
2843 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2844 if (!NILP (handler
))
2845 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2846 newname
, ok_if_already_exists
));
2848 /* If the new name has special constructs in it,
2849 call the corresponding file handler. */
2850 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2851 if (!NILP (handler
))
2852 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2853 newname
, ok_if_already_exists
));
2855 encoded_file
= ENCODE_FILE (file
);
2856 encoded_newname
= ENCODE_FILE (newname
);
2858 if (NILP (ok_if_already_exists
)
2859 || INTEGERP (ok_if_already_exists
))
2860 barf_or_query_if_file_exists (newname
, "make it a new name",
2861 INTEGERP (ok_if_already_exists
), 0, 0);
2863 unlink (SDATA (newname
));
2864 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2865 report_file_error ("Adding new name", list2 (file
, newname
));
2871 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2872 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2873 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2874 Both args must be strings.
2875 Signals a `file-already-exists' error if a file LINKNAME already exists
2876 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2877 A number as third arg means request confirmation if LINKNAME already exists.
2878 This happens for interactive use with M-x. */)
2879 (filename
, linkname
, ok_if_already_exists
)
2880 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2882 Lisp_Object handler
;
2883 Lisp_Object encoded_filename
, encoded_linkname
;
2884 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2886 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2887 encoded_filename
= encoded_linkname
= Qnil
;
2888 CHECK_STRING (filename
);
2889 CHECK_STRING (linkname
);
2890 /* If the link target has a ~, we must expand it to get
2891 a truly valid file name. Otherwise, do not expand;
2892 we want to permit links to relative file names. */
2893 if (SREF (filename
, 0) == '~')
2894 filename
= Fexpand_file_name (filename
, Qnil
);
2896 if (!NILP (Ffile_directory_p (linkname
)))
2897 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2899 linkname
= Fexpand_file_name (linkname
, Qnil
);
2901 /* If the file name has special constructs in it,
2902 call the corresponding file handler. */
2903 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2904 if (!NILP (handler
))
2905 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2906 linkname
, ok_if_already_exists
));
2908 /* If the new link name has special constructs in it,
2909 call the corresponding file handler. */
2910 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2911 if (!NILP (handler
))
2912 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2913 linkname
, ok_if_already_exists
));
2916 encoded_filename
= ENCODE_FILE (filename
);
2917 encoded_linkname
= ENCODE_FILE (linkname
);
2919 if (NILP (ok_if_already_exists
)
2920 || INTEGERP (ok_if_already_exists
))
2921 barf_or_query_if_file_exists (linkname
, "make it a link",
2922 INTEGERP (ok_if_already_exists
), 0, 0);
2923 if (0 > symlink (SDATA (encoded_filename
),
2924 SDATA (encoded_linkname
)))
2926 /* If we didn't complain already, silently delete existing file. */
2927 if (errno
== EEXIST
)
2929 unlink (SDATA (encoded_linkname
));
2930 if (0 <= symlink (SDATA (encoded_filename
),
2931 SDATA (encoded_linkname
)))
2938 report_file_error ("Making symbolic link", list2 (filename
, linkname
));
2945 xsignal1 (Qfile_error
, build_string ("Symbolic links are not supported"));
2947 #endif /* S_IFLNK */
2952 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2953 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2954 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2955 If STRING is nil or a null string, the logical name NAME is deleted. */)
2960 CHECK_STRING (name
);
2962 delete_logical_name (SDATA (name
));
2965 CHECK_STRING (string
);
2967 if (SCHARS (string
) == 0)
2968 delete_logical_name (SDATA (name
));
2970 define_logical_name (SDATA (name
), SDATA (string
));
2979 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2980 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2982 Lisp_Object path
, login
;
2986 CHECK_STRING (path
);
2987 CHECK_STRING (login
);
2989 netresult
= netunam (SDATA (path
), SDATA (login
));
2991 if (netresult
== -1)
2996 #endif /* HPUX_NET */
2998 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
3000 doc
: /* Return t if file FILENAME specifies an absolute file name.
3001 On Unix, this is a name starting with a `/' or a `~'. */)
3003 Lisp_Object filename
;
3005 CHECK_STRING (filename
);
3006 return file_name_absolute_p (SDATA (filename
)) ? Qt
: Qnil
;
3009 /* Return nonzero if file FILENAME exists and can be executed. */
3012 check_executable (filename
)
3016 int len
= strlen (filename
);
3019 if (stat (filename
, &st
) < 0)
3021 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
3022 return ((st
.st_mode
& S_IEXEC
) != 0);
3024 return (S_ISREG (st
.st_mode
)
3026 && (xstrcasecmp ((suffix
= filename
+ len
-4), ".com") == 0
3027 || xstrcasecmp (suffix
, ".exe") == 0
3028 || xstrcasecmp (suffix
, ".bat") == 0)
3029 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3030 #endif /* not WINDOWSNT */
3031 #else /* not DOS_NT */
3032 #ifdef HAVE_EUIDACCESS
3033 return (euidaccess (filename
, 1) >= 0);
3035 /* Access isn't quite right because it uses the real uid
3036 and we really want to test with the effective uid.
3037 But Unix doesn't give us a right way to do it. */
3038 return (access (filename
, 1) >= 0);
3040 #endif /* not DOS_NT */
3043 /* Return nonzero if file FILENAME exists and can be written. */
3046 check_writable (filename
)
3051 if (stat (filename
, &st
) < 0)
3053 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3054 #else /* not MSDOS */
3055 #ifdef HAVE_EUIDACCESS
3056 return (euidaccess (filename
, 2) >= 0);
3058 /* Access isn't quite right because it uses the real uid
3059 and we really want to test with the effective uid.
3060 But Unix doesn't give us a right way to do it.
3061 Opening with O_WRONLY could work for an ordinary file,
3062 but would lose for directories. */
3063 return (access (filename
, 2) >= 0);
3065 #endif /* not MSDOS */
3068 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3069 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
3070 See also `file-readable-p' and `file-attributes'.
3071 This returns nil for a symlink to a nonexistent file.
3072 Use `file-symlink-p' to test for such links. */)
3074 Lisp_Object filename
;
3076 Lisp_Object absname
;
3077 Lisp_Object handler
;
3078 struct stat statbuf
;
3080 CHECK_STRING (filename
);
3081 absname
= Fexpand_file_name (filename
, Qnil
);
3083 /* If the file name has special constructs in it,
3084 call the corresponding file handler. */
3085 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3086 if (!NILP (handler
))
3087 return call2 (handler
, Qfile_exists_p
, absname
);
3089 absname
= ENCODE_FILE (absname
);
3091 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3094 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3095 doc
: /* Return t if FILENAME can be executed by you.
3096 For a directory, this means you can access files in that directory. */)
3098 Lisp_Object filename
;
3100 Lisp_Object absname
;
3101 Lisp_Object handler
;
3103 CHECK_STRING (filename
);
3104 absname
= Fexpand_file_name (filename
, Qnil
);
3106 /* If the file name has special constructs in it,
3107 call the corresponding file handler. */
3108 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3109 if (!NILP (handler
))
3110 return call2 (handler
, Qfile_executable_p
, absname
);
3112 absname
= ENCODE_FILE (absname
);
3114 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3117 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3118 doc
: /* Return t if file FILENAME exists and you can read it.
3119 See also `file-exists-p' and `file-attributes'. */)
3121 Lisp_Object filename
;
3123 Lisp_Object absname
;
3124 Lisp_Object handler
;
3127 struct stat statbuf
;
3129 CHECK_STRING (filename
);
3130 absname
= Fexpand_file_name (filename
, Qnil
);
3132 /* If the file name has special constructs in it,
3133 call the corresponding file handler. */
3134 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3135 if (!NILP (handler
))
3136 return call2 (handler
, Qfile_readable_p
, absname
);
3138 absname
= ENCODE_FILE (absname
);
3140 #if defined(DOS_NT) || defined(macintosh)
3141 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3143 if (access (SDATA (absname
), 0) == 0)
3146 #else /* not DOS_NT and not macintosh */
3148 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3149 /* Opening a fifo without O_NONBLOCK can wait.
3150 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3151 except in the case of a fifo, on a system which handles it. */
3152 desc
= stat (SDATA (absname
), &statbuf
);
3155 if (S_ISFIFO (statbuf
.st_mode
))
3156 flags
|= O_NONBLOCK
;
3158 desc
= emacs_open (SDATA (absname
), flags
, 0);
3163 #endif /* not DOS_NT and not macintosh */
3166 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3168 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3169 doc
: /* Return t if file FILENAME can be written or created by you. */)
3171 Lisp_Object filename
;
3173 Lisp_Object absname
, dir
, encoded
;
3174 Lisp_Object handler
;
3175 struct stat statbuf
;
3177 CHECK_STRING (filename
);
3178 absname
= Fexpand_file_name (filename
, Qnil
);
3180 /* If the file name has special constructs in it,
3181 call the corresponding file handler. */
3182 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3183 if (!NILP (handler
))
3184 return call2 (handler
, Qfile_writable_p
, absname
);
3186 encoded
= ENCODE_FILE (absname
);
3187 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3188 return (check_writable (SDATA (encoded
))
3191 dir
= Ffile_name_directory (absname
);
3194 dir
= Fdirectory_file_name (dir
);
3198 dir
= Fdirectory_file_name (dir
);
3201 dir
= ENCODE_FILE (dir
);
3203 /* The read-only attribute of the parent directory doesn't affect
3204 whether a file or directory can be created within it. Some day we
3205 should check ACLs though, which do affect this. */
3206 if (stat (SDATA (dir
), &statbuf
) < 0)
3208 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3210 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3215 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3216 doc
: /* Access file FILENAME, and get an error if that does not work.
3217 The second argument STRING is used in the error message.
3218 If there is no error, returns nil. */)
3220 Lisp_Object filename
, string
;
3222 Lisp_Object handler
, encoded_filename
, absname
;
3225 CHECK_STRING (filename
);
3226 absname
= Fexpand_file_name (filename
, Qnil
);
3228 CHECK_STRING (string
);
3230 /* If the file name has special constructs in it,
3231 call the corresponding file handler. */
3232 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3233 if (!NILP (handler
))
3234 return call3 (handler
, Qaccess_file
, absname
, string
);
3236 encoded_filename
= ENCODE_FILE (absname
);
3238 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3240 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3246 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3247 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3248 The value is the link target, as a string.
3249 Otherwise it returns nil.
3251 This function returns t when given the name of a symlink that
3252 points to a nonexistent file. */)
3254 Lisp_Object filename
;
3256 Lisp_Object handler
;
3258 CHECK_STRING (filename
);
3259 filename
= Fexpand_file_name (filename
, Qnil
);
3261 /* If the file name has special constructs in it,
3262 call the corresponding file handler. */
3263 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3264 if (!NILP (handler
))
3265 return call2 (handler
, Qfile_symlink_p
, filename
);
3274 filename
= ENCODE_FILE (filename
);
3281 buf
= (char *) xrealloc (buf
, bufsize
);
3282 bzero (buf
, bufsize
);
3285 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3289 /* HP-UX reports ERANGE if buffer is too small. */
3290 if (errno
== ERANGE
)
3300 while (valsize
>= bufsize
);
3302 val
= make_string (buf
, valsize
);
3303 if (buf
[0] == '/' && index (buf
, ':'))
3304 val
= concat2 (build_string ("/:"), val
);
3306 val
= DECODE_FILE (val
);
3309 #else /* not S_IFLNK */
3311 #endif /* not S_IFLNK */
3314 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3315 doc
: /* Return t if FILENAME names an existing directory.
3316 Symbolic links to directories count as directories.
3317 See `file-symlink-p' to distinguish symlinks. */)
3319 Lisp_Object filename
;
3321 register Lisp_Object absname
;
3323 Lisp_Object handler
;
3325 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3327 /* If the file name has special constructs in it,
3328 call the corresponding file handler. */
3329 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3330 if (!NILP (handler
))
3331 return call2 (handler
, Qfile_directory_p
, absname
);
3333 absname
= ENCODE_FILE (absname
);
3335 if (stat (SDATA (absname
), &st
) < 0)
3337 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3340 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3341 doc
: /* Return t if file FILENAME names a directory you can open.
3342 For the value to be t, FILENAME must specify the name of a directory as a file,
3343 and the directory must allow you to open files in it. In order to use a
3344 directory as a buffer's current directory, this predicate must return true.
3345 A directory name spec may be given instead; then the value is t
3346 if the directory so specified exists and really is a readable and
3347 searchable directory. */)
3349 Lisp_Object filename
;
3351 Lisp_Object handler
;
3353 struct gcpro gcpro1
;
3355 /* If the file name has special constructs in it,
3356 call the corresponding file handler. */
3357 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3358 if (!NILP (handler
))
3359 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3362 tem
= (NILP (Ffile_directory_p (filename
))
3363 || NILP (Ffile_executable_p (filename
)));
3365 return tem
? Qnil
: Qt
;
3368 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3369 doc
: /* Return t if FILENAME names a regular file.
3370 This is the sort of file that holds an ordinary stream of data bytes.
3371 Symbolic links to regular files count as regular files.
3372 See `file-symlink-p' to distinguish symlinks. */)
3374 Lisp_Object filename
;
3376 register Lisp_Object absname
;
3378 Lisp_Object handler
;
3380 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3382 /* If the file name has special constructs in it,
3383 call the corresponding file handler. */
3384 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3385 if (!NILP (handler
))
3386 return call2 (handler
, Qfile_regular_p
, absname
);
3388 absname
= ENCODE_FILE (absname
);
3393 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3395 /* Tell stat to use expensive method to get accurate info. */
3396 Vw32_get_true_file_attributes
= Qt
;
3397 result
= stat (SDATA (absname
), &st
);
3398 Vw32_get_true_file_attributes
= tem
;
3402 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3405 if (stat (SDATA (absname
), &st
) < 0)
3407 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3411 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3412 doc
: /* Return mode bits of file named FILENAME, as an integer.
3413 Return nil, if file does not exist or is not accessible. */)
3415 Lisp_Object filename
;
3417 Lisp_Object absname
;
3419 Lisp_Object handler
;
3421 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3423 /* If the file name has special constructs in it,
3424 call the corresponding file handler. */
3425 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3426 if (!NILP (handler
))
3427 return call2 (handler
, Qfile_modes
, absname
);
3429 absname
= ENCODE_FILE (absname
);
3431 if (stat (SDATA (absname
), &st
) < 0)
3433 #if defined (MSDOS) && __DJGPP__ < 2
3434 if (check_executable (SDATA (absname
)))
3435 st
.st_mode
|= S_IEXEC
;
3436 #endif /* MSDOS && __DJGPP__ < 2 */
3438 return make_number (st
.st_mode
& 07777);
3441 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2,
3442 "(let ((file (read-file-name \"File: \"))) \
3443 (list file (read-file-modes nil file)))",
3444 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3445 Only the 12 low bits of MODE are used. */)
3447 Lisp_Object filename
, mode
;
3449 Lisp_Object absname
, encoded_absname
;
3450 Lisp_Object handler
;
3452 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3453 CHECK_NUMBER (mode
);
3455 /* If the file name has special constructs in it,
3456 call the corresponding file handler. */
3457 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3458 if (!NILP (handler
))
3459 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3461 encoded_absname
= ENCODE_FILE (absname
);
3463 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3464 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3469 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3470 doc
: /* Set the file permission bits for newly created files.
3471 The argument MODE should be an integer; only the low 9 bits are used.
3472 This setting is inherited by subprocesses. */)
3476 CHECK_NUMBER (mode
);
3478 umask ((~ XINT (mode
)) & 0777);
3483 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3484 doc
: /* Return the default file protection for created files.
3485 The value is an integer. */)
3491 realmask
= umask (0);
3494 XSETINT (value
, (~ realmask
) & 0777);
3498 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3500 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3501 doc
: /* Set times of file FILENAME to TIME.
3502 Set both access and modification times.
3503 Return t on success, else nil.
3504 Use the current time if TIME is nil. TIME is in the format of
3507 Lisp_Object filename
, time
;
3509 Lisp_Object absname
, encoded_absname
;
3510 Lisp_Object handler
;
3514 if (! lisp_time_argument (time
, &sec
, &usec
))
3515 error ("Invalid time specification");
3517 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3519 /* If the file name has special constructs in it,
3520 call the corresponding file handler. */
3521 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3522 if (!NILP (handler
))
3523 return call3 (handler
, Qset_file_times
, absname
, time
);
3525 encoded_absname
= ENCODE_FILE (absname
);
3530 EMACS_SET_SECS (t
, sec
);
3531 EMACS_SET_USECS (t
, usec
);
3533 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3538 /* Setting times on a directory always fails. */
3539 if (stat (SDATA (encoded_absname
), &st
) == 0
3540 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3543 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3552 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3553 doc
: /* Tell Unix to finish all pending disk updates. */)
3560 #endif /* HAVE_SYNC */
3562 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3563 doc
: /* Return t if file FILE1 is newer than file FILE2.
3564 If FILE1 does not exist, the answer is nil;
3565 otherwise, if FILE2 does not exist, the answer is t. */)
3567 Lisp_Object file1
, file2
;
3569 Lisp_Object absname1
, absname2
;
3572 Lisp_Object handler
;
3573 struct gcpro gcpro1
, gcpro2
;
3575 CHECK_STRING (file1
);
3576 CHECK_STRING (file2
);
3579 GCPRO2 (absname1
, file2
);
3580 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3581 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3584 /* If the file name has special constructs in it,
3585 call the corresponding file handler. */
3586 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3588 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3589 if (!NILP (handler
))
3590 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3592 GCPRO2 (absname1
, absname2
);
3593 absname1
= ENCODE_FILE (absname1
);
3594 absname2
= ENCODE_FILE (absname2
);
3597 if (stat (SDATA (absname1
), &st
) < 0)
3600 mtime1
= st
.st_mtime
;
3602 if (stat (SDATA (absname2
), &st
) < 0)
3605 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3609 Lisp_Object Qfind_buffer_file_type
;
3612 #ifndef READ_BUF_SIZE
3613 #define READ_BUF_SIZE (64 << 10)
3616 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3618 /* This function is called after Lisp functions to decide a coding
3619 system are called, or when they cause an error. Before they are
3620 called, the current buffer is set unibyte and it contains only a
3621 newly inserted text (thus the buffer was empty before the
3624 The functions may set markers, overlays, text properties, or even
3625 alter the buffer contents, change the current buffer.
3627 Here, we reset all those changes by:
3628 o set back the current buffer.
3629 o move all markers and overlays to BEG.
3630 o remove all text properties.
3631 o set back the buffer multibyteness. */
3634 decide_coding_unwind (unwind_data
)
3635 Lisp_Object unwind_data
;
3637 Lisp_Object multibyte
, undo_list
, buffer
;
3639 multibyte
= XCAR (unwind_data
);
3640 unwind_data
= XCDR (unwind_data
);
3641 undo_list
= XCAR (unwind_data
);
3642 buffer
= XCDR (unwind_data
);
3644 if (current_buffer
!= XBUFFER (buffer
))
3645 set_buffer_internal (XBUFFER (buffer
));
3646 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3647 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3648 BUF_INTERVALS (current_buffer
) = 0;
3649 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3651 /* Now we are safe to change the buffer's multibyteness directly. */
3652 current_buffer
->enable_multibyte_characters
= multibyte
;
3653 current_buffer
->undo_list
= undo_list
;
3659 /* Used to pass values from insert-file-contents to read_non_regular. */
3661 static int non_regular_fd
;
3662 static int non_regular_inserted
;
3663 static int non_regular_nbytes
;
3666 /* Read from a non-regular file.
3667 Read non_regular_trytry bytes max from non_regular_fd.
3668 Non_regular_inserted specifies where to put the read bytes.
3669 Value is the number of bytes read. */
3678 nbytes
= emacs_read (non_regular_fd
,
3679 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3680 non_regular_nbytes
);
3682 return make_number (nbytes
);
3686 /* Condition-case handler used when reading from non-regular files
3687 in insert-file-contents. */
3690 read_non_regular_quit ()
3696 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3698 doc
: /* Insert contents of file FILENAME after point.
3699 Returns list of absolute file name and number of characters inserted.
3700 If second argument VISIT is non-nil, the buffer's visited filename and
3701 last save file modtime are set, and it is marked unmodified. If
3702 visiting and the file does not exist, visiting is completed before the
3705 The optional third and fourth arguments BEG and END specify what portion
3706 of the file to insert. These arguments count bytes in the file, not
3707 characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
3709 If optional fifth argument REPLACE is non-nil, replace the current
3710 buffer contents (in the accessible portion) with the file contents.
3711 This is better than simply deleting and inserting the whole thing
3712 because (1) it preserves some marker positions and (2) it puts less data
3713 in the undo list. When REPLACE is non-nil, the second return value is
3714 the number of characters that replace previous buffer contents.
3716 This function does code conversion according to the value of
3717 `coding-system-for-read' or `file-coding-system-alist', and sets the
3718 variable `last-coding-system-used' to the coding system actually used. */)
3719 (filename
, visit
, beg
, end
, replace
)
3720 Lisp_Object filename
, visit
, beg
, end
, replace
;
3726 register int how_much
;
3727 register int unprocessed
;
3728 int count
= SPECPDL_INDEX ();
3729 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3730 Lisp_Object handler
, val
, insval
, orig_filename
, old_undo
;
3733 int not_regular
= 0;
3734 unsigned char read_buf
[READ_BUF_SIZE
];
3735 struct coding_system coding
;
3736 unsigned char buffer
[1 << 14];
3737 int replace_handled
= 0;
3738 int set_coding_system
= 0;
3739 Lisp_Object coding_system
;
3741 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3742 int we_locked_file
= 0;
3744 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3745 error ("Cannot do file visiting in an indirect buffer");
3747 if (!NILP (current_buffer
->read_only
))
3748 Fbarf_if_buffer_read_only ();
3752 orig_filename
= Qnil
;
3755 GCPRO5 (filename
, val
, p
, orig_filename
, old_undo
);
3757 CHECK_STRING (filename
);
3758 filename
= Fexpand_file_name (filename
, Qnil
);
3760 /* The value Qnil means that the coding system is not yet
3762 coding_system
= Qnil
;
3764 /* If the file name has special constructs in it,
3765 call the corresponding file handler. */
3766 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3767 if (!NILP (handler
))
3769 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3770 visit
, beg
, end
, replace
);
3771 if (CONSP (val
) && CONSP (XCDR (val
)))
3772 inserted
= XINT (XCAR (XCDR (val
)));
3776 orig_filename
= filename
;
3777 filename
= ENCODE_FILE (filename
);
3783 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3785 /* Tell stat to use expensive method to get accurate info. */
3786 Vw32_get_true_file_attributes
= Qt
;
3787 total
= stat (SDATA (filename
), &st
);
3788 Vw32_get_true_file_attributes
= tem
;
3792 if (stat (SDATA (filename
), &st
) < 0)
3793 #endif /* WINDOWSNT */
3795 if (fd
>= 0) emacs_close (fd
);
3798 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3801 if (!NILP (Vcoding_system_for_read
))
3802 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3807 /* This code will need to be changed in order to work on named
3808 pipes, and it's probably just not worth it. So we should at
3809 least signal an error. */
3810 if (!S_ISREG (st
.st_mode
))
3817 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3818 xsignal2 (Qfile_error
,
3819 build_string ("not a regular file"), orig_filename
);
3824 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3827 /* Replacement should preserve point as it preserves markers. */
3828 if (!NILP (replace
))
3829 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3831 record_unwind_protect (close_file_unwind
, make_number (fd
));
3833 /* Supposedly happens on VMS. */
3834 /* Can happen on any platform that uses long as type of off_t, but allows
3835 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3836 give a message suitable for the latter case. */
3837 if (! not_regular
&& st
.st_size
< 0)
3838 error ("Maximum buffer size exceeded");
3840 /* Prevent redisplay optimizations. */
3841 current_buffer
->clip_changed
= 1;
3845 if (!NILP (beg
) || !NILP (end
))
3846 error ("Attempt to visit less than an entire file");
3847 if (BEG
< Z
&& NILP (replace
))
3848 error ("Cannot do file visiting in a non-empty buffer");
3854 XSETFASTINT (beg
, 0);
3862 XSETINT (end
, st
.st_size
);
3864 /* Arithmetic overflow can occur if an Emacs integer cannot
3865 represent the file size, or if the calculations below
3866 overflow. The calculations below double the file size
3867 twice, so check that it can be multiplied by 4 safely. */
3868 if (XINT (end
) != st
.st_size
3869 || st
.st_size
> INT_MAX
/ 4)
3870 error ("Maximum buffer size exceeded");
3872 /* The file size returned from stat may be zero, but data
3873 may be readable nonetheless, for example when this is a
3874 file in the /proc filesystem. */
3875 if (st
.st_size
== 0)
3876 XSETINT (end
, READ_BUF_SIZE
);
3880 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3882 coding_system
= coding_inherit_eol_type (Qutf_8_emacs
, Qunix
);
3883 setup_coding_system (coding_system
, &coding
);
3884 /* Ensure we set Vlast_coding_system_used. */
3885 set_coding_system
= 1;
3889 /* Decide the coding system to use for reading the file now
3890 because we can't use an optimized method for handling
3891 `coding:' tag if the current buffer is not empty. */
3892 if (!NILP (Vcoding_system_for_read
))
3893 coding_system
= Vcoding_system_for_read
;
3896 /* Don't try looking inside a file for a coding system
3897 specification if it is not seekable. */
3898 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3900 /* Find a coding system specified in the heading two
3901 lines or in the tailing several lines of the file.
3902 We assume that the 1K-byte and 3K-byte for heading
3903 and tailing respectively are sufficient for this
3907 if (st
.st_size
<= (1024 * 4))
3908 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3911 nread
= emacs_read (fd
, read_buf
, 1024);
3914 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3915 report_file_error ("Setting file position",
3916 Fcons (orig_filename
, Qnil
));
3917 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3922 error ("IO error reading %s: %s",
3923 SDATA (orig_filename
), emacs_strerror (errno
));
3926 struct buffer
*prev
= current_buffer
;
3930 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3932 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3933 buf
= XBUFFER (buffer
);
3935 delete_all_overlays (buf
);
3936 buf
->directory
= current_buffer
->directory
;
3937 buf
->read_only
= Qnil
;
3938 buf
->filename
= Qnil
;
3939 buf
->undo_list
= Qt
;
3940 eassert (buf
->overlays_before
== NULL
);
3941 eassert (buf
->overlays_after
== NULL
);
3943 set_buffer_internal (buf
);
3945 buf
->enable_multibyte_characters
= Qnil
;
3947 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3948 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3949 coding_system
= call2 (Vset_auto_coding_function
,
3950 filename
, make_number (nread
));
3951 set_buffer_internal (prev
);
3953 /* Discard the unwind protect for recovering the
3957 /* Rewind the file for the actual read done later. */
3958 if (lseek (fd
, 0, 0) < 0)
3959 report_file_error ("Setting file position",
3960 Fcons (orig_filename
, Qnil
));
3964 if (NILP (coding_system
))
3966 /* If we have not yet decided a coding system, check
3967 file-coding-system-alist. */
3968 Lisp_Object args
[6];
3970 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3971 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3972 coding_system
= Ffind_operation_coding_system (6, args
);
3973 if (CONSP (coding_system
))
3974 coding_system
= XCAR (coding_system
);
3978 if (NILP (coding_system
))
3979 coding_system
= Qundecided
;
3981 CHECK_CODING_SYSTEM (coding_system
);
3983 if (NILP (current_buffer
->enable_multibyte_characters
))
3984 /* We must suppress all character code conversion except for
3985 end-of-line conversion. */
3986 coding_system
= raw_text_coding_system (coding_system
);
3988 setup_coding_system (coding_system
, &coding
);
3989 /* Ensure we set Vlast_coding_system_used. */
3990 set_coding_system
= 1;
3993 /* If requested, replace the accessible part of the buffer
3994 with the file contents. Avoid replacing text at the
3995 beginning or end of the buffer that matches the file contents;
3996 that preserves markers pointing to the unchanged parts.
3998 Here we implement this feature in an optimized way
3999 for the case where code conversion is NOT needed.
4000 The following if-statement handles the case of conversion
4001 in a less optimal way.
4003 If the code conversion is "automatic" then we try using this
4004 method and hope for the best.
4005 But if we discover the need for conversion, we give up on this method
4006 and let the following if-statement handle the replace job. */
4009 && (NILP (coding_system
)
4010 || ! CODING_REQUIRE_DECODING (&coding
)))
4012 /* same_at_start and same_at_end count bytes,
4013 because file access counts bytes
4014 and BEG and END count bytes. */
4015 int same_at_start
= BEGV_BYTE
;
4016 int same_at_end
= ZV_BYTE
;
4018 /* There is still a possibility we will find the need to do code
4019 conversion. If that happens, we set this variable to 1 to
4020 give up on handling REPLACE in the optimized way. */
4021 int giveup_match_end
= 0;
4023 if (XINT (beg
) != 0)
4025 if (lseek (fd
, XINT (beg
), 0) < 0)
4026 report_file_error ("Setting file position",
4027 Fcons (orig_filename
, Qnil
));
4032 /* Count how many chars at the start of the file
4033 match the text at the beginning of the buffer. */
4038 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4040 error ("IO error reading %s: %s",
4041 SDATA (orig_filename
), emacs_strerror (errno
));
4042 else if (nread
== 0)
4045 if (CODING_REQUIRE_DETECTION (&coding
))
4047 coding_system
= detect_coding_system (buffer
, nread
, nread
, 1, 0,
4049 setup_coding_system (coding_system
, &coding
);
4052 if (CODING_REQUIRE_DECODING (&coding
))
4053 /* We found that the file should be decoded somehow.
4054 Let's give up here. */
4056 giveup_match_end
= 1;
4061 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4062 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4063 same_at_start
++, bufpos
++;
4064 /* If we found a discrepancy, stop the scan.
4065 Otherwise loop around and scan the next bufferful. */
4066 if (bufpos
!= nread
)
4070 /* If the file matches the buffer completely,
4071 there's no need to replace anything. */
4072 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4076 /* Truncate the buffer to the size of the file. */
4077 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4082 /* Count how many chars at the end of the file
4083 match the text at the end of the buffer. But, if we have
4084 already found that decoding is necessary, don't waste time. */
4085 while (!giveup_match_end
)
4087 int total_read
, nread
, bufpos
, curpos
, trial
;
4089 /* At what file position are we now scanning? */
4090 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4091 /* If the entire file matches the buffer tail, stop the scan. */
4094 /* How much can we scan in the next step? */
4095 trial
= min (curpos
, sizeof buffer
);
4096 if (lseek (fd
, curpos
- trial
, 0) < 0)
4097 report_file_error ("Setting file position",
4098 Fcons (orig_filename
, Qnil
));
4100 total_read
= nread
= 0;
4101 while (total_read
< trial
)
4103 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4105 error ("IO error reading %s: %s",
4106 SDATA (orig_filename
), emacs_strerror (errno
));
4107 else if (nread
== 0)
4109 total_read
+= nread
;
4112 /* Scan this bufferful from the end, comparing with
4113 the Emacs buffer. */
4114 bufpos
= total_read
;
4116 /* Compare with same_at_start to avoid counting some buffer text
4117 as matching both at the file's beginning and at the end. */
4118 while (bufpos
> 0 && same_at_end
> same_at_start
4119 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4120 same_at_end
--, bufpos
--;
4122 /* If we found a discrepancy, stop the scan.
4123 Otherwise loop around and scan the preceding bufferful. */
4126 /* If this discrepancy is because of code conversion,
4127 we cannot use this method; giveup and try the other. */
4128 if (same_at_end
> same_at_start
4129 && FETCH_BYTE (same_at_end
- 1) >= 0200
4130 && ! NILP (current_buffer
->enable_multibyte_characters
)
4131 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4132 giveup_match_end
= 1;
4141 if (! giveup_match_end
)
4145 /* We win! We can handle REPLACE the optimized way. */
4147 /* Extend the start of non-matching text area to multibyte
4148 character boundary. */
4149 if (! NILP (current_buffer
->enable_multibyte_characters
))
4150 while (same_at_start
> BEGV_BYTE
4151 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4154 /* Extend the end of non-matching text area to multibyte
4155 character boundary. */
4156 if (! NILP (current_buffer
->enable_multibyte_characters
))
4157 while (same_at_end
< ZV_BYTE
4158 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4161 /* Don't try to reuse the same piece of text twice. */
4162 overlap
= (same_at_start
- BEGV_BYTE
4163 - (same_at_end
+ st
.st_size
- ZV
));
4165 same_at_end
+= overlap
;
4167 /* Arrange to read only the nonmatching middle part of the file. */
4168 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4169 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4171 del_range_byte (same_at_start
, same_at_end
, 0);
4172 /* Insert from the file at the proper position. */
4173 temp
= BYTE_TO_CHAR (same_at_start
);
4174 SET_PT_BOTH (temp
, same_at_start
);
4176 /* If display currently starts at beginning of line,
4177 keep it that way. */
4178 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4179 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4181 replace_handled
= 1;
4185 /* If requested, replace the accessible part of the buffer
4186 with the file contents. Avoid replacing text at the
4187 beginning or end of the buffer that matches the file contents;
4188 that preserves markers pointing to the unchanged parts.
4190 Here we implement this feature for the case where code conversion
4191 is needed, in a simple way that needs a lot of memory.
4192 The preceding if-statement handles the case of no conversion
4193 in a more optimized way. */
4194 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4196 EMACS_INT same_at_start
= BEGV_BYTE
;
4197 EMACS_INT same_at_end
= ZV_BYTE
;
4198 EMACS_INT same_at_start_charpos
;
4199 EMACS_INT inserted_chars
;
4202 unsigned char *decoded
;
4204 int this_count
= SPECPDL_INDEX ();
4205 int multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
4206 Lisp_Object conversion_buffer
;
4208 conversion_buffer
= code_conversion_save (1, multibyte
);
4210 /* First read the whole file, performing code conversion into
4211 CONVERSION_BUFFER. */
4213 if (lseek (fd
, XINT (beg
), 0) < 0)
4214 report_file_error ("Setting file position",
4215 Fcons (orig_filename
, Qnil
));
4217 total
= st
.st_size
; /* Total bytes in the file. */
4218 how_much
= 0; /* Bytes read from file so far. */
4219 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4220 unprocessed
= 0; /* Bytes not processed in previous loop. */
4222 GCPRO1 (conversion_buffer
);
4223 while (how_much
< total
)
4225 /* We read one bunch by one (READ_BUF_SIZE bytes) to allow
4226 quitting while reading a huge while. */
4227 /* try is reserved in some compilers (Microsoft C) */
4228 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4231 /* Allow quitting out of the actual I/O. */
4234 this = emacs_read (fd
, read_buf
+ unprocessed
, trytry
);
4246 BUF_TEMP_SET_PT (XBUFFER (conversion_buffer
),
4247 BUF_Z (XBUFFER (conversion_buffer
)));
4248 decode_coding_c_string (&coding
, read_buf
, unprocessed
+ this,
4250 unprocessed
= coding
.carryover_bytes
;
4251 if (coding
.carryover_bytes
> 0)
4252 bcopy (coding
.carryover
, read_buf
, unprocessed
);
4257 /* At this point, HOW_MUCH should equal TOTAL, or should be <= 0
4258 if we couldn't read the file. */
4261 error ("IO error reading %s: %s",
4262 SDATA (orig_filename
), emacs_strerror (errno
));
4264 if (unprocessed
> 0)
4266 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4267 decode_coding_c_string (&coding
, read_buf
, unprocessed
,
4269 coding
.mode
&= ~CODING_MODE_LAST_BLOCK
;
4272 decoded
= BUF_BEG_ADDR (XBUFFER (conversion_buffer
));
4273 inserted
= (BUF_Z_BYTE (XBUFFER (conversion_buffer
))
4274 - BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
4276 /* Compare the beginning of the converted string with the buffer
4280 while (bufpos
< inserted
&& same_at_start
< same_at_end
4281 && FETCH_BYTE (same_at_start
) == decoded
[bufpos
])
4282 same_at_start
++, bufpos
++;
4284 /* If the file matches the head of buffer completely,
4285 there's no need to replace anything. */
4287 if (bufpos
== inserted
)
4290 /* Truncate the buffer to the size of the file. */
4291 if (same_at_start
== same_at_end
)
4294 del_range_byte (same_at_start
, same_at_end
, 0);
4297 unbind_to (this_count
, Qnil
);
4301 /* Extend the start of non-matching text area to the previous
4302 multibyte character boundary. */
4303 if (! NILP (current_buffer
->enable_multibyte_characters
))
4304 while (same_at_start
> BEGV_BYTE
4305 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4308 /* Scan this bufferful from the end, comparing with
4309 the Emacs buffer. */
4312 /* Compare with same_at_start to avoid counting some buffer text
4313 as matching both at the file's beginning and at the end. */
4314 while (bufpos
> 0 && same_at_end
> same_at_start
4315 && FETCH_BYTE (same_at_end
- 1) == decoded
[bufpos
- 1])
4316 same_at_end
--, bufpos
--;
4318 /* Extend the end of non-matching text area to the next
4319 multibyte character boundary. */
4320 if (! NILP (current_buffer
->enable_multibyte_characters
))
4321 while (same_at_end
< ZV_BYTE
4322 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4325 /* Don't try to reuse the same piece of text twice. */
4326 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4328 same_at_end
+= overlap
;
4330 /* If display currently starts at beginning of line,
4331 keep it that way. */
4332 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4333 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4335 /* Replace the chars that we need to replace,
4336 and update INSERTED to equal the number of bytes
4337 we are taking from the decoded string. */
4338 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4340 if (same_at_end
!= same_at_start
)
4342 del_range_byte (same_at_start
, same_at_end
, 0);
4344 same_at_start
= GPT_BYTE
;
4348 temp
= BYTE_TO_CHAR (same_at_start
);
4350 /* Insert from the file at the proper position. */
4351 SET_PT_BOTH (temp
, same_at_start
);
4352 same_at_start_charpos
4353 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4354 same_at_start
- BEGV_BYTE
4355 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
4357 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4358 same_at_start
+ inserted
- BEGV_BYTE
4359 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)))
4360 - same_at_start_charpos
);
4361 /* This binding is to avoid ask-user-about-supersession-threat
4362 being called in insert_from_buffer (via in
4363 prepare_to_modify_buffer). */
4364 specbind (intern ("buffer-file-name"), Qnil
);
4365 insert_from_buffer (XBUFFER (conversion_buffer
),
4366 same_at_start_charpos
, inserted_chars
, 0);
4367 /* Set `inserted' to the number of inserted characters. */
4368 inserted
= PT
- temp
;
4369 /* Set point before the inserted characters. */
4370 SET_PT_BOTH (temp
, same_at_start
);
4372 unbind_to (this_count
, Qnil
);
4379 register Lisp_Object temp
;
4381 total
= XINT (end
) - XINT (beg
);
4383 /* Make sure point-max won't overflow after this insertion. */
4384 XSETINT (temp
, total
);
4385 if (total
!= XINT (temp
))
4386 error ("Maximum buffer size exceeded");
4389 /* For a special file, all we can do is guess. */
4390 total
= READ_BUF_SIZE
;
4392 if (NILP (visit
) && inserted
> 0)
4394 #ifdef CLASH_DETECTION
4395 if (!NILP (current_buffer
->file_truename
)
4396 /* Make binding buffer-file-name to nil effective. */
4397 && !NILP (current_buffer
->filename
)
4398 && SAVE_MODIFF
>= MODIFF
)
4400 #endif /* CLASH_DETECTION */
4401 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
4405 if (GAP_SIZE
< total
)
4406 make_gap (total
- GAP_SIZE
);
4408 if (XINT (beg
) != 0 || !NILP (replace
))
4410 if (lseek (fd
, XINT (beg
), 0) < 0)
4411 report_file_error ("Setting file position",
4412 Fcons (orig_filename
, Qnil
));
4415 /* In the following loop, HOW_MUCH contains the total bytes read so
4416 far for a regular file, and not changed for a special file. But,
4417 before exiting the loop, it is set to a negative value if I/O
4421 /* Total bytes inserted. */
4424 /* Here, we don't do code conversion in the loop. It is done by
4425 decode_coding_gap after all data are read into the buffer. */
4427 int gap_size
= GAP_SIZE
;
4429 while (how_much
< total
)
4431 /* try is reserved in some compilers (Microsoft C) */
4432 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4439 /* Maybe make more room. */
4440 if (gap_size
< trytry
)
4442 make_gap (total
- gap_size
);
4443 gap_size
= GAP_SIZE
;
4446 /* Read from the file, capturing `quit'. When an
4447 error occurs, end the loop, and arrange for a quit
4448 to be signaled after decoding the text we read. */
4449 non_regular_fd
= fd
;
4450 non_regular_inserted
= inserted
;
4451 non_regular_nbytes
= trytry
;
4452 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4453 read_non_regular_quit
);
4464 /* Allow quitting out of the actual I/O. We don't make text
4465 part of the buffer until all the reading is done, so a C-g
4466 here doesn't do any harm. */
4469 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4481 /* For a regular file, where TOTAL is the real size,
4482 count HOW_MUCH to compare with it.
4483 For a special file, where TOTAL is just a buffer size,
4484 so don't bother counting in HOW_MUCH.
4485 (INSERTED is where we count the number of characters inserted.) */
4492 /* Now we have read all the file data into the gap.
4493 If it was empty, undo marking the buffer modified. */
4497 #ifdef CLASH_DETECTION
4499 unlock_file (current_buffer
->file_truename
);
4501 Vdeactivate_mark
= old_Vdeactivate_mark
;
4504 Vdeactivate_mark
= Qt
;
4506 /* Make the text read part of the buffer. */
4507 GAP_SIZE
-= inserted
;
4509 GPT_BYTE
+= inserted
;
4511 ZV_BYTE
+= inserted
;
4516 /* Put an anchor to ensure multi-byte form ends at gap. */
4521 /* Discard the unwind protect for closing the file. */
4525 error ("IO error reading %s: %s",
4526 SDATA (orig_filename
), emacs_strerror (errno
));
4530 if (NILP (coding_system
))
4532 /* The coding system is not yet decided. Decide it by an
4533 optimized method for handling `coding:' tag.
4535 Note that we can get here only if the buffer was empty
4536 before the insertion. */
4538 if (!NILP (Vcoding_system_for_read
))
4539 coding_system
= Vcoding_system_for_read
;
4542 /* Since we are sure that the current buffer was empty
4543 before the insertion, we can toggle
4544 enable-multibyte-characters directly here without taking
4545 care of marker adjustment. By this way, we can run Lisp
4546 program safely before decoding the inserted text. */
4547 Lisp_Object unwind_data
;
4548 int count
= SPECPDL_INDEX ();
4550 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4551 Fcons (current_buffer
->undo_list
,
4552 Fcurrent_buffer ()));
4553 current_buffer
->enable_multibyte_characters
= Qnil
;
4554 current_buffer
->undo_list
= Qt
;
4555 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4557 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4559 coding_system
= call2 (Vset_auto_coding_function
,
4560 filename
, make_number (inserted
));
4563 if (NILP (coding_system
))
4565 /* If the coding system is not yet decided, check
4566 file-coding-system-alist. */
4567 Lisp_Object args
[6];
4569 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4570 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4571 coding_system
= Ffind_operation_coding_system (6, args
);
4572 if (CONSP (coding_system
))
4573 coding_system
= XCAR (coding_system
);
4575 unbind_to (count
, Qnil
);
4576 inserted
= Z_BYTE
- BEG_BYTE
;
4579 if (NILP (coding_system
))
4580 coding_system
= Qundecided
;
4582 CHECK_CODING_SYSTEM (coding_system
);
4584 if (NILP (current_buffer
->enable_multibyte_characters
))
4585 /* We must suppress all character code conversion except for
4586 end-of-line conversion. */
4587 coding_system
= raw_text_coding_system (coding_system
);
4588 setup_coding_system (coding_system
, &coding
);
4589 /* Ensure we set Vlast_coding_system_used. */
4590 set_coding_system
= 1;
4595 /* When we visit a file by raw-text, we change the buffer to
4597 if (CODING_FOR_UNIBYTE (&coding
)
4598 /* Can't do this if part of the buffer might be preserved. */
4600 /* Visiting a file with these coding system makes the buffer
4602 current_buffer
->enable_multibyte_characters
= Qnil
;
4605 coding
.dst_multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
4606 if (CODING_MAY_REQUIRE_DECODING (&coding
)
4607 && (inserted
> 0 || CODING_REQUIRE_FLUSHING (&coding
)))
4609 move_gap_both (PT
, PT_BYTE
);
4610 GAP_SIZE
+= inserted
;
4611 ZV_BYTE
-= inserted
;
4615 decode_coding_gap (&coding
, inserted
, inserted
);
4616 inserted
= coding
.produced_char
;
4617 coding_system
= CODING_ID_NAME (coding
.id
);
4619 else if (inserted
> 0)
4620 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4623 /* Now INSERTED is measured in characters. */
4626 /* Use the conversion type to determine buffer-file-type
4627 (find-buffer-file-type is now used to help determine the
4629 if ((VECTORP (CODING_ID_EOL_TYPE (coding
.id
))
4630 || EQ (CODING_ID_EOL_TYPE (coding
.id
), Qunix
))
4631 && ! CODING_REQUIRE_DECODING (&coding
))
4632 current_buffer
->buffer_file_type
= Qt
;
4634 current_buffer
->buffer_file_type
= Qnil
;
4641 if (!EQ (current_buffer
->undo_list
, Qt
) && !nochange
)
4642 current_buffer
->undo_list
= Qnil
;
4646 current_buffer
->modtime
= st
.st_mtime
;
4647 current_buffer
->filename
= orig_filename
;
4650 SAVE_MODIFF
= MODIFF
;
4651 current_buffer
->auto_save_modified
= MODIFF
;
4652 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4653 #ifdef CLASH_DETECTION
4656 if (!NILP (current_buffer
->file_truename
))
4657 unlock_file (current_buffer
->file_truename
);
4658 unlock_file (filename
);
4660 #endif /* CLASH_DETECTION */
4662 xsignal2 (Qfile_error
,
4663 build_string ("not a regular file"), orig_filename
);
4666 if (set_coding_system
)
4667 Vlast_coding_system_used
= coding_system
;
4669 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4671 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4673 if (! NILP (insval
))
4675 CHECK_NUMBER (insval
);
4676 inserted
= XFASTINT (insval
);
4680 /* Decode file format */
4683 /* Don't run point motion or modification hooks when decoding. */
4684 int count
= SPECPDL_INDEX ();
4685 specbind (Qinhibit_point_motion_hooks
, Qt
);
4686 specbind (Qinhibit_modification_hooks
, Qt
);
4688 /* Save old undo list and don't record undo for decoding. */
4689 old_undo
= current_buffer
->undo_list
;
4690 current_buffer
->undo_list
= Qt
;
4694 insval
= call3 (Qformat_decode
,
4695 Qnil
, make_number (inserted
), visit
);
4696 CHECK_NUMBER (insval
);
4697 inserted
= XFASTINT (insval
);
4701 /* If REPLACE is non-nil and we succeeded in not replacing the
4702 beginning or end of the buffer text with the file's contents,
4703 call format-decode with `point' positioned at the beginning of
4704 the buffer and `inserted' equalling the number of characters
4705 in the buffer. Otherwise, format-decode might fail to
4706 correctly analyze the beginning or end of the buffer. Hence
4707 we temporarily save `point' and `inserted' here and restore
4708 `point' iff format-decode did not insert or delete any text.
4709 Otherwise we leave `point' at point-min. */
4711 int opoint_byte
= PT_BYTE
;
4712 int oinserted
= ZV
- BEGV
;
4713 int ochars_modiff
= CHARS_MODIFF
;
4715 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4716 insval
= call3 (Qformat_decode
,
4717 Qnil
, make_number (oinserted
), visit
);
4718 CHECK_NUMBER (insval
);
4719 if (ochars_modiff
== CHARS_MODIFF
)
4720 /* format_decode didn't modify buffer's characters => move
4721 point back to position before inserted text and leave
4722 value of inserted alone. */
4723 SET_PT_BOTH (opoint
, opoint_byte
);
4725 /* format_decode modified buffer's characters => consider
4726 entire buffer changed and leave point at point-min. */
4727 inserted
= XFASTINT (insval
);
4730 /* For consistency with format-decode call these now iff inserted > 0
4731 (martin 2007-06-28) */
4732 p
= Vafter_insert_file_functions
;
4737 insval
= call1 (XCAR (p
), make_number (inserted
));
4740 CHECK_NUMBER (insval
);
4741 inserted
= XFASTINT (insval
);
4746 /* For the rationale of this see the comment on format-decode above. */
4748 int opoint_byte
= PT_BYTE
;
4749 int oinserted
= ZV
- BEGV
;
4750 int ochars_modiff
= CHARS_MODIFF
;
4752 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4753 insval
= call1 (XCAR (p
), make_number (oinserted
));
4756 CHECK_NUMBER (insval
);
4757 if (ochars_modiff
== CHARS_MODIFF
)
4758 /* after_insert_file_functions didn't modify
4759 buffer's characters => move point back to
4760 position before inserted text and leave value of
4762 SET_PT_BOTH (opoint
, opoint_byte
);
4764 /* after_insert_file_functions did modify buffer's
4765 characters => consider entire buffer changed and
4766 leave point at point-min. */
4767 inserted
= XFASTINT (insval
);
4777 Lisp_Object lbeg
, lend
;
4779 XSETINT (lend
, PT
+ inserted
);
4780 if (CONSP (old_undo
))
4782 Lisp_Object tem
= XCAR (old_undo
);
4783 if (CONSP (tem
) && INTEGERP (XCAR (tem
)) &&
4784 INTEGERP (XCDR (tem
)) && EQ (XCAR (tem
), lbeg
))
4785 /* In the non-visiting case record only the final insertion. */
4786 current_buffer
->undo_list
=
4787 Fcons (Fcons (lbeg
, lend
), Fcdr (old_undo
));
4791 /* If undo_list was Qt before, keep it that way.
4792 Otherwise start with an empty undo_list. */
4793 current_buffer
->undo_list
= EQ (old_undo
, Qt
) ? Qt
: Qnil
;
4795 unbind_to (count
, Qnil
);
4798 /* Call after-change hooks for the inserted text, aside from the case
4799 of normal visiting (not with REPLACE), which is done in a new buffer
4800 "before" the buffer is changed. */
4801 if (inserted
> 0 && total
> 0
4802 && (NILP (visit
) || !NILP (replace
)))
4804 signal_after_change (PT
, 0, inserted
);
4805 update_compositions (PT
, PT
, CHECK_BORDER
);
4809 && current_buffer
->modtime
== -1)
4811 /* If visiting nonexistent file, return nil. */
4812 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4816 Fsignal (Qquit
, Qnil
);
4818 /* ??? Retval needs to be dealt with in all cases consistently. */
4820 val
= Fcons (orig_filename
,
4821 Fcons (make_number (inserted
),
4824 RETURN_UNGCPRO (unbind_to (count
, val
));
4827 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4829 /* If build_annotations switched buffers, switch back to BUF.
4830 Kill the temporary buffer that was selected in the meantime.
4832 Since this kill only the last temporary buffer, some buffers remain
4833 not killed if build_annotations switched buffers more than once.
4837 build_annotations_unwind (buf
)
4842 if (XBUFFER (buf
) == current_buffer
)
4844 tembuf
= Fcurrent_buffer ();
4846 Fkill_buffer (tembuf
);
4850 /* Decide the coding-system to encode the data with. */
4853 choose_write_coding_system (start
, end
, filename
,
4854 append
, visit
, lockname
, coding
)
4855 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4856 struct coding_system
*coding
;
4859 Lisp_Object eol_parent
= Qnil
;
4862 && NILP (Fstring_equal (current_buffer
->filename
,
4863 current_buffer
->auto_save_file_name
)))
4868 else if (!NILP (Vcoding_system_for_write
))
4870 val
= Vcoding_system_for_write
;
4871 if (coding_system_require_warning
4872 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4873 /* Confirm that VAL can surely encode the current region. */
4874 val
= call5 (Vselect_safe_coding_system_function
,
4875 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4880 /* If the variable `buffer-file-coding-system' is set locally,
4881 it means that the file was read with some kind of code
4882 conversion or the variable is explicitly set by users. We
4883 had better write it out with the same coding system even if
4884 `enable-multibyte-characters' is nil.
4886 If it is not set locally, we anyway have to convert EOL
4887 format if the default value of `buffer-file-coding-system'
4888 tells that it is not Unix-like (LF only) format. */
4889 int using_default_coding
= 0;
4890 int force_raw_text
= 0;
4892 val
= current_buffer
->buffer_file_coding_system
;
4894 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4897 if (NILP (current_buffer
->enable_multibyte_characters
))
4903 /* Check file-coding-system-alist. */
4904 Lisp_Object args
[7], coding_systems
;
4906 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4907 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4909 coding_systems
= Ffind_operation_coding_system (7, args
);
4910 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4911 val
= XCDR (coding_systems
);
4916 /* If we still have not decided a coding system, use the
4917 default value of buffer-file-coding-system. */
4918 val
= current_buffer
->buffer_file_coding_system
;
4919 using_default_coding
= 1;
4922 if (! NILP (val
) && ! force_raw_text
)
4924 Lisp_Object spec
, attrs
;
4926 CHECK_CODING_SYSTEM_GET_SPEC (val
, spec
);
4927 attrs
= AREF (spec
, 0);
4928 if (EQ (CODING_ATTR_TYPE (attrs
), Qraw_text
))
4933 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4934 /* Confirm that VAL can surely encode the current region. */
4935 val
= call5 (Vselect_safe_coding_system_function
,
4936 start
, end
, val
, Qnil
, filename
);
4938 /* If the decided coding-system doesn't specify end-of-line
4939 format, we use that of
4940 `default-buffer-file-coding-system'. */
4941 if (! using_default_coding
4942 && ! NILP (buffer_defaults
.buffer_file_coding_system
))
4943 val
= (coding_inherit_eol_type
4944 (val
, buffer_defaults
.buffer_file_coding_system
));
4946 /* If we decide not to encode text, use `raw-text' or one of its
4949 val
= raw_text_coding_system (val
);
4952 val
= coding_inherit_eol_type (val
, eol_parent
);
4953 setup_coding_system (val
, coding
);
4955 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4956 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4960 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4961 "r\nFWrite region to file: \ni\ni\ni\np",
4962 doc
: /* Write current region into specified file.
4963 When called from a program, requires three arguments:
4964 START, END and FILENAME. START and END are normally buffer positions
4965 specifying the part of the buffer to write.
4966 If START is nil, that means to use the entire buffer contents.
4967 If START is a string, then output that string to the file
4968 instead of any buffer contents; END is ignored.
4970 Optional fourth argument APPEND if non-nil means
4971 append to existing file contents (if any). If it is an integer,
4972 seek to that offset in the file before writing.
4973 Optional fifth argument VISIT, if t or a string, means
4974 set the last-save-file-modtime of buffer to this file's modtime
4975 and mark buffer not modified.
4976 If VISIT is a string, it is a second file name;
4977 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4978 VISIT is also the file name to lock and unlock for clash detection.
4979 If VISIT is neither t nor nil nor a string,
4980 that means do not display the \"Wrote file\" message.
4981 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4982 use for locking and unlocking, overriding FILENAME and VISIT.
4983 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4984 for an existing file with the same name. If MUSTBENEW is `excl',
4985 that means to get an error if the file already exists; never overwrite.
4986 If MUSTBENEW is neither nil nor `excl', that means ask for
4987 confirmation before overwriting, but do go ahead and overwrite the file
4988 if the user confirms.
4990 This does code conversion according to the value of
4991 `coding-system-for-write', `buffer-file-coding-system', or
4992 `file-coding-system-alist', and sets the variable
4993 `last-coding-system-used' to the coding system actually used. */)
4994 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4995 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
5000 const unsigned char *fn
;
5002 int count
= SPECPDL_INDEX ();
5005 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
5007 Lisp_Object handler
;
5008 Lisp_Object visit_file
;
5009 Lisp_Object annotations
;
5010 Lisp_Object encoded_filename
;
5011 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
5012 int quietly
= !NILP (visit
);
5013 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5014 struct buffer
*given_buffer
;
5016 int buffer_file_type
= O_BINARY
;
5018 struct coding_system coding
;
5020 if (current_buffer
->base_buffer
&& visiting
)
5021 error ("Cannot do file visiting in an indirect buffer");
5023 if (!NILP (start
) && !STRINGP (start
))
5024 validate_region (&start
, &end
);
5027 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
5029 filename
= Fexpand_file_name (filename
, Qnil
);
5031 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
5032 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
5034 if (STRINGP (visit
))
5035 visit_file
= Fexpand_file_name (visit
, Qnil
);
5037 visit_file
= filename
;
5039 if (NILP (lockname
))
5040 lockname
= visit_file
;
5044 /* If the file name has special constructs in it,
5045 call the corresponding file handler. */
5046 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
5047 /* If FILENAME has no handler, see if VISIT has one. */
5048 if (NILP (handler
) && STRINGP (visit
))
5049 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
5051 if (!NILP (handler
))
5054 val
= call6 (handler
, Qwrite_region
, start
, end
,
5055 filename
, append
, visit
);
5059 SAVE_MODIFF
= MODIFF
;
5060 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5061 current_buffer
->filename
= visit_file
;
5067 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
5069 /* Special kludge to simplify auto-saving. */
5072 /* Do it later, so write-region-annotate-function can work differently
5073 if we save "the buffer" vs "a region".
5074 This is useful in tar-mode. --Stef
5075 XSETFASTINT (start, BEG);
5076 XSETFASTINT (end, Z); */
5080 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
5081 count1
= SPECPDL_INDEX ();
5083 given_buffer
= current_buffer
;
5085 if (!STRINGP (start
))
5087 annotations
= build_annotations (start
, end
);
5089 if (current_buffer
!= given_buffer
)
5091 XSETFASTINT (start
, BEGV
);
5092 XSETFASTINT (end
, ZV
);
5098 XSETFASTINT (start
, BEGV
);
5099 XSETFASTINT (end
, ZV
);
5104 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
5106 /* Decide the coding-system to encode the data with.
5107 We used to make this choice before calling build_annotations, but that
5108 leads to problems when a write-annotate-function takes care of
5109 unsavable chars (as was the case with X-Symbol). */
5110 Vlast_coding_system_used
5111 = choose_write_coding_system (start
, end
, filename
,
5112 append
, visit
, lockname
, &coding
);
5114 #ifdef CLASH_DETECTION
5117 #if 0 /* This causes trouble for GNUS. */
5118 /* If we've locked this file for some other buffer,
5119 query before proceeding. */
5120 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5121 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5124 lock_file (lockname
);
5126 #endif /* CLASH_DETECTION */
5128 encoded_filename
= ENCODE_FILE (filename
);
5130 fn
= SDATA (encoded_filename
);
5134 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5135 #else /* not DOS_NT */
5136 desc
= emacs_open (fn
, O_WRONLY
, 0);
5137 #endif /* not DOS_NT */
5139 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5141 if (auto_saving
) /* Overwrite any previous version of autosave file */
5143 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5144 desc
= emacs_open (fn
, O_RDWR
, 0);
5146 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5147 ? SDATA (current_buffer
->filename
) : 0,
5150 else /* Write to temporary name and rename if no errors */
5152 Lisp_Object temp_name
;
5153 temp_name
= Ffile_name_directory (filename
);
5155 if (!NILP (temp_name
))
5157 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5158 build_string ("$$SAVE$$")));
5159 fname
= SDATA (filename
);
5160 fn
= SDATA (temp_name
);
5161 desc
= creat_copy_attrs (fname
, fn
);
5164 /* If we can't open the temporary file, try creating a new
5165 version of the original file. VMS "creat" creates a
5166 new version rather than truncating an existing file. */
5169 desc
= creat (fn
, 0666);
5170 #if 0 /* This can clobber an existing file and fail to replace it,
5171 if the user runs out of space. */
5174 /* We can't make a new version;
5175 try to truncate and rewrite existing version if any. */
5177 desc
= emacs_open (fn
, O_RDWR
, 0);
5183 desc
= creat (fn
, 0666);
5187 desc
= emacs_open (fn
,
5188 O_WRONLY
| O_CREAT
| buffer_file_type
5189 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5190 S_IREAD
| S_IWRITE
);
5191 #else /* not DOS_NT */
5192 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5193 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5194 auto_saving
? auto_save_mode_bits
: 0666);
5195 #endif /* not DOS_NT */
5196 #endif /* not VMS */
5200 #ifdef CLASH_DETECTION
5202 if (!auto_saving
) unlock_file (lockname
);
5204 #endif /* CLASH_DETECTION */
5206 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5209 record_unwind_protect (close_file_unwind
, make_number (desc
));
5211 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5215 if (NUMBERP (append
))
5216 ret
= lseek (desc
, XINT (append
), 1);
5218 ret
= lseek (desc
, 0, 2);
5221 #ifdef CLASH_DETECTION
5222 if (!auto_saving
) unlock_file (lockname
);
5223 #endif /* CLASH_DETECTION */
5225 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5233 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5234 * if we do writes that don't end with a carriage return. Furthermore
5235 * it cannot handle writes of more then 16K. The modified
5236 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5237 * this EXCEPT for the last record (if it doesn't end with a carriage
5238 * return). This implies that if your buffer doesn't end with a carriage
5239 * return, you get one free... tough. However it also means that if
5240 * we make two calls to sys_write (a la the following code) you can
5241 * get one at the gap as well. The easiest way to fix this (honest)
5242 * is to move the gap to the next newline (or the end of the buffer).
5247 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5248 move_gap (find_next_newline (GPT
, 1));
5251 /* The new encoding routine doesn't require the following. */
5253 /* Whether VMS or not, we must move the gap to the next of newline
5254 when we must put designation sequences at beginning of line. */
5255 if (INTEGERP (start
)
5256 && coding
.type
== coding_type_iso2022
5257 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5258 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5260 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5261 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5262 move_gap_both (PT
, PT_BYTE
);
5263 SET_PT_BOTH (opoint
, opoint_byte
);
5271 if (STRINGP (start
))
5273 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5274 &annotations
, &coding
);
5277 else if (XINT (start
) != XINT (end
))
5279 failure
= 0 > a_write (desc
, Qnil
,
5280 XINT (start
), XINT (end
) - XINT (start
),
5281 &annotations
, &coding
);
5286 /* If file was empty, still need to write the annotations */
5287 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5288 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5292 if (CODING_REQUIRE_FLUSHING (&coding
)
5293 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5296 /* We have to flush out a data. */
5297 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5298 failure
= 0 > e_write (desc
, Qnil
, 1, 1, &coding
);
5305 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5306 Disk full in NFS may be reported here. */
5307 /* mib says that closing the file will try to write as fast as NFS can do
5308 it, and that means the fsync here is not crucial for autosave files. */
5309 if (!auto_saving
&& !write_region_inhibit_fsync
&& fsync (desc
) < 0)
5311 /* If fsync fails with EINTR, don't treat that as serious. Also
5312 ignore EINVAL which happens when fsync is not supported on this
5314 if (errno
!= EINTR
&& errno
!= EINVAL
)
5315 failure
= 1, save_errno
= errno
;
5319 /* Spurious "file has changed on disk" warnings have been
5320 observed on Suns as well.
5321 It seems that `close' can change the modtime, under nfs.
5323 (This has supposedly been fixed in Sunos 4,
5324 but who knows about all the other machines with NFS?) */
5327 /* On VMS, must do the stat after the close
5328 since closing changes the modtime. */
5330 /* Recall that #if defined does not work on VMS. */
5336 /* NFS can report a write failure now. */
5337 if (emacs_close (desc
) < 0)
5338 failure
= 1, save_errno
= errno
;
5341 /* If we wrote to a temporary name and had no errors, rename to real name. */
5345 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5353 /* Discard the unwind protect for close_file_unwind. */
5354 specpdl_ptr
= specpdl
+ count1
;
5355 /* Restore the original current buffer. */
5356 visit_file
= unbind_to (count
, visit_file
);
5358 #ifdef CLASH_DETECTION
5360 unlock_file (lockname
);
5361 #endif /* CLASH_DETECTION */
5363 /* Do this before reporting IO error
5364 to avoid a "file has changed on disk" warning on
5365 next attempt to save. */
5367 current_buffer
->modtime
= st
.st_mtime
;
5370 error ("IO error writing %s: %s", SDATA (filename
),
5371 emacs_strerror (save_errno
));
5375 SAVE_MODIFF
= MODIFF
;
5376 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5377 current_buffer
->filename
= visit_file
;
5378 update_mode_lines
++;
5383 && ! NILP (Fstring_equal (current_buffer
->filename
,
5384 current_buffer
->auto_save_file_name
)))
5385 SAVE_MODIFF
= MODIFF
;
5391 message_with_string ((INTEGERP (append
)
5401 Lisp_Object
merge ();
5403 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5404 doc
: /* Return t if (car A) is numerically less than (car B). */)
5408 return Flss (Fcar (a
), Fcar (b
));
5411 /* Build the complete list of annotations appropriate for writing out
5412 the text between START and END, by calling all the functions in
5413 write-region-annotate-functions and merging the lists they return.
5414 If one of these functions switches to a different buffer, we assume
5415 that buffer contains altered text. Therefore, the caller must
5416 make sure to restore the current buffer in all cases,
5417 as save-excursion would do. */
5420 build_annotations (start
, end
)
5421 Lisp_Object start
, end
;
5423 Lisp_Object annotations
;
5425 struct gcpro gcpro1
, gcpro2
;
5426 Lisp_Object original_buffer
;
5427 int i
, used_global
= 0;
5429 XSETBUFFER (original_buffer
, current_buffer
);
5432 p
= Vwrite_region_annotate_functions
;
5433 GCPRO2 (annotations
, p
);
5436 struct buffer
*given_buffer
= current_buffer
;
5437 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5438 { /* Use the global value of the hook. */
5441 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5443 p
= Fappend (2, arg
);
5446 Vwrite_region_annotations_so_far
= annotations
;
5447 res
= call2 (XCAR (p
), start
, end
);
5448 /* If the function makes a different buffer current,
5449 assume that means this buffer contains altered text to be output.
5450 Reset START and END from the buffer bounds
5451 and discard all previous annotations because they should have
5452 been dealt with by this function. */
5453 if (current_buffer
!= given_buffer
)
5455 XSETFASTINT (start
, BEGV
);
5456 XSETFASTINT (end
, ZV
);
5459 Flength (res
); /* Check basic validity of return value */
5460 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5464 /* Now do the same for annotation functions implied by the file-format */
5465 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
5466 p
= current_buffer
->auto_save_file_format
;
5468 p
= current_buffer
->file_format
;
5469 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5471 struct buffer
*given_buffer
= current_buffer
;
5473 Vwrite_region_annotations_so_far
= annotations
;
5475 /* Value is either a list of annotations or nil if the function
5476 has written annotations to a temporary buffer, which is now
5478 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5479 original_buffer
, make_number (i
));
5480 if (current_buffer
!= given_buffer
)
5482 XSETFASTINT (start
, BEGV
);
5483 XSETFASTINT (end
, ZV
);
5488 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5496 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5497 If STRING is nil, POS is the character position in the current buffer.
5498 Intersperse with them the annotations from *ANNOT
5499 which fall within the range of POS to POS + NCHARS,
5500 each at its appropriate position.
5502 We modify *ANNOT by discarding elements as we use them up.
5504 The return value is negative in case of system call failure. */
5507 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5510 register int nchars
;
5513 struct coding_system
*coding
;
5517 int lastpos
= pos
+ nchars
;
5519 while (NILP (*annot
) || CONSP (*annot
))
5521 tem
= Fcar_safe (Fcar (*annot
));
5524 nextpos
= XFASTINT (tem
);
5526 /* If there are no more annotations in this range,
5527 output the rest of the range all at once. */
5528 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5529 return e_write (desc
, string
, pos
, lastpos
, coding
);
5531 /* Output buffer text up to the next annotation's position. */
5534 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5538 /* Output the annotation. */
5539 tem
= Fcdr (Fcar (*annot
));
5542 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5545 *annot
= Fcdr (*annot
);
5551 /* Write text in the range START and END into descriptor DESC,
5552 encoding them with coding system CODING. If STRING is nil, START
5553 and END are character positions of the current buffer, else they
5554 are indexes to the string STRING. */
5557 e_write (desc
, string
, start
, end
, coding
)
5561 struct coding_system
*coding
;
5563 if (STRINGP (string
))
5566 end
= SCHARS (string
);
5569 /* We used to have a code for handling selective display here. But,
5570 now it is handled within encode_coding. */
5574 if (STRINGP (string
))
5576 coding
->src_multibyte
= SCHARS (string
) < SBYTES (string
);
5577 if (CODING_REQUIRE_ENCODING (coding
))
5579 encode_coding_object (coding
, string
,
5580 start
, string_char_to_byte (string
, start
),
5581 end
, string_char_to_byte (string
, end
), Qt
);
5585 coding
->dst_object
= string
;
5586 coding
->consumed_char
= SCHARS (string
);
5587 coding
->produced
= SBYTES (string
);
5592 int start_byte
= CHAR_TO_BYTE (start
);
5593 int end_byte
= CHAR_TO_BYTE (end
);
5595 coding
->src_multibyte
= (end
- start
) < (end_byte
- start_byte
);
5596 if (CODING_REQUIRE_ENCODING (coding
))
5598 encode_coding_object (coding
, Fcurrent_buffer (),
5599 start
, start_byte
, end
, end_byte
, Qt
);
5603 coding
->dst_object
= Qnil
;
5604 coding
->dst_pos_byte
= start_byte
;
5605 if (start
>= GPT
|| end
<= GPT
)
5607 coding
->consumed_char
= end
- start
;
5608 coding
->produced
= end_byte
- start_byte
;
5612 coding
->consumed_char
= GPT
- start
;
5613 coding
->produced
= GPT_BYTE
- start_byte
;
5618 if (coding
->produced
> 0)
5622 STRINGP (coding
->dst_object
)
5623 ? SDATA (coding
->dst_object
)
5624 : BYTE_POS_ADDR (coding
->dst_pos_byte
),
5627 if (coding
->produced
)
5630 start
+= coding
->consumed_char
;
5636 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5637 Sverify_visited_file_modtime
, 1, 1, 0,
5638 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5639 This means that the file has not been changed since it was visited or saved.
5640 See Info node `(elisp)Modification Time' for more details. */)
5646 Lisp_Object handler
;
5647 Lisp_Object filename
;
5652 if (!STRINGP (b
->filename
)) return Qt
;
5653 if (b
->modtime
== 0) return Qt
;
5655 /* If the file name has special constructs in it,
5656 call the corresponding file handler. */
5657 handler
= Ffind_file_name_handler (b
->filename
,
5658 Qverify_visited_file_modtime
);
5659 if (!NILP (handler
))
5660 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5662 filename
= ENCODE_FILE (b
->filename
);
5664 if (stat (SDATA (filename
), &st
) < 0)
5666 /* If the file doesn't exist now and didn't exist before,
5667 we say that it isn't modified, provided the error is a tame one. */
5668 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5673 if (st
.st_mtime
== b
->modtime
5674 /* If both are positive, accept them if they are off by one second. */
5675 || (st
.st_mtime
> 0 && b
->modtime
> 0
5676 && (st
.st_mtime
== b
->modtime
+ 1
5677 || st
.st_mtime
== b
->modtime
- 1)))
5682 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5683 Sclear_visited_file_modtime
, 0, 0, 0,
5684 doc
: /* Clear out records of last mod time of visited file.
5685 Next attempt to save will certainly not complain of a discrepancy. */)
5688 current_buffer
->modtime
= 0;
5692 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5693 Svisited_file_modtime
, 0, 0, 0,
5694 doc
: /* Return the current buffer's recorded visited file modification time.
5695 The value is a list of the form (HIGH LOW), like the time values
5696 that `file-attributes' returns. If the current buffer has no recorded
5697 file modification time, this function returns 0.
5698 See Info node `(elisp)Modification Time' for more details. */)
5701 if (! current_buffer
->modtime
)
5702 return make_number (0);
5703 return make_time ((time_t) current_buffer
->modtime
);
5706 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5707 Sset_visited_file_modtime
, 0, 1, 0,
5708 doc
: /* Update buffer's recorded modification time from the visited file's time.
5709 Useful if the buffer was not read from the file normally
5710 or if the file itself has been changed for some known benign reason.
5711 An argument specifies the modification time value to use
5712 \(instead of that of the visited file), in the form of a list
5713 \(HIGH . LOW) or (HIGH LOW). */)
5715 Lisp_Object time_list
;
5717 if (!NILP (time_list
))
5718 current_buffer
->modtime
= cons_to_long (time_list
);
5721 register Lisp_Object filename
;
5723 Lisp_Object handler
;
5725 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5727 /* If the file name has special constructs in it,
5728 call the corresponding file handler. */
5729 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5730 if (!NILP (handler
))
5731 /* The handler can find the file name the same way we did. */
5732 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5734 filename
= ENCODE_FILE (filename
);
5736 if (stat (SDATA (filename
), &st
) >= 0)
5737 current_buffer
->modtime
= st
.st_mtime
;
5744 auto_save_error (error
)
5747 Lisp_Object args
[3], msg
;
5749 struct gcpro gcpro1
;
5753 auto_save_error_occurred
= 1;
5755 ring_bell (XFRAME (selected_frame
));
5757 args
[0] = build_string ("Auto-saving %s: %s");
5758 args
[1] = current_buffer
->name
;
5759 args
[2] = Ferror_message_string (error
);
5760 msg
= Fformat (3, args
);
5762 nbytes
= SBYTES (msg
);
5763 SAFE_ALLOCA (msgbuf
, char *, nbytes
);
5764 bcopy (SDATA (msg
), msgbuf
, nbytes
);
5766 for (i
= 0; i
< 3; ++i
)
5769 message2 (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5771 message2_nolog (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5772 Fsleep_for (make_number (1), Qnil
);
5786 auto_save_mode_bits
= 0666;
5788 /* Get visited file's mode to become the auto save file's mode. */
5789 if (! NILP (current_buffer
->filename
))
5791 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5792 /* But make sure we can overwrite it later! */
5793 auto_save_mode_bits
= st
.st_mode
| 0600;
5794 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5796 /* Remote files don't cooperate with stat. */
5797 auto_save_mode_bits
= XINT (modes
) | 0600;
5801 Fwrite_region (Qnil
, Qnil
,
5802 current_buffer
->auto_save_file_name
,
5803 Qnil
, Qlambda
, Qnil
, Qnil
);
5807 do_auto_save_unwind (arg
) /* used as unwind-protect function */
5810 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
5822 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5825 minibuffer_auto_raise
= XINT (value
);
5830 do_auto_save_make_dir (dir
)
5835 call2 (Qmake_directory
, dir
, Qt
);
5836 XSETFASTINT (mode
, 0700);
5837 return Fset_file_modes (dir
, mode
);
5841 do_auto_save_eh (ignore
)
5847 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5848 doc
: /* Auto-save all buffers that need it.
5849 This is all buffers that have auto-saving enabled
5850 and are changed since last auto-saved.
5851 Auto-saving writes the buffer into a file
5852 so that your editing is not lost if the system crashes.
5853 This file is not the file you visited; that changes only when you save.
5854 Normally we run the normal hook `auto-save-hook' before saving.
5856 A non-nil NO-MESSAGE argument means do not print any message if successful.
5857 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5858 (no_message
, current_only
)
5859 Lisp_Object no_message
, current_only
;
5861 struct buffer
*old
= current_buffer
, *b
;
5862 Lisp_Object tail
, buf
;
5864 int do_handled_files
;
5866 FILE *stream
= NULL
;
5867 int count
= SPECPDL_INDEX ();
5868 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5869 int old_message_p
= 0;
5870 struct gcpro gcpro1
, gcpro2
;
5872 if (max_specpdl_size
< specpdl_size
+ 40)
5873 max_specpdl_size
= specpdl_size
+ 40;
5878 if (NILP (no_message
))
5880 old_message_p
= push_message ();
5881 record_unwind_protect (pop_message_unwind
, Qnil
);
5884 /* Ordinarily don't quit within this function,
5885 but don't make it impossible to quit (in case we get hung in I/O). */
5889 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5890 point to non-strings reached from Vbuffer_alist. */
5892 if (!NILP (Vrun_hooks
))
5893 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5895 if (STRINGP (Vauto_save_list_file_name
))
5897 Lisp_Object listfile
;
5899 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5901 /* Don't try to create the directory when shutting down Emacs,
5902 because creating the directory might signal an error, and
5903 that would leave Emacs in a strange state. */
5904 if (!NILP (Vrun_hooks
))
5908 GCPRO2 (dir
, listfile
);
5909 dir
= Ffile_name_directory (listfile
);
5910 if (NILP (Ffile_directory_p (dir
)))
5911 internal_condition_case_1 (do_auto_save_make_dir
,
5912 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5917 stream
= fopen (SDATA (listfile
), "w");
5920 record_unwind_protect (do_auto_save_unwind
,
5921 make_save_value (stream
, 0));
5922 record_unwind_protect (do_auto_save_unwind_1
,
5923 make_number (minibuffer_auto_raise
));
5924 minibuffer_auto_raise
= 0;
5926 auto_save_error_occurred
= 0;
5928 /* On first pass, save all files that don't have handlers.
5929 On second pass, save all files that do have handlers.
5931 If Emacs is crashing, the handlers may tweak what is causing
5932 Emacs to crash in the first place, and it would be a shame if
5933 Emacs failed to autosave perfectly ordinary files because it
5934 couldn't handle some ange-ftp'd file. */
5936 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5937 for (tail
= Vbuffer_alist
; CONSP (tail
); tail
= XCDR (tail
))
5939 buf
= XCDR (XCAR (tail
));
5942 /* Record all the buffers that have auto save mode
5943 in the special file that lists them. For each of these buffers,
5944 Record visited name (if any) and auto save name. */
5945 if (STRINGP (b
->auto_save_file_name
)
5946 && stream
!= NULL
&& do_handled_files
== 0)
5949 if (!NILP (b
->filename
))
5951 fwrite (SDATA (b
->filename
), 1,
5952 SBYTES (b
->filename
), stream
);
5954 putc ('\n', stream
);
5955 fwrite (SDATA (b
->auto_save_file_name
), 1,
5956 SBYTES (b
->auto_save_file_name
), stream
);
5957 putc ('\n', stream
);
5961 if (!NILP (current_only
)
5962 && b
!= current_buffer
)
5965 /* Don't auto-save indirect buffers.
5966 The base buffer takes care of it. */
5970 /* Check for auto save enabled
5971 and file changed since last auto save
5972 and file changed since last real save. */
5973 if (STRINGP (b
->auto_save_file_name
)
5974 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5975 && b
->auto_save_modified
< BUF_MODIFF (b
)
5976 /* -1 means we've turned off autosaving for a while--see below. */
5977 && XINT (b
->save_length
) >= 0
5978 && (do_handled_files
5979 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5982 EMACS_TIME before_time
, after_time
;
5984 EMACS_GET_TIME (before_time
);
5986 /* If we had a failure, don't try again for 20 minutes. */
5987 if (b
->auto_save_failure_time
>= 0
5988 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5991 if ((XFASTINT (b
->save_length
) * 10
5992 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5993 /* A short file is likely to change a large fraction;
5994 spare the user annoying messages. */
5995 && XFASTINT (b
->save_length
) > 5000
5996 /* These messages are frequent and annoying for `*mail*'. */
5997 && !EQ (b
->filename
, Qnil
)
5998 && NILP (no_message
))
6000 /* It has shrunk too much; turn off auto-saving here. */
6001 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
6002 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
6004 minibuffer_auto_raise
= 0;
6005 /* Turn off auto-saving until there's a real save,
6006 and prevent any more warnings. */
6007 XSETINT (b
->save_length
, -1);
6008 Fsleep_for (make_number (1), Qnil
);
6011 set_buffer_internal (b
);
6012 if (!auto_saved
&& NILP (no_message
))
6013 message1 ("Auto-saving...");
6014 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
6016 b
->auto_save_modified
= BUF_MODIFF (b
);
6017 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6018 set_buffer_internal (old
);
6020 EMACS_GET_TIME (after_time
);
6022 /* If auto-save took more than 60 seconds,
6023 assume it was an NFS failure that got a timeout. */
6024 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
6025 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
6029 /* Prevent another auto save till enough input events come in. */
6030 record_auto_save ();
6032 if (auto_saved
&& NILP (no_message
))
6036 /* If we are going to restore an old message,
6037 give time to read ours. */
6038 sit_for (make_number (1), 0, 0);
6041 else if (!auto_save_error_occurred
)
6042 /* Don't overwrite the error message if an error occurred.
6043 If we displayed a message and then restored a state
6044 with no message, leave a "done" message on the screen. */
6045 message1 ("Auto-saving...done");
6050 /* This restores the message-stack status. */
6051 unbind_to (count
, Qnil
);
6055 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
6056 Sset_buffer_auto_saved
, 0, 0, 0,
6057 doc
: /* Mark current buffer as auto-saved with its current text.
6058 No auto-save file will be written until the buffer changes again. */)
6061 current_buffer
->auto_save_modified
= MODIFF
;
6062 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6063 current_buffer
->auto_save_failure_time
= -1;
6067 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
6068 Sclear_buffer_auto_save_failure
, 0, 0, 0,
6069 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
6072 current_buffer
->auto_save_failure_time
= -1;
6076 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6078 doc
: /* Return t if current buffer has been auto-saved recently.
6079 More precisely, if it has been auto-saved since last read from or saved
6080 in the visited file. If the buffer has no visited file,
6081 then any auto-save counts as "recent". */)
6084 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6087 /* Reading and completing file names */
6089 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
6090 Snext_read_file_uses_dialog_p
, 0, 0, 0,
6091 doc
: /* Return t if a call to `read-file-name' will use a dialog.
6092 The return value is only relevant for a call to `read-file-name' that happens
6093 before any other event (mouse or keypress) is handeled. */)
6096 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6097 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6107 Fread_file_name (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6108 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6110 struct gcpro gcpro1
, gcpro2
;
6111 Lisp_Object args
[7];
6113 GCPRO1 (default_filename
);
6114 args
[0] = intern ("read-file-name");
6117 args
[3] = default_filename
;
6118 args
[4] = mustmatch
;
6120 args
[6] = predicate
;
6121 RETURN_UNGCPRO (Ffuncall (7, args
));
6128 /* Must be set before any path manipulation is performed. */
6129 XSETFASTINT (Vdirectory_sep_char
, '/');
6136 Qoperations
= intern ("operations");
6137 Qexpand_file_name
= intern ("expand-file-name");
6138 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6139 Qdirectory_file_name
= intern ("directory-file-name");
6140 Qfile_name_directory
= intern ("file-name-directory");
6141 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6142 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6143 Qfile_name_as_directory
= intern ("file-name-as-directory");
6144 Qcopy_file
= intern ("copy-file");
6145 Qmake_directory_internal
= intern ("make-directory-internal");
6146 Qmake_directory
= intern ("make-directory");
6147 Qdelete_directory
= intern ("delete-directory");
6148 Qdelete_file
= intern ("delete-file");
6149 Qrename_file
= intern ("rename-file");
6150 Qadd_name_to_file
= intern ("add-name-to-file");
6151 Qmake_symbolic_link
= intern ("make-symbolic-link");
6152 Qfile_exists_p
= intern ("file-exists-p");
6153 Qfile_executable_p
= intern ("file-executable-p");
6154 Qfile_readable_p
= intern ("file-readable-p");
6155 Qfile_writable_p
= intern ("file-writable-p");
6156 Qfile_symlink_p
= intern ("file-symlink-p");
6157 Qaccess_file
= intern ("access-file");
6158 Qfile_directory_p
= intern ("file-directory-p");
6159 Qfile_regular_p
= intern ("file-regular-p");
6160 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6161 Qfile_modes
= intern ("file-modes");
6162 Qset_file_modes
= intern ("set-file-modes");
6163 Qset_file_times
= intern ("set-file-times");
6164 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6165 Qinsert_file_contents
= intern ("insert-file-contents");
6166 Qwrite_region
= intern ("write-region");
6167 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6168 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6169 Qauto_save_coding
= intern ("auto-save-coding");
6171 staticpro (&Qoperations
);
6172 staticpro (&Qexpand_file_name
);
6173 staticpro (&Qsubstitute_in_file_name
);
6174 staticpro (&Qdirectory_file_name
);
6175 staticpro (&Qfile_name_directory
);
6176 staticpro (&Qfile_name_nondirectory
);
6177 staticpro (&Qunhandled_file_name_directory
);
6178 staticpro (&Qfile_name_as_directory
);
6179 staticpro (&Qcopy_file
);
6180 staticpro (&Qmake_directory_internal
);
6181 staticpro (&Qmake_directory
);
6182 staticpro (&Qdelete_directory
);
6183 staticpro (&Qdelete_file
);
6184 staticpro (&Qrename_file
);
6185 staticpro (&Qadd_name_to_file
);
6186 staticpro (&Qmake_symbolic_link
);
6187 staticpro (&Qfile_exists_p
);
6188 staticpro (&Qfile_executable_p
);
6189 staticpro (&Qfile_readable_p
);
6190 staticpro (&Qfile_writable_p
);
6191 staticpro (&Qaccess_file
);
6192 staticpro (&Qfile_symlink_p
);
6193 staticpro (&Qfile_directory_p
);
6194 staticpro (&Qfile_regular_p
);
6195 staticpro (&Qfile_accessible_directory_p
);
6196 staticpro (&Qfile_modes
);
6197 staticpro (&Qset_file_modes
);
6198 staticpro (&Qset_file_times
);
6199 staticpro (&Qfile_newer_than_file_p
);
6200 staticpro (&Qinsert_file_contents
);
6201 staticpro (&Qwrite_region
);
6202 staticpro (&Qverify_visited_file_modtime
);
6203 staticpro (&Qset_visited_file_modtime
);
6204 staticpro (&Qauto_save_coding
);
6206 Qfile_name_history
= intern ("file-name-history");
6207 Fset (Qfile_name_history
, Qnil
);
6208 staticpro (&Qfile_name_history
);
6210 Qfile_error
= intern ("file-error");
6211 staticpro (&Qfile_error
);
6212 Qfile_already_exists
= intern ("file-already-exists");
6213 staticpro (&Qfile_already_exists
);
6214 Qfile_date_error
= intern ("file-date-error");
6215 staticpro (&Qfile_date_error
);
6216 Qexcl
= intern ("excl");
6220 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6221 staticpro (&Qfind_buffer_file_type
);
6224 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6225 doc
: /* *Coding system for encoding file names.
6226 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6227 Vfile_name_coding_system
= Qnil
;
6229 DEFVAR_LISP ("default-file-name-coding-system",
6230 &Vdefault_file_name_coding_system
,
6231 doc
: /* Default coding system for encoding file names.
6232 This variable is used only when `file-name-coding-system' is nil.
6234 This variable is set/changed by the command `set-language-environment'.
6235 User should not set this variable manually,
6236 instead use `file-name-coding-system' to get a constant encoding
6237 of file names regardless of the current language environment. */);
6238 Vdefault_file_name_coding_system
= Qnil
;
6240 Qformat_decode
= intern ("format-decode");
6241 staticpro (&Qformat_decode
);
6242 Qformat_annotate_function
= intern ("format-annotate-function");
6243 staticpro (&Qformat_annotate_function
);
6244 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6245 staticpro (&Qafter_insert_file_set_coding
);
6247 Qcar_less_than_car
= intern ("car-less-than-car");
6248 staticpro (&Qcar_less_than_car
);
6250 Fput (Qfile_error
, Qerror_conditions
,
6251 list2 (Qfile_error
, Qerror
));
6252 Fput (Qfile_error
, Qerror_message
,
6253 build_string ("File error"));
6255 Fput (Qfile_already_exists
, Qerror_conditions
,
6256 list3 (Qfile_already_exists
, Qfile_error
, Qerror
));
6257 Fput (Qfile_already_exists
, Qerror_message
,
6258 build_string ("File already exists"));
6260 Fput (Qfile_date_error
, Qerror_conditions
,
6261 list3 (Qfile_date_error
, Qfile_error
, Qerror
));
6262 Fput (Qfile_date_error
, Qerror_message
,
6263 build_string ("Cannot set file date"));
6265 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6266 doc
: /* *Non-nil means write new files with record format `stmlf'.
6267 nil means use format `var'. This variable is meaningful only on VMS. */);
6268 vms_stmlf_recfm
= 0;
6270 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6271 doc
: /* Directory separator character for built-in functions that return file names.
6272 The value is always ?/. Don't use this variable, just use `/'. */);
6274 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6275 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6276 If a file name matches REGEXP, then all I/O on that file is done by calling
6279 The first argument given to HANDLER is the name of the I/O primitive
6280 to be handled; the remaining arguments are the arguments that were
6281 passed to that primitive. For example, if you do
6282 (file-exists-p FILENAME)
6283 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6284 (funcall HANDLER 'file-exists-p FILENAME)
6285 The function `find-file-name-handler' checks this list for a handler
6286 for its argument. */);
6287 Vfile_name_handler_alist
= Qnil
;
6289 DEFVAR_LISP ("set-auto-coding-function",
6290 &Vset_auto_coding_function
,
6291 doc
: /* If non-nil, a function to call to decide a coding system of file.
6292 Two arguments are passed to this function: the file name
6293 and the length of a file contents following the point.
6294 This function should return a coding system to decode the file contents.
6295 It should check the file name against `auto-coding-alist'.
6296 If no coding system is decided, it should check a coding system
6297 specified in the heading lines with the format:
6298 -*- ... coding: CODING-SYSTEM; ... -*-
6299 or local variable spec of the tailing lines with `coding:' tag. */);
6300 Vset_auto_coding_function
= Qnil
;
6302 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6303 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6304 Each is passed one argument, the number of characters inserted,
6305 with point at the start of the inserted text. Each function
6306 should leave point the same, and return the new character count.
6307 If `insert-file-contents' is intercepted by a handler from
6308 `file-name-handler-alist', that handler is responsible for calling the
6309 functions in `after-insert-file-functions' if appropriate. */);
6310 Vafter_insert_file_functions
= Qnil
;
6312 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6313 doc
: /* A list of functions to be called at the start of `write-region'.
6314 Each is passed two arguments, START and END as for `write-region'.
6315 These are usually two numbers but not always; see the documentation
6316 for `write-region'. The function should return a list of pairs
6317 of the form (POSITION . STRING), consisting of strings to be effectively
6318 inserted at the specified positions of the file being written (1 means to
6319 insert before the first byte written). The POSITIONs must be sorted into
6320 increasing order. If there are several functions in the list, the several
6321 lists are merged destructively. Alternatively, the function can return
6322 with a different buffer current; in that case it should pay attention
6323 to the annotations returned by previous functions and listed in
6324 `write-region-annotations-so-far'.*/);
6325 Vwrite_region_annotate_functions
= Qnil
;
6326 staticpro (&Qwrite_region_annotate_functions
);
6327 Qwrite_region_annotate_functions
6328 = intern ("write-region-annotate-functions");
6330 DEFVAR_LISP ("write-region-annotations-so-far",
6331 &Vwrite_region_annotations_so_far
,
6332 doc
: /* When an annotation function is called, this holds the previous annotations.
6333 These are the annotations made by other annotation functions
6334 that were already called. See also `write-region-annotate-functions'. */);
6335 Vwrite_region_annotations_so_far
= Qnil
;
6337 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6338 doc
: /* A list of file name handlers that temporarily should not be used.
6339 This applies only to the operation `inhibit-file-name-operation'. */);
6340 Vinhibit_file_name_handlers
= Qnil
;
6342 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6343 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6344 Vinhibit_file_name_operation
= Qnil
;
6346 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6347 doc
: /* File name in which we write a list of all auto save file names.
6348 This variable is initialized automatically from `auto-save-list-file-prefix'
6349 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6350 a non-nil value. */);
6351 Vauto_save_list_file_name
= Qnil
;
6354 DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync
,
6355 doc
: /* *Non-nil means don't call fsync in `write-region'.
6356 This variable affects calls to `write-region' as well as save commands.
6357 A non-nil value may result in data loss! */);
6358 write_region_inhibit_fsync
= 0;
6361 defsubr (&Sfind_file_name_handler
);
6362 defsubr (&Sfile_name_directory
);
6363 defsubr (&Sfile_name_nondirectory
);
6364 defsubr (&Sunhandled_file_name_directory
);
6365 defsubr (&Sfile_name_as_directory
);
6366 defsubr (&Sdirectory_file_name
);
6367 defsubr (&Smake_temp_name
);
6368 defsubr (&Sexpand_file_name
);
6369 defsubr (&Ssubstitute_in_file_name
);
6370 defsubr (&Scopy_file
);
6371 defsubr (&Smake_directory_internal
);
6372 defsubr (&Sdelete_directory
);
6373 defsubr (&Sdelete_file
);
6374 defsubr (&Srename_file
);
6375 defsubr (&Sadd_name_to_file
);
6376 defsubr (&Smake_symbolic_link
);
6378 defsubr (&Sdefine_logical_name
);
6381 defsubr (&Ssysnetunam
);
6382 #endif /* HPUX_NET */
6383 defsubr (&Sfile_name_absolute_p
);
6384 defsubr (&Sfile_exists_p
);
6385 defsubr (&Sfile_executable_p
);
6386 defsubr (&Sfile_readable_p
);
6387 defsubr (&Sfile_writable_p
);
6388 defsubr (&Saccess_file
);
6389 defsubr (&Sfile_symlink_p
);
6390 defsubr (&Sfile_directory_p
);
6391 defsubr (&Sfile_accessible_directory_p
);
6392 defsubr (&Sfile_regular_p
);
6393 defsubr (&Sfile_modes
);
6394 defsubr (&Sset_file_modes
);
6395 defsubr (&Sset_file_times
);
6396 defsubr (&Sset_default_file_modes
);
6397 defsubr (&Sdefault_file_modes
);
6398 defsubr (&Sfile_newer_than_file_p
);
6399 defsubr (&Sinsert_file_contents
);
6400 defsubr (&Swrite_region
);
6401 defsubr (&Scar_less_than_car
);
6402 defsubr (&Sverify_visited_file_modtime
);
6403 defsubr (&Sclear_visited_file_modtime
);
6404 defsubr (&Svisited_file_modtime
);
6405 defsubr (&Sset_visited_file_modtime
);
6406 defsubr (&Sdo_auto_save
);
6407 defsubr (&Sset_buffer_auto_saved
);
6408 defsubr (&Sclear_buffer_auto_save_failure
);
6409 defsubr (&Srecent_auto_save_p
);
6411 defsubr (&Snext_read_file_uses_dialog_p
);
6414 defsubr (&Sunix_sync
);
6418 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6419 (do not change this comment) */