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 /* Non-zero means call move-file-to-trash in Fdelete_file or
217 Fdelete_directory. */
218 int delete_by_moving_to_trash
;
220 /* Lisp function for moving files to trash. */
221 Lisp_Object Qmove_file_to_trash
;
223 extern Lisp_Object Vuser_login_name
;
226 extern Lisp_Object Vw32_get_true_file_attributes
;
229 extern int minibuf_level
;
231 extern int minibuffer_auto_raise
;
233 extern int history_delete_duplicates
;
235 /* These variables describe handlers that have "already" had a chance
236 to handle the current operation.
238 Vinhibit_file_name_handlers is a list of file name handlers.
239 Vinhibit_file_name_operation is the operation being handled.
240 If we try to handle that operation, we ignore those handlers. */
242 static Lisp_Object Vinhibit_file_name_handlers
;
243 static Lisp_Object Vinhibit_file_name_operation
;
245 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
247 Lisp_Object Qfile_name_history
;
249 Lisp_Object Qcar_less_than_car
;
251 static int a_write
P_ ((int, Lisp_Object
, int, int,
252 Lisp_Object
*, struct coding_system
*));
253 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
257 report_file_error (string
, data
)
261 Lisp_Object errstring
;
265 synchronize_system_messages_locale ();
266 str
= strerror (errorno
);
267 errstring
= code_convert_string_norecord (make_unibyte_string (str
,
269 Vlocale_coding_system
, 0);
275 xsignal (Qfile_already_exists
, Fcons (errstring
, data
));
278 /* System error messages are capitalized. Downcase the initial
279 unless it is followed by a slash. */
280 if (SREF (errstring
, 1) != '/')
281 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
283 xsignal (Qfile_error
,
284 Fcons (build_string (string
), Fcons (errstring
, data
)));
289 close_file_unwind (fd
)
292 emacs_close (XFASTINT (fd
));
296 /* Restore point, having saved it as a marker. */
299 restore_point_unwind (location
)
300 Lisp_Object location
;
302 Fgoto_char (location
);
303 Fset_marker (location
, Qnil
, Qnil
);
308 Lisp_Object Qexpand_file_name
;
309 Lisp_Object Qsubstitute_in_file_name
;
310 Lisp_Object Qdirectory_file_name
;
311 Lisp_Object Qfile_name_directory
;
312 Lisp_Object Qfile_name_nondirectory
;
313 Lisp_Object Qunhandled_file_name_directory
;
314 Lisp_Object Qfile_name_as_directory
;
315 Lisp_Object Qcopy_file
;
316 Lisp_Object Qmake_directory_internal
;
317 Lisp_Object Qmake_directory
;
318 Lisp_Object Qdelete_directory
;
319 Lisp_Object Qdelete_file
;
320 Lisp_Object Qrename_file
;
321 Lisp_Object Qadd_name_to_file
;
322 Lisp_Object Qmake_symbolic_link
;
323 Lisp_Object Qfile_exists_p
;
324 Lisp_Object Qfile_executable_p
;
325 Lisp_Object Qfile_readable_p
;
326 Lisp_Object Qfile_writable_p
;
327 Lisp_Object Qfile_symlink_p
;
328 Lisp_Object Qaccess_file
;
329 Lisp_Object Qfile_directory_p
;
330 Lisp_Object Qfile_regular_p
;
331 Lisp_Object Qfile_accessible_directory_p
;
332 Lisp_Object Qfile_modes
;
333 Lisp_Object Qset_file_modes
;
334 Lisp_Object Qset_file_times
;
335 Lisp_Object Qfile_newer_than_file_p
;
336 Lisp_Object Qinsert_file_contents
;
337 Lisp_Object Qwrite_region
;
338 Lisp_Object Qverify_visited_file_modtime
;
339 Lisp_Object Qset_visited_file_modtime
;
341 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
342 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
343 Otherwise, return nil.
344 A file name is handled if one of the regular expressions in
345 `file-name-handler-alist' matches it.
347 If OPERATION equals `inhibit-file-name-operation', then we ignore
348 any handlers that are members of `inhibit-file-name-handlers',
349 but we still do run any other handlers. This lets handlers
350 use the standard functions without calling themselves recursively. */)
351 (filename
, operation
)
352 Lisp_Object filename
, operation
;
354 /* This function must not munge the match data. */
355 Lisp_Object chain
, inhibited_handlers
, result
;
359 CHECK_STRING (filename
);
361 if (EQ (operation
, Vinhibit_file_name_operation
))
362 inhibited_handlers
= Vinhibit_file_name_handlers
;
364 inhibited_handlers
= Qnil
;
366 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
367 chain
= XCDR (chain
))
373 Lisp_Object string
= XCAR (elt
);
375 Lisp_Object handler
= XCDR (elt
);
376 Lisp_Object operations
= Qnil
;
378 if (SYMBOLP (handler
))
379 operations
= Fget (handler
, Qoperations
);
382 && (match_pos
= fast_string_match (string
, filename
)) > pos
383 && (NILP (operations
) || ! NILP (Fmemq (operation
, operations
))))
387 handler
= XCDR (elt
);
388 tem
= Fmemq (handler
, inhibited_handlers
);
402 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
404 doc
: /* Return the directory component in file name FILENAME.
405 Return nil if FILENAME does not include a directory.
406 Otherwise return a directory name.
407 Given a Unix syntax file name, returns a string ending in slash;
408 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
410 Lisp_Object filename
;
413 register const unsigned char *beg
;
415 register unsigned char *beg
;
417 register const unsigned char *p
;
420 CHECK_STRING (filename
);
422 /* If the file name has special constructs in it,
423 call the corresponding file handler. */
424 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
426 return call2 (handler
, Qfile_name_directory
, filename
);
428 filename
= FILE_SYSTEM_CASE (filename
);
429 beg
= SDATA (filename
);
431 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
433 p
= beg
+ SBYTES (filename
);
435 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
437 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
440 /* only recognise drive specifier at the beginning */
442 /* handle the "/:d:foo" and "/:foo" cases correctly */
443 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
444 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
451 /* Expansion of "c:" to drive and default directory. */
454 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
455 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
456 unsigned char *r
= res
;
458 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
460 strncpy (res
, beg
, 2);
465 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
467 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
470 p
= beg
+ strlen (beg
);
473 CORRECT_DIR_SEPS (beg
);
476 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
479 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
480 Sfile_name_nondirectory
, 1, 1, 0,
481 doc
: /* Return file name FILENAME sans its directory.
482 For example, in a Unix-syntax file name,
483 this is everything after the last slash,
484 or the entire name if it contains no slash. */)
486 Lisp_Object filename
;
488 register const unsigned char *beg
, *p
, *end
;
491 CHECK_STRING (filename
);
493 /* If the file name has special constructs in it,
494 call the corresponding file handler. */
495 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
497 return call2 (handler
, Qfile_name_nondirectory
, filename
);
499 beg
= SDATA (filename
);
500 end
= p
= beg
+ SBYTES (filename
);
502 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
504 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
507 /* only recognise drive specifier at beginning */
509 /* handle the "/:d:foo" case correctly */
510 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
515 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
518 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
519 Sunhandled_file_name_directory
, 1, 1, 0,
520 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
521 A `directly usable' directory name is one that may be used without the
522 intervention of any file handler.
523 If FILENAME is a directly usable file itself, return
524 \(file-name-directory FILENAME).
525 If FILENAME refers to a file which is not accessible from a local process,
526 then this should return nil.
527 The `call-process' and `start-process' functions use this function to
528 get a current directory to run processes in. */)
530 Lisp_Object filename
;
534 /* If the file name has special constructs in it,
535 call the corresponding file handler. */
536 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
538 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
540 return Ffile_name_directory (filename
);
545 file_name_as_directory (out
, in
)
548 int size
= strlen (in
) - 1;
561 /* Is it already a directory string? */
562 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
564 /* Is it a VMS directory file name? If so, hack VMS syntax. */
565 else if (! index (in
, '/')
566 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
567 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
568 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
569 || ! strncmp (&in
[size
- 5], ".dir", 4))
570 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
571 && in
[size
] == '1')))
573 register char *p
, *dot
;
577 dir:x.dir --> dir:[x]
578 dir:[x]y.dir --> dir:[x.y] */
580 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
583 strncpy (out
, in
, p
- in
);
602 dot
= index (p
, '.');
605 /* blindly remove any extension */
606 size
= strlen (out
) + (dot
- p
);
607 strncat (out
, p
, dot
- p
);
618 /* For Unix syntax, Append a slash if necessary */
619 if (!IS_DIRECTORY_SEP (out
[size
]))
621 /* Cannot use DIRECTORY_SEP, which could have any value */
623 out
[size
+ 2] = '\0';
626 CORRECT_DIR_SEPS (out
);
632 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
633 Sfile_name_as_directory
, 1, 1, 0,
634 doc
: /* Return a string representing the file name FILE interpreted as a directory.
635 This operation exists because a directory is also a file, but its name as
636 a directory is different from its name as a file.
637 The result can be used as the value of `default-directory'
638 or passed as second argument to `expand-file-name'.
639 For a Unix-syntax file name, just appends a slash.
640 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
651 /* If the file name has special constructs in it,
652 call the corresponding file handler. */
653 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
655 return call2 (handler
, Qfile_name_as_directory
, file
);
657 buf
= (char *) alloca (SBYTES (file
) + 10);
658 file_name_as_directory (buf
, SDATA (file
));
659 return make_specified_string (buf
, -1, strlen (buf
),
660 STRING_MULTIBYTE (file
));
664 * Convert from directory name to filename.
666 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
667 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
668 * On UNIX, it's simple: just make sure there isn't a terminating /
670 * Value is nonzero if the string output is different from the input.
674 directory_file_name (src
, dst
)
682 struct FAB fab
= cc$rms_fab
;
683 struct NAM nam
= cc$rms_nam
;
684 char esa
[NAM$C_MAXRSS
];
689 if (! index (src
, '/')
690 && (src
[slen
- 1] == ']'
691 || src
[slen
- 1] == ':'
692 || src
[slen
- 1] == '>'))
694 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
696 fab
.fab$b_fns
= slen
;
697 fab
.fab$l_nam
= &nam
;
698 fab
.fab$l_fop
= FAB$M_NAM
;
701 nam
.nam$b_ess
= sizeof esa
;
702 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
704 /* We call SYS$PARSE to handle such things as [--] for us. */
705 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
707 slen
= nam
.nam$b_esl
;
708 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
713 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
715 /* what about when we have logical_name:???? */
716 if (src
[slen
- 1] == ':')
717 { /* Xlate logical name and see what we get */
718 ptr
= strcpy (dst
, src
); /* upper case for getenv */
721 if ('a' <= *ptr
&& *ptr
<= 'z')
725 dst
[slen
- 1] = 0; /* remove colon */
726 if (!(src
= egetenv (dst
)))
728 /* should we jump to the beginning of this procedure?
729 Good points: allows us to use logical names that xlate
731 Bad points: can be a problem if we just translated to a device
733 For now, I'll punt and always expect VMS names, and hope for
736 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
737 { /* no recursion here! */
743 { /* not a directory spec */
748 bracket
= src
[slen
- 1];
750 /* If bracket is ']' or '>', bracket - 2 is the corresponding
752 ptr
= index (src
, bracket
- 2);
754 { /* no opening bracket */
758 if (!(rptr
= rindex (src
, '.')))
761 strncpy (dst
, src
, slen
);
765 dst
[slen
++] = bracket
;
770 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
771 then translate the device and recurse. */
772 if (dst
[slen
- 1] == ':'
773 && dst
[slen
- 2] != ':' /* skip decnet nodes */
774 && strcmp (src
+ slen
, "[000000]") == 0)
776 dst
[slen
- 1] = '\0';
777 if ((ptr
= egetenv (dst
))
778 && (rlen
= strlen (ptr
) - 1) > 0
779 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
780 && ptr
[rlen
- 1] == '.')
782 char * buf
= (char *) alloca (strlen (ptr
) + 1);
786 return directory_file_name (buf
, dst
);
791 strcat (dst
, "[000000]");
795 rlen
= strlen (rptr
) - 1;
796 strncat (dst
, rptr
, rlen
);
797 dst
[slen
+ rlen
] = '\0';
798 strcat (dst
, ".DIR.1");
802 /* Process as Unix format: just remove any final slash.
803 But leave "/" unchanged; do not change it to "". */
806 && IS_DIRECTORY_SEP (dst
[slen
- 1])
808 && !IS_ANY_SEP (dst
[slen
- 2])
813 CORRECT_DIR_SEPS (dst
);
818 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
820 doc
: /* Returns the file name of the directory named DIRECTORY.
821 This is the name of the file that holds the data for the directory DIRECTORY.
822 This operation exists because a directory is also a file, but its name as
823 a directory is different from its name as a file.
824 In Unix-syntax, this function just removes the final slash.
825 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
826 it returns a file name such as \"[X]Y.DIR.1\". */)
828 Lisp_Object directory
;
833 CHECK_STRING (directory
);
835 if (NILP (directory
))
838 /* If the file name has special constructs in it,
839 call the corresponding file handler. */
840 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
842 return call2 (handler
, Qdirectory_file_name
, directory
);
845 /* 20 extra chars is insufficient for VMS, since we might perform a
846 logical name translation. an equivalence string can be up to 255
847 chars long, so grab that much extra space... - sss */
848 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
850 buf
= (char *) alloca (SBYTES (directory
) + 20);
852 directory_file_name (SDATA (directory
), buf
);
853 return make_specified_string (buf
, -1, strlen (buf
),
854 STRING_MULTIBYTE (directory
));
857 static char make_temp_name_tbl
[64] =
859 'A','B','C','D','E','F','G','H',
860 'I','J','K','L','M','N','O','P',
861 'Q','R','S','T','U','V','W','X',
862 'Y','Z','a','b','c','d','e','f',
863 'g','h','i','j','k','l','m','n',
864 'o','p','q','r','s','t','u','v',
865 'w','x','y','z','0','1','2','3',
866 '4','5','6','7','8','9','-','_'
869 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
871 /* Value is a temporary file name starting with PREFIX, a string.
873 The Emacs process number forms part of the result, so there is
874 no danger of generating a name being used by another process.
875 In addition, this function makes an attempt to choose a name
876 which has no existing file. To make this work, PREFIX should be
877 an absolute file name.
879 BASE64_P non-zero means add the pid as 3 characters in base64
880 encoding. In this case, 6 characters will be added to PREFIX to
881 form the file name. Otherwise, if Emacs is running on a system
882 with long file names, add the pid as a decimal number.
884 This function signals an error if no unique file name could be
888 make_temp_name (prefix
, base64_p
)
895 unsigned char *p
, *data
;
899 CHECK_STRING (prefix
);
901 /* VAL is created by adding 6 characters to PREFIX. The first
902 three are the PID of this process, in base 64, and the second
903 three are incremented if the file already exists. This ensures
904 262144 unique file names per PID per PREFIX. */
906 pid
= (int) getpid ();
910 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
911 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
912 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
917 #ifdef HAVE_LONG_FILE_NAMES
918 sprintf (pidbuf
, "%d", pid
);
919 pidlen
= strlen (pidbuf
);
921 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
922 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
923 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
928 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
929 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
930 if (!STRING_MULTIBYTE (prefix
))
931 STRING_SET_UNIBYTE (val
);
933 bcopy(SDATA (prefix
), data
, len
);
936 bcopy (pidbuf
, p
, pidlen
);
939 /* Here we try to minimize useless stat'ing when this function is
940 invoked many times successively with the same PREFIX. We achieve
941 this by initializing count to a random value, and incrementing it
944 We don't want make-temp-name to be called while dumping,
945 because then make_temp_name_count_initialized_p would get set
946 and then make_temp_name_count would not be set when Emacs starts. */
948 if (!make_temp_name_count_initialized_p
)
950 make_temp_name_count
= (unsigned) time (NULL
);
951 make_temp_name_count_initialized_p
= 1;
957 unsigned num
= make_temp_name_count
;
959 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
960 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
961 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
963 /* Poor man's congruential RN generator. Replace with
964 ++make_temp_name_count for debugging. */
965 make_temp_name_count
+= 25229;
966 make_temp_name_count
%= 225307;
968 if (stat (data
, &ignored
) < 0)
970 /* We want to return only if errno is ENOENT. */
974 /* The error here is dubious, but there is little else we
975 can do. The alternatives are to return nil, which is
976 as bad as (and in many cases worse than) throwing the
977 error, or to ignore the error, which will likely result
978 in looping through 225307 stat's, which is not only
979 dog-slow, but also useless since it will fallback to
980 the errow below, anyway. */
981 report_file_error ("Cannot create temporary name for prefix",
982 Fcons (prefix
, Qnil
));
987 error ("Cannot create temporary name for prefix `%s'",
993 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
994 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
995 The Emacs process number forms part of the result,
996 so there is no danger of generating a name being used by another process.
998 In addition, this function makes an attempt to choose a name
999 which has no existing file. To make this work,
1000 PREFIX should be an absolute file name.
1002 There is a race condition between calling `make-temp-name' and creating the
1003 file which opens all kinds of security holes. For that reason, you should
1004 probably use `make-temp-file' instead, except in three circumstances:
1006 * If you are creating the file in the user's home directory.
1007 * If you are creating a directory rather than an ordinary file.
1008 * If you are taking special precautions as `make-temp-file' does. */)
1012 return make_temp_name (prefix
, 0);
1017 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1018 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1019 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1020 \(does not start with slash or tilde); if DEFAULT-DIRECTORY is nil or missing,
1021 the current buffer's value of `default-directory' is used.
1022 File name components that are `.' are removed, and
1023 so are file name components followed by `..', along with the `..' itself;
1024 note that these simplifications are done without checking the resulting
1025 file names in the file system.
1026 An initial `~/' expands to your home directory.
1027 An initial `~USER/' expands to USER's home directory.
1028 See also the function `substitute-in-file-name'. */)
1029 (name
, default_directory
)
1030 Lisp_Object name
, default_directory
;
1032 /* These point to SDATA and need to be careful with string-relocation
1033 during GC (via DECODE_FILE). */
1034 unsigned char *nm
, *newdir
;
1036 /* This should only point to alloca'd data. */
1037 unsigned char *target
;
1042 unsigned char * colon
= 0;
1043 unsigned char * close
= 0;
1044 unsigned char * slash
= 0;
1045 unsigned char * brack
= 0;
1046 int lbrack
= 0, rbrack
= 0;
1051 int collapse_newdir
= 1;
1055 Lisp_Object handler
, result
;
1059 CHECK_STRING (name
);
1061 /* If the file name has special constructs in it,
1062 call the corresponding file handler. */
1063 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1064 if (!NILP (handler
))
1065 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1067 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1068 if (NILP (default_directory
))
1069 default_directory
= current_buffer
->directory
;
1070 if (! STRINGP (default_directory
))
1073 /* "/" is not considered a root directory on DOS_NT, so using "/"
1074 here causes an infinite recursion in, e.g., the following:
1076 (let (default-directory)
1077 (expand-file-name "a"))
1079 To avoid this, we set default_directory to the root of the
1081 extern char *emacs_root_dir (void);
1083 default_directory
= build_string (emacs_root_dir ());
1085 default_directory
= build_string ("/");
1089 if (!NILP (default_directory
))
1091 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1092 if (!NILP (handler
))
1093 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1097 unsigned char *o
= SDATA (default_directory
);
1099 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1100 It would be better to do this down below where we actually use
1101 default_directory. Unfortunately, calling Fexpand_file_name recursively
1102 could invoke GC, and the strings might be relocated. This would
1103 be annoying because we have pointers into strings lying around
1104 that would need adjusting, and people would add new pointers to
1105 the code and forget to adjust them, resulting in intermittent bugs.
1106 Putting this call here avoids all that crud.
1108 The EQ test avoids infinite recursion. */
1109 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1110 /* Save time in some common cases - as long as default_directory
1111 is not relative, it can be canonicalized with name below (if it
1112 is needed at all) without requiring it to be expanded now. */
1114 /* Detect MSDOS file names with drive specifiers. */
1115 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1])
1116 && IS_DIRECTORY_SEP (o
[2]))
1118 /* Detect Windows file names in UNC format. */
1119 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1121 #else /* not DOS_NT */
1122 /* Detect Unix absolute file names (/... alone is not absolute on
1124 && ! (IS_DIRECTORY_SEP (o
[0]))
1125 #endif /* not DOS_NT */
1128 struct gcpro gcpro1
;
1131 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1135 name
= FILE_SYSTEM_CASE (name
);
1136 multibyte
= STRING_MULTIBYTE (name
);
1137 if (multibyte
!= STRING_MULTIBYTE (default_directory
))
1140 default_directory
= string_to_multibyte (default_directory
);
1143 name
= string_to_multibyte (name
);
1152 /* We will force directory separators to be either all \ or /, so make
1153 a local copy to modify, even if there ends up being no change. */
1154 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1157 /* Note if special escape prefix is present, but remove for now. */
1158 if (nm
[0] == '/' && nm
[1] == ':')
1164 /* Find and remove drive specifier if present; this makes nm absolute
1165 even if the rest of the name appears to be relative. Only look for
1166 drive specifier at the beginning. */
1167 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1174 /* If we see "c://somedir", we want to strip the first slash after the
1175 colon when stripping the drive letter. Otherwise, this expands to
1177 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1180 /* Discard any previous drive specifier if nm is now in UNC format. */
1181 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1185 #endif /* WINDOWSNT */
1188 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1189 none are found, we can probably return right away. We will avoid
1190 allocating a new string if name is already fully expanded. */
1192 IS_DIRECTORY_SEP (nm
[0])
1194 && drive
&& !is_escaped
1197 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1204 /* If it turns out that the filename we want to return is just a
1205 suffix of FILENAME, we don't need to go through and edit
1206 things; we just need to construct a new string using data
1207 starting at the middle of FILENAME. If we set lose to a
1208 non-zero value, that means we've discovered that we can't do
1211 unsigned char *p
= nm
;
1215 /* Since we know the name is absolute, we can assume that each
1216 element starts with a "/". */
1218 /* "." and ".." are hairy. */
1219 if (IS_DIRECTORY_SEP (p
[0])
1221 && (IS_DIRECTORY_SEP (p
[2])
1223 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1226 /* We want to replace multiple `/' in a row with a single
1229 && IS_DIRECTORY_SEP (p
[0])
1230 && IS_DIRECTORY_SEP (p
[1]))
1237 /* if dev:[dir]/, move nm to / */
1238 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1239 nm
= (brack
? brack
+ 1 : colon
+ 1);
1240 lbrack
= rbrack
= 0;
1247 #ifdef NO_HYPHENS_IN_FILENAMES
1248 if (lbrack
== rbrack
)
1250 /* Avoid clobbering negative version numbers. */
1255 #endif /* NO_HYPHENS_IN_FILENAMES */
1257 && ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<')
1258 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1260 #ifdef NO_HYPHENS_IN_FILENAMES
1263 #endif /* NO_HYPHENS_IN_FILENAMES */
1264 /* count open brackets, reset close bracket pointer */
1265 if (p
[0] == '[' || p
[0] == '<')
1266 lbrack
++, brack
= 0;
1267 /* count close brackets, set close bracket pointer */
1268 if (p
[0] == ']' || p
[0] == '>')
1269 rbrack
++, brack
= p
;
1270 /* detect ][ or >< */
1271 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1273 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1274 nm
= p
+ 1, lose
= 1;
1275 if (p
[0] == ':' && (colon
|| slash
))
1276 /* if dev1:[dir]dev2:, move nm to dev2: */
1282 /* if /name/dev:, move nm to dev: */
1285 /* if node::dev:, move colon following dev */
1286 else if (colon
&& colon
[-1] == ':')
1288 /* if dev1:dev2:, move nm to dev2: */
1289 else if (colon
&& colon
[-1] != ':')
1294 if (p
[0] == ':' && !colon
)
1300 if (lbrack
== rbrack
)
1303 else if (p
[0] == '.')
1311 if (index (nm
, '/'))
1313 nm
= sys_translate_unix (nm
);
1315 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1319 /* Make sure directories are all separated with / or \ as
1320 desired, but avoid allocation of a new string when not
1322 CORRECT_DIR_SEPS (nm
);
1324 if (IS_DIRECTORY_SEP (nm
[1]))
1326 if (strcmp (nm
, SDATA (name
)) != 0)
1327 name
= make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1331 /* drive must be set, so this is okay */
1332 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1336 name
= make_specified_string (nm
, -1, p
- nm
, multibyte
);
1337 temp
[0] = DRIVE_LETTER (drive
);
1338 name
= concat2 (build_string (temp
), name
);
1341 #else /* not DOS_NT */
1342 if (nm
== SDATA (name
))
1344 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1345 #endif /* not DOS_NT */
1349 /* At this point, nm might or might not be an absolute file name. We
1350 need to expand ~ or ~user if present, otherwise prefix nm with
1351 default_directory if nm is not absolute, and finally collapse /./
1352 and /foo/../ sequences.
1354 We set newdir to be the appropriate prefix if one is needed:
1355 - the relevant user directory if nm starts with ~ or ~user
1356 - the specified drive's working dir (DOS/NT only) if nm does not
1358 - the value of default_directory.
1360 Note that these prefixes are not guaranteed to be absolute (except
1361 for the working dir of a drive). Therefore, to ensure we always
1362 return an absolute name, if the final prefix is not absolute we
1363 append it to the current working directory. */
1367 if (nm
[0] == '~') /* prefix ~ */
1369 if (IS_DIRECTORY_SEP (nm
[1])
1373 || nm
[1] == 0) /* ~ by itself */
1377 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1378 newdir
= (unsigned char *) "";
1380 /* egetenv may return a unibyte string, which will bite us since
1381 we expect the directory to be multibyte. */
1382 tem
= build_string (newdir
);
1383 if (!STRING_MULTIBYTE (tem
))
1385 /* FIXME: DECODE_FILE may GC, which may move SDATA(name),
1386 after which `nm' won't point to the right place any more. */
1387 int offset
= nm
- SDATA (name
);
1388 hdir
= DECODE_FILE (tem
);
1389 newdir
= SDATA (hdir
);
1391 nm
= SDATA (name
) + offset
;
1394 collapse_newdir
= 0;
1397 nm
++; /* Don't leave the slash in nm. */
1400 else /* ~user/filename */
1402 unsigned char *o
, *p
;
1403 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1408 o
= alloca (p
- nm
+ 1);
1409 bcopy ((char *) nm
, o
, p
- nm
);
1413 pw
= (struct passwd
*) getpwnam (o
+ 1);
1417 newdir
= (unsigned char *) pw
-> pw_dir
;
1419 nm
= p
+ 1; /* skip the terminator */
1423 collapse_newdir
= 0;
1428 /* If we don't find a user of that name, leave the name
1429 unchanged; don't move nm forward to p. */
1434 /* On DOS and Windows, nm is absolute if a drive name was specified;
1435 use the drive's current directory as the prefix if needed. */
1436 if (!newdir
&& drive
)
1438 /* Get default directory if needed to make nm absolute. */
1439 if (!IS_DIRECTORY_SEP (nm
[0]))
1441 newdir
= alloca (MAXPATHLEN
+ 1);
1442 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1447 /* Either nm starts with /, or drive isn't mounted. */
1448 newdir
= alloca (4);
1449 newdir
[0] = DRIVE_LETTER (drive
);
1457 /* Finally, if no prefix has been specified and nm is not absolute,
1458 then it must be expanded relative to default_directory. */
1462 /* /... alone is not absolute on DOS and Windows. */
1463 && !IS_DIRECTORY_SEP (nm
[0])
1466 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1473 newdir
= SDATA (default_directory
);
1475 /* Note if special escape prefix is present, but remove for now. */
1476 if (newdir
[0] == '/' && newdir
[1] == ':')
1487 /* First ensure newdir is an absolute name. */
1489 /* Detect MSDOS file names with drive specifiers. */
1490 ! (IS_DRIVE (newdir
[0])
1491 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1493 /* Detect Windows file names in UNC format. */
1494 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1498 /* Effectively, let newdir be (expand-file-name newdir cwd).
1499 Because of the admonition against calling expand-file-name
1500 when we have pointers into lisp strings, we accomplish this
1501 indirectly by prepending newdir to nm if necessary, and using
1502 cwd (or the wd of newdir's drive) as the new newdir. */
1504 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1509 if (!IS_DIRECTORY_SEP (nm
[0]))
1511 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1512 file_name_as_directory (tmp
, newdir
);
1516 newdir
= alloca (MAXPATHLEN
+ 1);
1519 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1526 /* Strip off drive name from prefix, if present. */
1527 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1533 /* Keep only a prefix from newdir if nm starts with slash
1534 (//server/share for UNC, nothing otherwise). */
1535 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1538 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1541 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1543 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1545 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1557 /* Get rid of any slash at the end of newdir, unless newdir is
1558 just / or // (an incomplete UNC name). */
1559 length
= strlen (newdir
);
1560 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1562 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1566 unsigned char *temp
= (unsigned char *) alloca (length
);
1567 bcopy (newdir
, temp
, length
- 1);
1568 temp
[length
- 1] = 0;
1576 /* Now concatenate the directory and name to new space in the stack frame */
1577 tlen
+= strlen (nm
) + 1;
1579 /* Reserve space for drive specifier and escape prefix, since either
1580 or both may need to be inserted. (The Microsoft x86 compiler
1581 produces incorrect code if the following two lines are combined.) */
1582 target
= (unsigned char *) alloca (tlen
+ 4);
1584 #else /* not DOS_NT */
1585 target
= (unsigned char *) alloca (tlen
);
1586 #endif /* not DOS_NT */
1592 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1595 /* If newdir is effectively "C:/", then the drive letter will have
1596 been stripped and newdir will be "/". Concatenating with an
1597 absolute directory in nm produces "//", which will then be
1598 incorrectly treated as a network share. Ignore newdir in
1599 this case (keeping the drive letter). */
1600 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1601 && newdir
[1] == '\0'))
1603 strcpy (target
, newdir
);
1607 file_name_as_directory (target
, newdir
);
1610 strcat (target
, nm
);
1612 if (index (target
, '/'))
1613 strcpy (target
, sys_translate_unix (target
));
1616 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1618 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1622 unsigned char *p
= target
;
1623 unsigned char *o
= target
;
1628 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1634 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1635 /* brackets are offset from each other by 2 */
1638 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1639 /* convert [foo][bar] to [bar] */
1640 while (o
[-1] != '[' && o
[-1] != '<')
1642 else if (*p
== '-' && *o
!= '.')
1645 else if (p
[0] == '-' && o
[-1] == '.'
1646 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1647 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1651 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1652 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1654 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1656 /* else [foo.-] ==> [-] */
1660 #ifdef NO_HYPHENS_IN_FILENAMES
1662 && o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.'
1663 && p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1665 #endif /* NO_HYPHENS_IN_FILENAMES */
1669 if (!IS_DIRECTORY_SEP (*p
))
1673 else if (p
[1] == '.'
1674 && (IS_DIRECTORY_SEP (p
[2])
1677 /* If "/." is the entire filename, keep the "/". Otherwise,
1678 just delete the whole "/.". */
1679 if (o
== target
&& p
[2] == '\0')
1683 else if (p
[1] == '.' && p
[2] == '.'
1684 /* `/../' is the "superroot" on certain file systems.
1685 Turned off on DOS_NT systems because they have no
1686 "superroot" and because this causes us to produce
1687 file names like "d:/../foo" which fail file-related
1688 functions of the underlying OS. (To reproduce, try a
1689 long series of "../../" in default_directory, longer
1690 than the number of levels from the root.) */
1694 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1696 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1698 /* Keep initial / only if this is the whole name. */
1699 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1703 else if (p
> target
&& IS_DIRECTORY_SEP (p
[1]))
1704 /* Collapse multiple `/' in a row. */
1710 #endif /* not VMS */
1714 /* At last, set drive name. */
1716 /* Except for network file name. */
1717 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1718 #endif /* WINDOWSNT */
1720 if (!drive
) abort ();
1722 target
[0] = DRIVE_LETTER (drive
);
1725 /* Reinsert the escape prefix if required. */
1732 CORRECT_DIR_SEPS (target
);
1735 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1738 /* Again look to see if the file name has special constructs in it
1739 and perhaps call the corresponding file handler. This is needed
1740 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1741 the ".." component gives us "/user@host:/bar/../baz" which needs
1742 to be expanded again. */
1743 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1744 if (!NILP (handler
))
1745 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1751 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1752 This is the old version of expand-file-name, before it was thoroughly
1753 rewritten for Emacs 10.31. We leave this version here commented-out,
1754 because the code is very complex and likely to have subtle bugs. If
1755 bugs _are_ found, it might be of interest to look at the old code and
1756 see what did it do in the relevant situation.
1758 Don't remove this code: it's true that it will be accessible via CVS,
1759 but a few years from deletion, people will forget it is there. */
1761 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1762 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1763 "Convert FILENAME to absolute, and canonicalize it.\n\
1764 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1765 \(does not start with slash); if DEFAULT is nil or missing,\n\
1766 the current buffer's value of default-directory is used.\n\
1767 Filenames containing `.' or `..' as components are simplified;\n\
1768 initial `~/' expands to your home directory.\n\
1769 See also the function `substitute-in-file-name'.")
1771 Lisp_Object name
, defalt
;
1775 register unsigned char *newdir
, *p
, *o
;
1777 unsigned char *target
;
1781 unsigned char * colon
= 0;
1782 unsigned char * close
= 0;
1783 unsigned char * slash
= 0;
1784 unsigned char * brack
= 0;
1785 int lbrack
= 0, rbrack
= 0;
1789 CHECK_STRING (name
);
1792 /* Filenames on VMS are always upper case. */
1793 name
= Fupcase (name
);
1798 /* If nm is absolute, flush ...// and detect /./ and /../.
1799 If no /./ or /../ we can return right away. */
1811 if (p
[0] == '/' && p
[1] == '/'
1814 if (p
[0] == '/' && p
[1] == '~')
1815 nm
= p
+ 1, lose
= 1;
1816 if (p
[0] == '/' && p
[1] == '.'
1817 && (p
[2] == '/' || p
[2] == 0
1818 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1824 /* if dev:[dir]/, move nm to / */
1825 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1826 nm
= (brack
? brack
+ 1 : colon
+ 1);
1827 lbrack
= rbrack
= 0;
1835 /* VMS pre V4.4,convert '-'s in filenames. */
1836 if (lbrack
== rbrack
)
1838 if (dots
< 2) /* this is to allow negative version numbers */
1844 && ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<')
1845 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1851 /* count open brackets, reset close bracket pointer */
1852 if (p
[0] == '[' || p
[0] == '<')
1853 lbrack
++, brack
= 0;
1854 /* count close brackets, set close bracket pointer */
1855 if (p
[0] == ']' || p
[0] == '>')
1856 rbrack
++, brack
= p
;
1857 /* detect ][ or >< */
1858 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1860 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1861 nm
= p
+ 1, lose
= 1;
1862 if (p
[0] == ':' && (colon
|| slash
))
1863 /* if dev1:[dir]dev2:, move nm to dev2: */
1869 /* If /name/dev:, move nm to dev: */
1872 /* If node::dev:, move colon following dev */
1873 else if (colon
&& colon
[-1] == ':')
1875 /* If dev1:dev2:, move nm to dev2: */
1876 else if (colon
&& colon
[-1] != ':')
1881 if (p
[0] == ':' && !colon
)
1887 if (lbrack
== rbrack
)
1890 else if (p
[0] == '.')
1898 if (index (nm
, '/'))
1899 return build_string (sys_translate_unix (nm
));
1901 if (nm
== SDATA (name
))
1903 return build_string (nm
);
1907 /* Now determine directory to start with and put it in NEWDIR */
1911 if (nm
[0] == '~') /* prefix ~ */
1916 || nm
[1] == 0)/* ~/filename */
1918 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1919 newdir
= (unsigned char *) "";
1922 nm
++; /* Don't leave the slash in nm. */
1925 else /* ~user/filename */
1927 /* Get past ~ to user */
1928 unsigned char *user
= nm
+ 1;
1929 /* Find end of name. */
1930 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1931 int len
= ptr
? ptr
- user
: strlen (user
);
1933 unsigned char *ptr1
= index (user
, ':');
1934 if (ptr1
!= 0 && ptr1
- user
< len
)
1937 /* Copy the user name into temp storage. */
1938 o
= (unsigned char *) alloca (len
+ 1);
1939 bcopy ((char *) user
, o
, len
);
1942 /* Look up the user name. */
1944 pw
= (struct passwd
*) getpwnam (o
+ 1);
1947 error ("\"%s\" isn't a registered user", o
+ 1);
1949 newdir
= (unsigned char *) pw
->pw_dir
;
1951 /* Discard the user name from NM. */
1958 #endif /* not VMS */
1962 defalt
= current_buffer
->directory
;
1963 CHECK_STRING (defalt
);
1964 newdir
= SDATA (defalt
);
1967 /* Now concatenate the directory and name to new space in the stack frame */
1969 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1970 target
= (unsigned char *) alloca (tlen
);
1976 if (nm
[0] == 0 || nm
[0] == '/')
1977 strcpy (target
, newdir
);
1980 file_name_as_directory (target
, newdir
);
1983 strcat (target
, nm
);
1985 if (index (target
, '/'))
1986 strcpy (target
, sys_translate_unix (target
));
1989 /* Now canonicalize by removing /. and /foo/.. if they appear */
1997 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
2003 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
2004 /* brackets are offset from each other by 2 */
2007 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
2008 /* convert [foo][bar] to [bar] */
2009 while (o
[-1] != '[' && o
[-1] != '<')
2011 else if (*p
== '-' && *o
!= '.')
2014 else if (p
[0] == '-' && o
[-1] == '.'
2015 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
2016 /* flush .foo.- ; leave - if stopped by '[' or '<' */
2020 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
2021 if (p
[1] == '.') /* foo.-.bar ==> bar. */
2023 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
2025 /* else [foo.-] ==> [-] */
2031 && o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.'
2032 && p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2042 else if (!strncmp (p
, "//", 2)
2048 else if (p
[0] == '/' && p
[1] == '.'
2049 && (p
[2] == '/' || p
[2] == 0))
2051 else if (!strncmp (p
, "/..", 3)
2052 /* `/../' is the "superroot" on certain file systems. */
2054 && (p
[3] == '/' || p
[3] == 0))
2056 while (o
!= target
&& *--o
!= '/')
2058 if (o
== target
&& *o
== '/')
2066 #endif /* not VMS */
2069 return make_string (target
, o
- target
);
2073 /* If /~ or // appears, discard everything through first slash. */
2075 file_name_absolute_p (filename
)
2076 const unsigned char *filename
;
2079 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
2081 /* ??? This criterion is probably wrong for '<'. */
2082 || index (filename
, ':') || index (filename
, '<')
2083 || (*filename
== '[' && (filename
[1] != '-'
2084 || (filename
[2] != '.' && filename
[2] != ']'))
2085 && filename
[1] != '.')
2088 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
2089 && IS_DIRECTORY_SEP (filename
[2]))
2094 static unsigned char *
2095 search_embedded_absfilename (nm
, endp
)
2096 unsigned char *nm
, *endp
;
2098 unsigned char *p
, *s
;
2100 for (p
= nm
+ 1; p
< endp
; p
++)
2104 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2106 || IS_DIRECTORY_SEP (p
[-1]))
2107 && file_name_absolute_p (p
)
2108 #if defined (WINDOWSNT) || defined(CYGWIN)
2109 /* // at start of file name is meaningful in Apollo,
2110 WindowsNT and Cygwin systems. */
2111 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
2112 #endif /* not (WINDOWSNT || CYGWIN) */
2115 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2120 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2122 unsigned char *o
= alloca (s
- p
+ 1);
2124 bcopy (p
, o
, s
- p
);
2127 /* If we have ~user and `user' exists, discard
2128 everything up to ~. But if `user' does not exist, leave
2129 ~user alone, it might be a literal file name. */
2131 pw
= getpwnam (o
+ 1);
2143 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2144 Ssubstitute_in_file_name
, 1, 1, 0,
2145 doc
: /* Substitute environment variables referred to in FILENAME.
2146 `$FOO' where FOO is an environment variable name means to substitute
2147 the value of that variable. The variable name should be terminated
2148 with a character not a letter, digit or underscore; otherwise, enclose
2149 the entire variable name in braces.
2150 If `/~' appears, all of FILENAME through that `/' is discarded.
2152 On VMS, `$' substitution is not done; this function does little and only
2153 duplicates what `expand-file-name' does. */)
2155 Lisp_Object filename
;
2159 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2160 unsigned char *target
= NULL
;
2162 int substituted
= 0;
2164 Lisp_Object handler
;
2166 CHECK_STRING (filename
);
2168 /* If the file name has special constructs in it,
2169 call the corresponding file handler. */
2170 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2171 if (!NILP (handler
))
2172 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2174 nm
= SDATA (filename
);
2176 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2177 CORRECT_DIR_SEPS (nm
);
2178 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2180 endp
= nm
+ SBYTES (filename
);
2182 /* If /~ or // appears, discard everything through first slash. */
2183 p
= search_embedded_absfilename (nm
, endp
);
2185 /* Start over with the new string, so we check the file-name-handler
2186 again. Important with filenames like "/home/foo//:/hello///there"
2187 which whould substitute to "/:/hello///there" rather than "/there". */
2188 return Fsubstitute_in_file_name
2189 (make_specified_string (p
, -1, endp
- p
,
2190 STRING_MULTIBYTE (filename
)));
2196 /* See if any variables are substituted into the string
2197 and find the total length of their values in `total' */
2199 for (p
= nm
; p
!= endp
;)
2209 /* "$$" means a single "$" */
2218 while (p
!= endp
&& *p
!= '}') p
++;
2219 if (*p
!= '}') goto missingclose
;
2225 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2229 /* Copy out the variable name */
2230 target
= (unsigned char *) alloca (s
- o
+ 1);
2231 strncpy (target
, o
, s
- o
);
2234 strupr (target
); /* $home == $HOME etc. */
2237 /* Get variable value */
2238 o
= (unsigned char *) egetenv (target
);
2240 { /* Eight-bit chars occupy upto 2 bytes in multibyte. */
2241 total
+= strlen (o
) * (STRING_MULTIBYTE (filename
) ? 2 : 1);
2251 /* If substitution required, recopy the string and do it */
2252 /* Make space in stack frame for the new copy */
2253 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2256 /* Copy the rest of the name through, replacing $ constructs with values */
2273 while (p
!= endp
&& *p
!= '}') p
++;
2274 if (*p
!= '}') goto missingclose
;
2280 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2284 /* Copy out the variable name */
2285 target
= (unsigned char *) alloca (s
- o
+ 1);
2286 strncpy (target
, o
, s
- o
);
2289 strupr (target
); /* $home == $HOME etc. */
2292 /* Get variable value */
2293 o
= (unsigned char *) egetenv (target
);
2297 strcpy (x
, target
); x
+= strlen (target
);
2299 else if (STRING_MULTIBYTE (filename
))
2301 /* If the original string is multibyte,
2302 convert what we substitute into multibyte. */
2306 c
= unibyte_char_to_multibyte (c
);
2307 x
+= CHAR_STRING (c
, x
);
2319 /* If /~ or // appears, discard everything through first slash. */
2320 while ((p
= search_embedded_absfilename (xnm
, x
)))
2321 /* This time we do not start over because we've already expanded envvars
2322 and replaced $$ with $. Maybe we should start over as well, but we'd
2323 need to quote some $ to $$ first. */
2326 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2329 error ("Bad format environment-variable substitution");
2331 error ("Missing \"}\" in environment-variable substitution");
2333 error ("Substituting nonexistent environment variable \"%s\"", target
);
2336 #endif /* not VMS */
2340 /* A slightly faster and more convenient way to get
2341 (directory-file-name (expand-file-name FOO)). */
2344 expand_and_dir_to_file (filename
, defdir
)
2345 Lisp_Object filename
, defdir
;
2347 register Lisp_Object absname
;
2349 absname
= Fexpand_file_name (filename
, defdir
);
2352 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2353 if (c
== ':' || c
== ']' || c
== '>')
2354 absname
= Fdirectory_file_name (absname
);
2357 /* Remove final slash, if any (unless this is the root dir).
2358 stat behaves differently depending! */
2359 if (SCHARS (absname
) > 1
2360 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2361 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2362 /* We cannot take shortcuts; they might be wrong for magic file names. */
2363 absname
= Fdirectory_file_name (absname
);
2368 /* Signal an error if the file ABSNAME already exists.
2369 If INTERACTIVE is nonzero, ask the user whether to proceed,
2370 and bypass the error if the user says to go ahead.
2371 QUERYSTRING is a name for the action that is being considered
2374 *STATPTR is used to store the stat information if the file exists.
2375 If the file does not exist, STATPTR->st_mode is set to 0.
2376 If STATPTR is null, we don't store into it.
2378 If QUICK is nonzero, we ask for y or n, not yes or no. */
2381 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2382 Lisp_Object absname
;
2383 unsigned char *querystring
;
2385 struct stat
*statptr
;
2388 register Lisp_Object tem
, encoded_filename
;
2389 struct stat statbuf
;
2390 struct gcpro gcpro1
;
2392 encoded_filename
= ENCODE_FILE (absname
);
2394 /* stat is a good way to tell whether the file exists,
2395 regardless of what access permissions it has. */
2396 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
2399 xsignal2 (Qfile_already_exists
,
2400 build_string ("File already exists"), absname
);
2402 tem
= format2 ("File %s already exists; %s anyway? ",
2403 absname
, build_string (querystring
));
2405 tem
= Fy_or_n_p (tem
);
2407 tem
= do_yes_or_no_p (tem
);
2410 xsignal2 (Qfile_already_exists
,
2411 build_string ("File already exists"), absname
);
2418 statptr
->st_mode
= 0;
2423 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 5,
2424 "fCopy file: \nGCopy %s to file: \np\nP",
2425 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2426 If NEWNAME names a directory, copy FILE there.
2428 This function always sets the file modes of the output file to match
2431 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
2432 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
2433 signal a `file-already-exists' error without overwriting. If
2434 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
2435 about overwriting; this is what happens in interactive use with M-x.
2436 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
2439 Fourth arg KEEP-TIME non-nil means give the output file the same
2440 last-modified time as the old one. (This works on only some systems.)
2442 A prefix arg makes KEEP-TIME non-nil.
2444 If PRESERVE-UID-GID is non-nil, we try to transfer the
2445 uid and gid of FILE to NEWNAME. */)
2446 (file
, newname
, ok_if_already_exists
, keep_time
, preserve_uid_gid
)
2447 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2448 Lisp_Object preserve_uid_gid
;
2451 char buf
[16 * 1024];
2452 struct stat st
, out_st
;
2453 Lisp_Object handler
;
2454 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2455 int count
= SPECPDL_INDEX ();
2456 int input_file_statable_p
;
2457 Lisp_Object encoded_file
, encoded_newname
;
2459 encoded_file
= encoded_newname
= Qnil
;
2460 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2461 CHECK_STRING (file
);
2462 CHECK_STRING (newname
);
2464 if (!NILP (Ffile_directory_p (newname
)))
2465 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2467 newname
= Fexpand_file_name (newname
, Qnil
);
2469 file
= Fexpand_file_name (file
, Qnil
);
2471 /* If the input file name has special constructs in it,
2472 call the corresponding file handler. */
2473 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2474 /* Likewise for output file name. */
2476 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2477 if (!NILP (handler
))
2478 RETURN_UNGCPRO (call6 (handler
, Qcopy_file
, file
, newname
,
2479 ok_if_already_exists
, keep_time
, preserve_uid_gid
));
2481 encoded_file
= ENCODE_FILE (file
);
2482 encoded_newname
= ENCODE_FILE (newname
);
2484 if (NILP (ok_if_already_exists
)
2485 || INTEGERP (ok_if_already_exists
))
2486 barf_or_query_if_file_exists (newname
, "copy to it",
2487 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2488 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2492 if (!CopyFile (SDATA (encoded_file
),
2493 SDATA (encoded_newname
),
2495 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2496 /* CopyFile retains the timestamp by default. */
2497 else if (NILP (keep_time
))
2503 EMACS_GET_TIME (now
);
2504 filename
= SDATA (encoded_newname
);
2506 /* Ensure file is writable while its modified time is set. */
2507 attributes
= GetFileAttributes (filename
);
2508 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2509 if (set_file_times (filename
, now
, now
))
2511 /* Restore original attributes. */
2512 SetFileAttributes (filename
, attributes
);
2513 xsignal2 (Qfile_date_error
,
2514 build_string ("Cannot set file date"), newname
);
2516 /* Restore original attributes. */
2517 SetFileAttributes (filename
, attributes
);
2519 #else /* not WINDOWSNT */
2521 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2525 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2527 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2529 /* We can only copy regular files and symbolic links. Other files are not
2531 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2533 #if !defined (MSDOS) || __DJGPP__ > 1
2534 if (out_st
.st_mode
!= 0
2535 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2538 report_file_error ("Input and output files are the same",
2539 Fcons (file
, Fcons (newname
, Qnil
)));
2543 #if defined (S_ISREG) && defined (S_ISLNK)
2544 if (input_file_statable_p
)
2546 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2548 #if defined (EISDIR)
2549 /* Get a better looking error message. */
2552 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2555 #endif /* S_ISREG && S_ISLNK */
2558 /* Create the copy file with the same record format as the input file */
2559 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2562 /* System's default file type was set to binary by _fmode in emacs.c. */
2563 ofd
= emacs_open (SDATA (encoded_newname
),
2564 O_WRONLY
| O_TRUNC
| O_CREAT
2565 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2566 S_IREAD
| S_IWRITE
);
2567 #else /* not MSDOS */
2568 ofd
= emacs_open (SDATA (encoded_newname
),
2569 O_WRONLY
| O_TRUNC
| O_CREAT
2570 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2572 #endif /* not MSDOS */
2575 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2577 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2581 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2582 if (emacs_write (ofd
, buf
, n
) != n
)
2583 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2587 /* Preserve the original file modes, and if requested, also its
2589 if (input_file_statable_p
)
2591 if (! NILP (preserve_uid_gid
))
2592 fchown (ofd
, st
.st_uid
, st
.st_gid
);
2593 fchmod (ofd
, st
.st_mode
& 07777);
2595 #endif /* not MSDOS */
2597 /* Closing the output clobbers the file times on some systems. */
2598 if (emacs_close (ofd
) < 0)
2599 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2601 if (input_file_statable_p
)
2603 if (!NILP (keep_time
))
2605 EMACS_TIME atime
, mtime
;
2606 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2607 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2608 if (set_file_times (SDATA (encoded_newname
),
2610 xsignal2 (Qfile_date_error
,
2611 build_string ("Cannot set file date"), newname
);
2617 #if defined (__DJGPP__) && __DJGPP__ > 1
2618 if (input_file_statable_p
)
2620 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2621 and if it can't, it tells so. Otherwise, under MSDOS we usually
2622 get only the READ bit, which will make the copied file read-only,
2623 so it's better not to chmod at all. */
2624 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2625 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2627 #endif /* DJGPP version 2 or newer */
2628 #endif /* not WINDOWSNT */
2630 /* Discard the unwind protects. */
2631 specpdl_ptr
= specpdl
+ count
;
2637 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2638 Smake_directory_internal
, 1, 1, 0,
2639 doc
: /* Create a new directory named DIRECTORY. */)
2641 Lisp_Object directory
;
2643 const unsigned char *dir
;
2644 Lisp_Object handler
;
2645 Lisp_Object encoded_dir
;
2647 CHECK_STRING (directory
);
2648 directory
= Fexpand_file_name (directory
, Qnil
);
2650 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2651 if (!NILP (handler
))
2652 return call2 (handler
, Qmake_directory_internal
, directory
);
2654 encoded_dir
= ENCODE_FILE (directory
);
2656 dir
= SDATA (encoded_dir
);
2659 if (mkdir (dir
) != 0)
2661 if (mkdir (dir
, 0777) != 0)
2663 report_file_error ("Creating directory", list1 (directory
));
2668 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2669 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2671 Lisp_Object directory
;
2673 const unsigned char *dir
;
2674 Lisp_Object handler
;
2675 Lisp_Object encoded_dir
;
2677 CHECK_STRING (directory
);
2678 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2680 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2681 if (!NILP (handler
))
2682 return call2 (handler
, Qdelete_directory
, directory
);
2684 if (delete_by_moving_to_trash
)
2685 return call1 (Qmove_file_to_trash
, directory
);
2687 encoded_dir
= ENCODE_FILE (directory
);
2689 dir
= SDATA (encoded_dir
);
2691 if (rmdir (dir
) != 0)
2692 report_file_error ("Removing directory", list1 (directory
));
2697 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2698 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2699 If file has multiple names, it continues to exist with the other names. */)
2701 Lisp_Object filename
;
2703 Lisp_Object handler
;
2704 Lisp_Object encoded_file
;
2705 struct gcpro gcpro1
;
2708 if (!NILP (Ffile_directory_p (filename
))
2709 && NILP (Ffile_symlink_p (filename
)))
2710 xsignal2 (Qfile_error
,
2711 build_string ("Removing old name: is a directory"),
2714 filename
= Fexpand_file_name (filename
, Qnil
);
2716 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2717 if (!NILP (handler
))
2718 return call2 (handler
, Qdelete_file
, filename
);
2720 if (delete_by_moving_to_trash
)
2721 return call1 (Qmove_file_to_trash
, filename
);
2723 encoded_file
= ENCODE_FILE (filename
);
2725 if (0 > unlink (SDATA (encoded_file
)))
2726 report_file_error ("Removing old name", list1 (filename
));
2731 internal_delete_file_1 (ignore
)
2737 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2740 internal_delete_file (filename
)
2741 Lisp_Object filename
;
2744 tem
= internal_condition_case_1 (Fdelete_file
, filename
,
2745 Qt
, internal_delete_file_1
);
2749 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2750 "fRename file: \nGRename %s to file: \np",
2751 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2752 If file has names other than FILE, it continues to have those names.
2753 Signals a `file-already-exists' error if a file NEWNAME already exists
2754 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2755 A number as third arg means request confirmation if NEWNAME already exists.
2756 This is what happens in interactive use with M-x. */)
2757 (file
, newname
, ok_if_already_exists
)
2758 Lisp_Object file
, newname
, ok_if_already_exists
;
2760 Lisp_Object handler
;
2761 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2762 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2764 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2765 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2766 CHECK_STRING (file
);
2767 CHECK_STRING (newname
);
2768 file
= Fexpand_file_name (file
, Qnil
);
2770 if ((!NILP (Ffile_directory_p (newname
)))
2772 /* If the file names are identical but for the case,
2773 don't attempt to move directory to itself. */
2774 && (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2777 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2779 newname
= Fexpand_file_name (newname
, Qnil
);
2781 /* If the file name has special constructs in it,
2782 call the corresponding file handler. */
2783 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2785 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2786 if (!NILP (handler
))
2787 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2788 file
, newname
, ok_if_already_exists
));
2790 encoded_file
= ENCODE_FILE (file
);
2791 encoded_newname
= ENCODE_FILE (newname
);
2794 /* If the file names are identical but for the case, don't ask for
2795 confirmation: they simply want to change the letter-case of the
2797 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2799 if (NILP (ok_if_already_exists
)
2800 || INTEGERP (ok_if_already_exists
))
2801 barf_or_query_if_file_exists (newname
, "rename to it",
2802 INTEGERP (ok_if_already_exists
), 0, 0);
2803 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2808 symlink_target
= Ffile_symlink_p (file
);
2809 if (! NILP (symlink_target
))
2810 Fmake_symbolic_link (symlink_target
, newname
,
2811 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2814 Fcopy_file (file
, newname
,
2815 /* We have already prompted if it was an integer,
2816 so don't have copy-file prompt again. */
2817 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2820 Fdelete_file (file
);
2823 report_file_error ("Renaming", list2 (file
, newname
));
2829 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2830 "fAdd name to file: \nGName to add to %s: \np",
2831 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2832 Signals a `file-already-exists' error if a file NEWNAME already exists
2833 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2834 A number as third arg means request confirmation if NEWNAME already exists.
2835 This is what happens in interactive use with M-x. */)
2836 (file
, newname
, ok_if_already_exists
)
2837 Lisp_Object file
, newname
, ok_if_already_exists
;
2839 Lisp_Object handler
;
2840 Lisp_Object encoded_file
, encoded_newname
;
2841 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2843 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2844 encoded_file
= encoded_newname
= Qnil
;
2845 CHECK_STRING (file
);
2846 CHECK_STRING (newname
);
2847 file
= Fexpand_file_name (file
, Qnil
);
2849 if (!NILP (Ffile_directory_p (newname
)))
2850 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2852 newname
= Fexpand_file_name (newname
, Qnil
);
2854 /* If the file name has special constructs in it,
2855 call the corresponding file handler. */
2856 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2857 if (!NILP (handler
))
2858 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2859 newname
, ok_if_already_exists
));
2861 /* If the new name has special constructs in it,
2862 call the corresponding file handler. */
2863 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2864 if (!NILP (handler
))
2865 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2866 newname
, ok_if_already_exists
));
2868 encoded_file
= ENCODE_FILE (file
);
2869 encoded_newname
= ENCODE_FILE (newname
);
2871 if (NILP (ok_if_already_exists
)
2872 || INTEGERP (ok_if_already_exists
))
2873 barf_or_query_if_file_exists (newname
, "make it a new name",
2874 INTEGERP (ok_if_already_exists
), 0, 0);
2876 unlink (SDATA (newname
));
2877 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2878 report_file_error ("Adding new name", list2 (file
, newname
));
2884 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2885 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2886 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2887 Both args must be strings.
2888 Signals a `file-already-exists' error if a file LINKNAME already exists
2889 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2890 A number as third arg means request confirmation if LINKNAME already exists.
2891 This happens for interactive use with M-x. */)
2892 (filename
, linkname
, ok_if_already_exists
)
2893 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2895 Lisp_Object handler
;
2896 Lisp_Object encoded_filename
, encoded_linkname
;
2897 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2899 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2900 encoded_filename
= encoded_linkname
= Qnil
;
2901 CHECK_STRING (filename
);
2902 CHECK_STRING (linkname
);
2903 /* If the link target has a ~, we must expand it to get
2904 a truly valid file name. Otherwise, do not expand;
2905 we want to permit links to relative file names. */
2906 if (SREF (filename
, 0) == '~')
2907 filename
= Fexpand_file_name (filename
, Qnil
);
2909 if (!NILP (Ffile_directory_p (linkname
)))
2910 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2912 linkname
= Fexpand_file_name (linkname
, Qnil
);
2914 /* If the file name has special constructs in it,
2915 call the corresponding file handler. */
2916 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2917 if (!NILP (handler
))
2918 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2919 linkname
, ok_if_already_exists
));
2921 /* If the new link name has special constructs in it,
2922 call the corresponding file handler. */
2923 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2924 if (!NILP (handler
))
2925 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2926 linkname
, ok_if_already_exists
));
2929 encoded_filename
= ENCODE_FILE (filename
);
2930 encoded_linkname
= ENCODE_FILE (linkname
);
2932 if (NILP (ok_if_already_exists
)
2933 || INTEGERP (ok_if_already_exists
))
2934 barf_or_query_if_file_exists (linkname
, "make it a link",
2935 INTEGERP (ok_if_already_exists
), 0, 0);
2936 if (0 > symlink (SDATA (encoded_filename
),
2937 SDATA (encoded_linkname
)))
2939 /* If we didn't complain already, silently delete existing file. */
2940 if (errno
== EEXIST
)
2942 unlink (SDATA (encoded_linkname
));
2943 if (0 <= symlink (SDATA (encoded_filename
),
2944 SDATA (encoded_linkname
)))
2951 report_file_error ("Making symbolic link", list2 (filename
, linkname
));
2958 xsignal1 (Qfile_error
, build_string ("Symbolic links are not supported"));
2960 #endif /* S_IFLNK */
2965 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2966 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2967 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2968 If STRING is nil or a null string, the logical name NAME is deleted. */)
2973 CHECK_STRING (name
);
2975 delete_logical_name (SDATA (name
));
2978 CHECK_STRING (string
);
2980 if (SCHARS (string
) == 0)
2981 delete_logical_name (SDATA (name
));
2983 define_logical_name (SDATA (name
), SDATA (string
));
2992 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2993 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2995 Lisp_Object path
, login
;
2999 CHECK_STRING (path
);
3000 CHECK_STRING (login
);
3002 netresult
= netunam (SDATA (path
), SDATA (login
));
3004 if (netresult
== -1)
3009 #endif /* HPUX_NET */
3011 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
3013 doc
: /* Return t if file FILENAME specifies an absolute file name.
3014 On Unix, this is a name starting with a `/' or a `~'. */)
3016 Lisp_Object filename
;
3018 CHECK_STRING (filename
);
3019 return file_name_absolute_p (SDATA (filename
)) ? Qt
: Qnil
;
3022 /* Return nonzero if file FILENAME exists and can be executed. */
3025 check_executable (filename
)
3029 int len
= strlen (filename
);
3032 if (stat (filename
, &st
) < 0)
3034 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
3035 return ((st
.st_mode
& S_IEXEC
) != 0);
3037 return (S_ISREG (st
.st_mode
)
3039 && (xstrcasecmp ((suffix
= filename
+ len
-4), ".com") == 0
3040 || xstrcasecmp (suffix
, ".exe") == 0
3041 || xstrcasecmp (suffix
, ".bat") == 0)
3042 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3043 #endif /* not WINDOWSNT */
3044 #else /* not DOS_NT */
3045 #ifdef HAVE_EUIDACCESS
3046 return (euidaccess (filename
, 1) >= 0);
3048 /* Access isn't quite right because it uses the real uid
3049 and we really want to test with the effective uid.
3050 But Unix doesn't give us a right way to do it. */
3051 return (access (filename
, 1) >= 0);
3053 #endif /* not DOS_NT */
3056 /* Return nonzero if file FILENAME exists and can be written. */
3059 check_writable (filename
)
3064 if (stat (filename
, &st
) < 0)
3066 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3067 #else /* not MSDOS */
3068 #ifdef HAVE_EUIDACCESS
3069 return (euidaccess (filename
, 2) >= 0);
3071 /* Access isn't quite right because it uses the real uid
3072 and we really want to test with the effective uid.
3073 But Unix doesn't give us a right way to do it.
3074 Opening with O_WRONLY could work for an ordinary file,
3075 but would lose for directories. */
3076 return (access (filename
, 2) >= 0);
3078 #endif /* not MSDOS */
3081 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3082 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
3083 See also `file-readable-p' and `file-attributes'.
3084 This returns nil for a symlink to a nonexistent file.
3085 Use `file-symlink-p' to test for such links. */)
3087 Lisp_Object filename
;
3089 Lisp_Object absname
;
3090 Lisp_Object handler
;
3091 struct stat statbuf
;
3093 CHECK_STRING (filename
);
3094 absname
= Fexpand_file_name (filename
, Qnil
);
3096 /* If the file name has special constructs in it,
3097 call the corresponding file handler. */
3098 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3099 if (!NILP (handler
))
3100 return call2 (handler
, Qfile_exists_p
, absname
);
3102 absname
= ENCODE_FILE (absname
);
3104 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3107 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3108 doc
: /* Return t if FILENAME can be executed by you.
3109 For a directory, this means you can access files in that directory. */)
3111 Lisp_Object filename
;
3113 Lisp_Object absname
;
3114 Lisp_Object handler
;
3116 CHECK_STRING (filename
);
3117 absname
= Fexpand_file_name (filename
, Qnil
);
3119 /* If the file name has special constructs in it,
3120 call the corresponding file handler. */
3121 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3122 if (!NILP (handler
))
3123 return call2 (handler
, Qfile_executable_p
, absname
);
3125 absname
= ENCODE_FILE (absname
);
3127 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3130 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3131 doc
: /* Return t if file FILENAME exists and you can read it.
3132 See also `file-exists-p' and `file-attributes'. */)
3134 Lisp_Object filename
;
3136 Lisp_Object absname
;
3137 Lisp_Object handler
;
3140 struct stat statbuf
;
3142 CHECK_STRING (filename
);
3143 absname
= Fexpand_file_name (filename
, Qnil
);
3145 /* If the file name has special constructs in it,
3146 call the corresponding file handler. */
3147 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3148 if (!NILP (handler
))
3149 return call2 (handler
, Qfile_readable_p
, absname
);
3151 absname
= ENCODE_FILE (absname
);
3153 #if defined(DOS_NT) || defined(macintosh)
3154 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3156 if (access (SDATA (absname
), 0) == 0)
3159 #else /* not DOS_NT and not macintosh */
3161 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3162 /* Opening a fifo without O_NONBLOCK can wait.
3163 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3164 except in the case of a fifo, on a system which handles it. */
3165 desc
= stat (SDATA (absname
), &statbuf
);
3168 if (S_ISFIFO (statbuf
.st_mode
))
3169 flags
|= O_NONBLOCK
;
3171 desc
= emacs_open (SDATA (absname
), flags
, 0);
3176 #endif /* not DOS_NT and not macintosh */
3179 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3181 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3182 doc
: /* Return t if file FILENAME can be written or created by you. */)
3184 Lisp_Object filename
;
3186 Lisp_Object absname
, dir
, encoded
;
3187 Lisp_Object handler
;
3188 struct stat statbuf
;
3190 CHECK_STRING (filename
);
3191 absname
= Fexpand_file_name (filename
, Qnil
);
3193 /* If the file name has special constructs in it,
3194 call the corresponding file handler. */
3195 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3196 if (!NILP (handler
))
3197 return call2 (handler
, Qfile_writable_p
, absname
);
3199 encoded
= ENCODE_FILE (absname
);
3200 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3201 return (check_writable (SDATA (encoded
))
3204 dir
= Ffile_name_directory (absname
);
3207 dir
= Fdirectory_file_name (dir
);
3211 dir
= Fdirectory_file_name (dir
);
3214 dir
= ENCODE_FILE (dir
);
3216 /* The read-only attribute of the parent directory doesn't affect
3217 whether a file or directory can be created within it. Some day we
3218 should check ACLs though, which do affect this. */
3219 if (stat (SDATA (dir
), &statbuf
) < 0)
3221 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3223 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3228 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3229 doc
: /* Access file FILENAME, and get an error if that does not work.
3230 The second argument STRING is used in the error message.
3231 If there is no error, returns nil. */)
3233 Lisp_Object filename
, string
;
3235 Lisp_Object handler
, encoded_filename
, absname
;
3238 CHECK_STRING (filename
);
3239 absname
= Fexpand_file_name (filename
, Qnil
);
3241 CHECK_STRING (string
);
3243 /* If the file name has special constructs in it,
3244 call the corresponding file handler. */
3245 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3246 if (!NILP (handler
))
3247 return call3 (handler
, Qaccess_file
, absname
, string
);
3249 encoded_filename
= ENCODE_FILE (absname
);
3251 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3253 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3259 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3260 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3261 The value is the link target, as a string.
3262 Otherwise it returns nil.
3264 This function returns t when given the name of a symlink that
3265 points to a nonexistent file. */)
3267 Lisp_Object filename
;
3269 Lisp_Object handler
;
3271 CHECK_STRING (filename
);
3272 filename
= Fexpand_file_name (filename
, Qnil
);
3274 /* If the file name has special constructs in it,
3275 call the corresponding file handler. */
3276 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3277 if (!NILP (handler
))
3278 return call2 (handler
, Qfile_symlink_p
, filename
);
3287 filename
= ENCODE_FILE (filename
);
3294 buf
= (char *) xrealloc (buf
, bufsize
);
3295 bzero (buf
, bufsize
);
3298 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3302 /* HP-UX reports ERANGE if buffer is too small. */
3303 if (errno
== ERANGE
)
3313 while (valsize
>= bufsize
);
3315 val
= make_string (buf
, valsize
);
3316 if (buf
[0] == '/' && index (buf
, ':'))
3317 val
= concat2 (build_string ("/:"), val
);
3319 val
= DECODE_FILE (val
);
3322 #else /* not S_IFLNK */
3324 #endif /* not S_IFLNK */
3327 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3328 doc
: /* Return t if FILENAME names an existing directory.
3329 Symbolic links to directories count as directories.
3330 See `file-symlink-p' to distinguish symlinks. */)
3332 Lisp_Object filename
;
3334 register Lisp_Object absname
;
3336 Lisp_Object handler
;
3338 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3340 /* If the file name has special constructs in it,
3341 call the corresponding file handler. */
3342 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3343 if (!NILP (handler
))
3344 return call2 (handler
, Qfile_directory_p
, absname
);
3346 absname
= ENCODE_FILE (absname
);
3348 if (stat (SDATA (absname
), &st
) < 0)
3350 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3353 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3354 doc
: /* Return t if file FILENAME names a directory you can open.
3355 For the value to be t, FILENAME must specify the name of a directory as a file,
3356 and the directory must allow you to open files in it. In order to use a
3357 directory as a buffer's current directory, this predicate must return true.
3358 A directory name spec may be given instead; then the value is t
3359 if the directory so specified exists and really is a readable and
3360 searchable directory. */)
3362 Lisp_Object filename
;
3364 Lisp_Object handler
;
3366 struct gcpro gcpro1
;
3368 /* If the file name has special constructs in it,
3369 call the corresponding file handler. */
3370 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3371 if (!NILP (handler
))
3372 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3375 tem
= (NILP (Ffile_directory_p (filename
))
3376 || NILP (Ffile_executable_p (filename
)));
3378 return tem
? Qnil
: Qt
;
3381 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3382 doc
: /* Return t if FILENAME names a regular file.
3383 This is the sort of file that holds an ordinary stream of data bytes.
3384 Symbolic links to regular files count as regular files.
3385 See `file-symlink-p' to distinguish symlinks. */)
3387 Lisp_Object filename
;
3389 register Lisp_Object absname
;
3391 Lisp_Object handler
;
3393 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3395 /* If the file name has special constructs in it,
3396 call the corresponding file handler. */
3397 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3398 if (!NILP (handler
))
3399 return call2 (handler
, Qfile_regular_p
, absname
);
3401 absname
= ENCODE_FILE (absname
);
3406 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3408 /* Tell stat to use expensive method to get accurate info. */
3409 Vw32_get_true_file_attributes
= Qt
;
3410 result
= stat (SDATA (absname
), &st
);
3411 Vw32_get_true_file_attributes
= tem
;
3415 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3418 if (stat (SDATA (absname
), &st
) < 0)
3420 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3424 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3425 doc
: /* Return mode bits of file named FILENAME, as an integer.
3426 Return nil, if file does not exist or is not accessible. */)
3428 Lisp_Object filename
;
3430 Lisp_Object absname
;
3432 Lisp_Object handler
;
3434 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3436 /* If the file name has special constructs in it,
3437 call the corresponding file handler. */
3438 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3439 if (!NILP (handler
))
3440 return call2 (handler
, Qfile_modes
, absname
);
3442 absname
= ENCODE_FILE (absname
);
3444 if (stat (SDATA (absname
), &st
) < 0)
3446 #if defined (MSDOS) && __DJGPP__ < 2
3447 if (check_executable (SDATA (absname
)))
3448 st
.st_mode
|= S_IEXEC
;
3449 #endif /* MSDOS && __DJGPP__ < 2 */
3451 return make_number (st
.st_mode
& 07777);
3454 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2,
3455 "(let ((file (read-file-name \"File: \"))) \
3456 (list file (read-file-modes nil file)))",
3457 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3458 Only the 12 low bits of MODE are used. */)
3460 Lisp_Object filename
, mode
;
3462 Lisp_Object absname
, encoded_absname
;
3463 Lisp_Object handler
;
3465 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3466 CHECK_NUMBER (mode
);
3468 /* If the file name has special constructs in it,
3469 call the corresponding file handler. */
3470 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3471 if (!NILP (handler
))
3472 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3474 encoded_absname
= ENCODE_FILE (absname
);
3476 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3477 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3482 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3483 doc
: /* Set the file permission bits for newly created files.
3484 The argument MODE should be an integer; only the low 9 bits are used.
3485 This setting is inherited by subprocesses. */)
3489 CHECK_NUMBER (mode
);
3491 umask ((~ XINT (mode
)) & 0777);
3496 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3497 doc
: /* Return the default file protection for created files.
3498 The value is an integer. */)
3504 realmask
= umask (0);
3507 XSETINT (value
, (~ realmask
) & 0777);
3511 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3513 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3514 doc
: /* Set times of file FILENAME to TIME.
3515 Set both access and modification times.
3516 Return t on success, else nil.
3517 Use the current time if TIME is nil. TIME is in the format of
3520 Lisp_Object filename
, time
;
3522 Lisp_Object absname
, encoded_absname
;
3523 Lisp_Object handler
;
3527 if (! lisp_time_argument (time
, &sec
, &usec
))
3528 error ("Invalid time specification");
3530 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3532 /* If the file name has special constructs in it,
3533 call the corresponding file handler. */
3534 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3535 if (!NILP (handler
))
3536 return call3 (handler
, Qset_file_times
, absname
, time
);
3538 encoded_absname
= ENCODE_FILE (absname
);
3543 EMACS_SET_SECS (t
, sec
);
3544 EMACS_SET_USECS (t
, usec
);
3546 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3551 /* Setting times on a directory always fails. */
3552 if (stat (SDATA (encoded_absname
), &st
) == 0
3553 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3556 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3565 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3566 doc
: /* Tell Unix to finish all pending disk updates. */)
3573 #endif /* HAVE_SYNC */
3575 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3576 doc
: /* Return t if file FILE1 is newer than file FILE2.
3577 If FILE1 does not exist, the answer is nil;
3578 otherwise, if FILE2 does not exist, the answer is t. */)
3580 Lisp_Object file1
, file2
;
3582 Lisp_Object absname1
, absname2
;
3585 Lisp_Object handler
;
3586 struct gcpro gcpro1
, gcpro2
;
3588 CHECK_STRING (file1
);
3589 CHECK_STRING (file2
);
3592 GCPRO2 (absname1
, file2
);
3593 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3594 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3597 /* If the file name has special constructs in it,
3598 call the corresponding file handler. */
3599 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3601 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3602 if (!NILP (handler
))
3603 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3605 GCPRO2 (absname1
, absname2
);
3606 absname1
= ENCODE_FILE (absname1
);
3607 absname2
= ENCODE_FILE (absname2
);
3610 if (stat (SDATA (absname1
), &st
) < 0)
3613 mtime1
= st
.st_mtime
;
3615 if (stat (SDATA (absname2
), &st
) < 0)
3618 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3622 Lisp_Object Qfind_buffer_file_type
;
3625 #ifndef READ_BUF_SIZE
3626 #define READ_BUF_SIZE (64 << 10)
3629 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3631 /* This function is called after Lisp functions to decide a coding
3632 system are called, or when they cause an error. Before they are
3633 called, the current buffer is set unibyte and it contains only a
3634 newly inserted text (thus the buffer was empty before the
3637 The functions may set markers, overlays, text properties, or even
3638 alter the buffer contents, change the current buffer.
3640 Here, we reset all those changes by:
3641 o set back the current buffer.
3642 o move all markers and overlays to BEG.
3643 o remove all text properties.
3644 o set back the buffer multibyteness. */
3647 decide_coding_unwind (unwind_data
)
3648 Lisp_Object unwind_data
;
3650 Lisp_Object multibyte
, undo_list
, buffer
;
3652 multibyte
= XCAR (unwind_data
);
3653 unwind_data
= XCDR (unwind_data
);
3654 undo_list
= XCAR (unwind_data
);
3655 buffer
= XCDR (unwind_data
);
3657 if (current_buffer
!= XBUFFER (buffer
))
3658 set_buffer_internal (XBUFFER (buffer
));
3659 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3660 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3661 BUF_INTERVALS (current_buffer
) = 0;
3662 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3664 /* Now we are safe to change the buffer's multibyteness directly. */
3665 current_buffer
->enable_multibyte_characters
= multibyte
;
3666 current_buffer
->undo_list
= undo_list
;
3672 /* Used to pass values from insert-file-contents to read_non_regular. */
3674 static int non_regular_fd
;
3675 static int non_regular_inserted
;
3676 static int non_regular_nbytes
;
3679 /* Read from a non-regular file.
3680 Read non_regular_trytry bytes max from non_regular_fd.
3681 Non_regular_inserted specifies where to put the read bytes.
3682 Value is the number of bytes read. */
3691 nbytes
= emacs_read (non_regular_fd
,
3692 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3693 non_regular_nbytes
);
3695 return make_number (nbytes
);
3699 /* Condition-case handler used when reading from non-regular files
3700 in insert-file-contents. */
3703 read_non_regular_quit ()
3709 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3711 doc
: /* Insert contents of file FILENAME after point.
3712 Returns list of absolute file name and number of characters inserted.
3713 If second argument VISIT is non-nil, the buffer's visited filename and
3714 last save file modtime are set, and it is marked unmodified. If
3715 visiting and the file does not exist, visiting is completed before the
3718 The optional third and fourth arguments BEG and END specify what portion
3719 of the file to insert. These arguments count bytes in the file, not
3720 characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
3722 If optional fifth argument REPLACE is non-nil, replace the current
3723 buffer contents (in the accessible portion) with the file contents.
3724 This is better than simply deleting and inserting the whole thing
3725 because (1) it preserves some marker positions and (2) it puts less data
3726 in the undo list. When REPLACE is non-nil, the second return value is
3727 the number of characters that replace previous buffer contents.
3729 This function does code conversion according to the value of
3730 `coding-system-for-read' or `file-coding-system-alist', and sets the
3731 variable `last-coding-system-used' to the coding system actually used. */)
3732 (filename
, visit
, beg
, end
, replace
)
3733 Lisp_Object filename
, visit
, beg
, end
, replace
;
3739 register int how_much
;
3740 register int unprocessed
;
3741 int count
= SPECPDL_INDEX ();
3742 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3743 Lisp_Object handler
, val
, insval
, orig_filename
, old_undo
;
3746 int not_regular
= 0;
3747 unsigned char read_buf
[READ_BUF_SIZE
];
3748 struct coding_system coding
;
3749 unsigned char buffer
[1 << 14];
3750 int replace_handled
= 0;
3751 int set_coding_system
= 0;
3752 Lisp_Object coding_system
;
3754 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3755 int we_locked_file
= 0;
3757 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3758 error ("Cannot do file visiting in an indirect buffer");
3760 if (!NILP (current_buffer
->read_only
))
3761 Fbarf_if_buffer_read_only ();
3765 orig_filename
= Qnil
;
3768 GCPRO5 (filename
, val
, p
, orig_filename
, old_undo
);
3770 CHECK_STRING (filename
);
3771 filename
= Fexpand_file_name (filename
, Qnil
);
3773 /* The value Qnil means that the coding system is not yet
3775 coding_system
= Qnil
;
3777 /* If the file name has special constructs in it,
3778 call the corresponding file handler. */
3779 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3780 if (!NILP (handler
))
3782 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3783 visit
, beg
, end
, replace
);
3784 if (CONSP (val
) && CONSP (XCDR (val
)))
3785 inserted
= XINT (XCAR (XCDR (val
)));
3789 orig_filename
= filename
;
3790 filename
= ENCODE_FILE (filename
);
3796 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3798 /* Tell stat to use expensive method to get accurate info. */
3799 Vw32_get_true_file_attributes
= Qt
;
3800 total
= stat (SDATA (filename
), &st
);
3801 Vw32_get_true_file_attributes
= tem
;
3805 if (stat (SDATA (filename
), &st
) < 0)
3806 #endif /* WINDOWSNT */
3808 if (fd
>= 0) emacs_close (fd
);
3811 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3814 if (!NILP (Vcoding_system_for_read
))
3815 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3820 /* This code will need to be changed in order to work on named
3821 pipes, and it's probably just not worth it. So we should at
3822 least signal an error. */
3823 if (!S_ISREG (st
.st_mode
))
3830 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3831 xsignal2 (Qfile_error
,
3832 build_string ("not a regular file"), orig_filename
);
3837 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3840 /* Replacement should preserve point as it preserves markers. */
3841 if (!NILP (replace
))
3842 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3844 record_unwind_protect (close_file_unwind
, make_number (fd
));
3846 /* Supposedly happens on VMS. */
3847 /* Can happen on any platform that uses long as type of off_t, but allows
3848 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3849 give a message suitable for the latter case. */
3850 if (! not_regular
&& st
.st_size
< 0)
3851 error ("Maximum buffer size exceeded");
3853 /* Prevent redisplay optimizations. */
3854 current_buffer
->clip_changed
= 1;
3858 if (!NILP (beg
) || !NILP (end
))
3859 error ("Attempt to visit less than an entire file");
3860 if (BEG
< Z
&& NILP (replace
))
3861 error ("Cannot do file visiting in a non-empty buffer");
3867 XSETFASTINT (beg
, 0);
3875 XSETINT (end
, st
.st_size
);
3877 /* Arithmetic overflow can occur if an Emacs integer cannot
3878 represent the file size, or if the calculations below
3879 overflow. The calculations below double the file size
3880 twice, so check that it can be multiplied by 4 safely. */
3881 if (XINT (end
) != st
.st_size
3882 || st
.st_size
> INT_MAX
/ 4)
3883 error ("Maximum buffer size exceeded");
3885 /* The file size returned from stat may be zero, but data
3886 may be readable nonetheless, for example when this is a
3887 file in the /proc filesystem. */
3888 if (st
.st_size
== 0)
3889 XSETINT (end
, READ_BUF_SIZE
);
3893 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3895 coding_system
= coding_inherit_eol_type (Qutf_8_emacs
, Qunix
);
3896 setup_coding_system (coding_system
, &coding
);
3897 /* Ensure we set Vlast_coding_system_used. */
3898 set_coding_system
= 1;
3902 /* Decide the coding system to use for reading the file now
3903 because we can't use an optimized method for handling
3904 `coding:' tag if the current buffer is not empty. */
3905 if (!NILP (Vcoding_system_for_read
))
3906 coding_system
= Vcoding_system_for_read
;
3909 /* Don't try looking inside a file for a coding system
3910 specification if it is not seekable. */
3911 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3913 /* Find a coding system specified in the heading two
3914 lines or in the tailing several lines of the file.
3915 We assume that the 1K-byte and 3K-byte for heading
3916 and tailing respectively are sufficient for this
3920 if (st
.st_size
<= (1024 * 4))
3921 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3924 nread
= emacs_read (fd
, read_buf
, 1024);
3927 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3928 report_file_error ("Setting file position",
3929 Fcons (orig_filename
, Qnil
));
3930 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3935 error ("IO error reading %s: %s",
3936 SDATA (orig_filename
), emacs_strerror (errno
));
3939 struct buffer
*prev
= current_buffer
;
3943 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3945 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3946 buf
= XBUFFER (buffer
);
3948 delete_all_overlays (buf
);
3949 buf
->directory
= current_buffer
->directory
;
3950 buf
->read_only
= Qnil
;
3951 buf
->filename
= Qnil
;
3952 buf
->undo_list
= Qt
;
3953 eassert (buf
->overlays_before
== NULL
);
3954 eassert (buf
->overlays_after
== NULL
);
3956 set_buffer_internal (buf
);
3958 buf
->enable_multibyte_characters
= Qnil
;
3960 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3961 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3962 coding_system
= call2 (Vset_auto_coding_function
,
3963 filename
, make_number (nread
));
3964 set_buffer_internal (prev
);
3966 /* Discard the unwind protect for recovering the
3970 /* Rewind the file for the actual read done later. */
3971 if (lseek (fd
, 0, 0) < 0)
3972 report_file_error ("Setting file position",
3973 Fcons (orig_filename
, Qnil
));
3977 if (NILP (coding_system
))
3979 /* If we have not yet decided a coding system, check
3980 file-coding-system-alist. */
3981 Lisp_Object args
[6];
3983 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3984 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3985 coding_system
= Ffind_operation_coding_system (6, args
);
3986 if (CONSP (coding_system
))
3987 coding_system
= XCAR (coding_system
);
3991 if (NILP (coding_system
))
3992 coding_system
= Qundecided
;
3994 CHECK_CODING_SYSTEM (coding_system
);
3996 if (NILP (current_buffer
->enable_multibyte_characters
))
3997 /* We must suppress all character code conversion except for
3998 end-of-line conversion. */
3999 coding_system
= raw_text_coding_system (coding_system
);
4001 setup_coding_system (coding_system
, &coding
);
4002 /* Ensure we set Vlast_coding_system_used. */
4003 set_coding_system
= 1;
4006 /* If requested, replace the accessible part of the buffer
4007 with the file contents. Avoid replacing text at the
4008 beginning or end of the buffer that matches the file contents;
4009 that preserves markers pointing to the unchanged parts.
4011 Here we implement this feature in an optimized way
4012 for the case where code conversion is NOT needed.
4013 The following if-statement handles the case of conversion
4014 in a less optimal way.
4016 If the code conversion is "automatic" then we try using this
4017 method and hope for the best.
4018 But if we discover the need for conversion, we give up on this method
4019 and let the following if-statement handle the replace job. */
4022 && (NILP (coding_system
)
4023 || ! CODING_REQUIRE_DECODING (&coding
)))
4025 /* same_at_start and same_at_end count bytes,
4026 because file access counts bytes
4027 and BEG and END count bytes. */
4028 int same_at_start
= BEGV_BYTE
;
4029 int same_at_end
= ZV_BYTE
;
4031 /* There is still a possibility we will find the need to do code
4032 conversion. If that happens, we set this variable to 1 to
4033 give up on handling REPLACE in the optimized way. */
4034 int giveup_match_end
= 0;
4036 if (XINT (beg
) != 0)
4038 if (lseek (fd
, XINT (beg
), 0) < 0)
4039 report_file_error ("Setting file position",
4040 Fcons (orig_filename
, Qnil
));
4045 /* Count how many chars at the start of the file
4046 match the text at the beginning of the buffer. */
4051 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4053 error ("IO error reading %s: %s",
4054 SDATA (orig_filename
), emacs_strerror (errno
));
4055 else if (nread
== 0)
4058 if (CODING_REQUIRE_DETECTION (&coding
))
4060 coding_system
= detect_coding_system (buffer
, nread
, nread
, 1, 0,
4062 setup_coding_system (coding_system
, &coding
);
4065 if (CODING_REQUIRE_DECODING (&coding
))
4066 /* We found that the file should be decoded somehow.
4067 Let's give up here. */
4069 giveup_match_end
= 1;
4074 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4075 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4076 same_at_start
++, bufpos
++;
4077 /* If we found a discrepancy, stop the scan.
4078 Otherwise loop around and scan the next bufferful. */
4079 if (bufpos
!= nread
)
4083 /* If the file matches the buffer completely,
4084 there's no need to replace anything. */
4085 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4089 /* Truncate the buffer to the size of the file. */
4090 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4095 /* Count how many chars at the end of the file
4096 match the text at the end of the buffer. But, if we have
4097 already found that decoding is necessary, don't waste time. */
4098 while (!giveup_match_end
)
4100 int total_read
, nread
, bufpos
, curpos
, trial
;
4102 /* At what file position are we now scanning? */
4103 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4104 /* If the entire file matches the buffer tail, stop the scan. */
4107 /* How much can we scan in the next step? */
4108 trial
= min (curpos
, sizeof buffer
);
4109 if (lseek (fd
, curpos
- trial
, 0) < 0)
4110 report_file_error ("Setting file position",
4111 Fcons (orig_filename
, Qnil
));
4113 total_read
= nread
= 0;
4114 while (total_read
< trial
)
4116 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4118 error ("IO error reading %s: %s",
4119 SDATA (orig_filename
), emacs_strerror (errno
));
4120 else if (nread
== 0)
4122 total_read
+= nread
;
4125 /* Scan this bufferful from the end, comparing with
4126 the Emacs buffer. */
4127 bufpos
= total_read
;
4129 /* Compare with same_at_start to avoid counting some buffer text
4130 as matching both at the file's beginning and at the end. */
4131 while (bufpos
> 0 && same_at_end
> same_at_start
4132 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4133 same_at_end
--, bufpos
--;
4135 /* If we found a discrepancy, stop the scan.
4136 Otherwise loop around and scan the preceding bufferful. */
4139 /* If this discrepancy is because of code conversion,
4140 we cannot use this method; giveup and try the other. */
4141 if (same_at_end
> same_at_start
4142 && FETCH_BYTE (same_at_end
- 1) >= 0200
4143 && ! NILP (current_buffer
->enable_multibyte_characters
)
4144 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4145 giveup_match_end
= 1;
4154 if (! giveup_match_end
)
4158 /* We win! We can handle REPLACE the optimized way. */
4160 /* Extend the start of non-matching text area to multibyte
4161 character boundary. */
4162 if (! NILP (current_buffer
->enable_multibyte_characters
))
4163 while (same_at_start
> BEGV_BYTE
4164 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4167 /* Extend the end of non-matching text area to multibyte
4168 character boundary. */
4169 if (! NILP (current_buffer
->enable_multibyte_characters
))
4170 while (same_at_end
< ZV_BYTE
4171 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4174 /* Don't try to reuse the same piece of text twice. */
4175 overlap
= (same_at_start
- BEGV_BYTE
4176 - (same_at_end
+ st
.st_size
- ZV
));
4178 same_at_end
+= overlap
;
4180 /* Arrange to read only the nonmatching middle part of the file. */
4181 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4182 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4184 del_range_byte (same_at_start
, same_at_end
, 0);
4185 /* Insert from the file at the proper position. */
4186 temp
= BYTE_TO_CHAR (same_at_start
);
4187 SET_PT_BOTH (temp
, same_at_start
);
4189 /* If display currently starts at beginning of line,
4190 keep it that way. */
4191 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4192 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4194 replace_handled
= 1;
4198 /* If requested, replace the accessible part of the buffer
4199 with the file contents. Avoid replacing text at the
4200 beginning or end of the buffer that matches the file contents;
4201 that preserves markers pointing to the unchanged parts.
4203 Here we implement this feature for the case where code conversion
4204 is needed, in a simple way that needs a lot of memory.
4205 The preceding if-statement handles the case of no conversion
4206 in a more optimized way. */
4207 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4209 EMACS_INT same_at_start
= BEGV_BYTE
;
4210 EMACS_INT same_at_end
= ZV_BYTE
;
4211 EMACS_INT same_at_start_charpos
;
4212 EMACS_INT inserted_chars
;
4215 unsigned char *decoded
;
4217 int this_count
= SPECPDL_INDEX ();
4218 int multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
4219 Lisp_Object conversion_buffer
;
4221 conversion_buffer
= code_conversion_save (1, multibyte
);
4223 /* First read the whole file, performing code conversion into
4224 CONVERSION_BUFFER. */
4226 if (lseek (fd
, XINT (beg
), 0) < 0)
4227 report_file_error ("Setting file position",
4228 Fcons (orig_filename
, Qnil
));
4230 total
= st
.st_size
; /* Total bytes in the file. */
4231 how_much
= 0; /* Bytes read from file so far. */
4232 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4233 unprocessed
= 0; /* Bytes not processed in previous loop. */
4235 GCPRO1 (conversion_buffer
);
4236 while (how_much
< total
)
4238 /* We read one bunch by one (READ_BUF_SIZE bytes) to allow
4239 quitting while reading a huge while. */
4240 /* try is reserved in some compilers (Microsoft C) */
4241 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4244 /* Allow quitting out of the actual I/O. */
4247 this = emacs_read (fd
, read_buf
+ unprocessed
, trytry
);
4259 BUF_TEMP_SET_PT (XBUFFER (conversion_buffer
),
4260 BUF_Z (XBUFFER (conversion_buffer
)));
4261 decode_coding_c_string (&coding
, read_buf
, unprocessed
+ this,
4263 unprocessed
= coding
.carryover_bytes
;
4264 if (coding
.carryover_bytes
> 0)
4265 bcopy (coding
.carryover
, read_buf
, unprocessed
);
4270 /* At this point, HOW_MUCH should equal TOTAL, or should be <= 0
4271 if we couldn't read the file. */
4274 error ("IO error reading %s: %s",
4275 SDATA (orig_filename
), emacs_strerror (errno
));
4277 if (unprocessed
> 0)
4279 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4280 decode_coding_c_string (&coding
, read_buf
, unprocessed
,
4282 coding
.mode
&= ~CODING_MODE_LAST_BLOCK
;
4285 decoded
= BUF_BEG_ADDR (XBUFFER (conversion_buffer
));
4286 inserted
= (BUF_Z_BYTE (XBUFFER (conversion_buffer
))
4287 - BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
4289 /* Compare the beginning of the converted string with the buffer
4293 while (bufpos
< inserted
&& same_at_start
< same_at_end
4294 && FETCH_BYTE (same_at_start
) == decoded
[bufpos
])
4295 same_at_start
++, bufpos
++;
4297 /* If the file matches the head of buffer completely,
4298 there's no need to replace anything. */
4300 if (bufpos
== inserted
)
4303 /* Truncate the buffer to the size of the file. */
4304 if (same_at_start
== same_at_end
)
4307 del_range_byte (same_at_start
, same_at_end
, 0);
4310 unbind_to (this_count
, Qnil
);
4314 /* Extend the start of non-matching text area to the previous
4315 multibyte character boundary. */
4316 if (! NILP (current_buffer
->enable_multibyte_characters
))
4317 while (same_at_start
> BEGV_BYTE
4318 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4321 /* Scan this bufferful from the end, comparing with
4322 the Emacs buffer. */
4325 /* Compare with same_at_start to avoid counting some buffer text
4326 as matching both at the file's beginning and at the end. */
4327 while (bufpos
> 0 && same_at_end
> same_at_start
4328 && FETCH_BYTE (same_at_end
- 1) == decoded
[bufpos
- 1])
4329 same_at_end
--, bufpos
--;
4331 /* Extend the end of non-matching text area to the next
4332 multibyte character boundary. */
4333 if (! NILP (current_buffer
->enable_multibyte_characters
))
4334 while (same_at_end
< ZV_BYTE
4335 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4338 /* Don't try to reuse the same piece of text twice. */
4339 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4341 same_at_end
+= overlap
;
4343 /* If display currently starts at beginning of line,
4344 keep it that way. */
4345 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4346 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4348 /* Replace the chars that we need to replace,
4349 and update INSERTED to equal the number of bytes
4350 we are taking from the decoded string. */
4351 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4353 if (same_at_end
!= same_at_start
)
4355 del_range_byte (same_at_start
, same_at_end
, 0);
4357 same_at_start
= GPT_BYTE
;
4361 temp
= BYTE_TO_CHAR (same_at_start
);
4363 /* Insert from the file at the proper position. */
4364 SET_PT_BOTH (temp
, same_at_start
);
4365 same_at_start_charpos
4366 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4367 same_at_start
- BEGV_BYTE
4368 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
4370 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4371 same_at_start
+ inserted
- BEGV_BYTE
4372 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)))
4373 - same_at_start_charpos
);
4374 /* This binding is to avoid ask-user-about-supersession-threat
4375 being called in insert_from_buffer (via in
4376 prepare_to_modify_buffer). */
4377 specbind (intern ("buffer-file-name"), Qnil
);
4378 insert_from_buffer (XBUFFER (conversion_buffer
),
4379 same_at_start_charpos
, inserted_chars
, 0);
4380 /* Set `inserted' to the number of inserted characters. */
4381 inserted
= PT
- temp
;
4382 /* Set point before the inserted characters. */
4383 SET_PT_BOTH (temp
, same_at_start
);
4385 unbind_to (this_count
, Qnil
);
4392 register Lisp_Object temp
;
4394 total
= XINT (end
) - XINT (beg
);
4396 /* Make sure point-max won't overflow after this insertion. */
4397 XSETINT (temp
, total
);
4398 if (total
!= XINT (temp
))
4399 error ("Maximum buffer size exceeded");
4402 /* For a special file, all we can do is guess. */
4403 total
= READ_BUF_SIZE
;
4405 if (NILP (visit
) && inserted
> 0)
4407 #ifdef CLASH_DETECTION
4408 if (!NILP (current_buffer
->file_truename
)
4409 /* Make binding buffer-file-name to nil effective. */
4410 && !NILP (current_buffer
->filename
)
4411 && SAVE_MODIFF
>= MODIFF
)
4413 #endif /* CLASH_DETECTION */
4414 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
4418 if (GAP_SIZE
< total
)
4419 make_gap (total
- GAP_SIZE
);
4421 if (XINT (beg
) != 0 || !NILP (replace
))
4423 if (lseek (fd
, XINT (beg
), 0) < 0)
4424 report_file_error ("Setting file position",
4425 Fcons (orig_filename
, Qnil
));
4428 /* In the following loop, HOW_MUCH contains the total bytes read so
4429 far for a regular file, and not changed for a special file. But,
4430 before exiting the loop, it is set to a negative value if I/O
4434 /* Total bytes inserted. */
4437 /* Here, we don't do code conversion in the loop. It is done by
4438 decode_coding_gap after all data are read into the buffer. */
4440 int gap_size
= GAP_SIZE
;
4442 while (how_much
< total
)
4444 /* try is reserved in some compilers (Microsoft C) */
4445 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4452 /* Maybe make more room. */
4453 if (gap_size
< trytry
)
4455 make_gap (total
- gap_size
);
4456 gap_size
= GAP_SIZE
;
4459 /* Read from the file, capturing `quit'. When an
4460 error occurs, end the loop, and arrange for a quit
4461 to be signaled after decoding the text we read. */
4462 non_regular_fd
= fd
;
4463 non_regular_inserted
= inserted
;
4464 non_regular_nbytes
= trytry
;
4465 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4466 read_non_regular_quit
);
4477 /* Allow quitting out of the actual I/O. We don't make text
4478 part of the buffer until all the reading is done, so a C-g
4479 here doesn't do any harm. */
4482 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4494 /* For a regular file, where TOTAL is the real size,
4495 count HOW_MUCH to compare with it.
4496 For a special file, where TOTAL is just a buffer size,
4497 so don't bother counting in HOW_MUCH.
4498 (INSERTED is where we count the number of characters inserted.) */
4505 /* Now we have read all the file data into the gap.
4506 If it was empty, undo marking the buffer modified. */
4510 #ifdef CLASH_DETECTION
4512 unlock_file (current_buffer
->file_truename
);
4514 Vdeactivate_mark
= old_Vdeactivate_mark
;
4517 Vdeactivate_mark
= Qt
;
4519 /* Make the text read part of the buffer. */
4520 GAP_SIZE
-= inserted
;
4522 GPT_BYTE
+= inserted
;
4524 ZV_BYTE
+= inserted
;
4529 /* Put an anchor to ensure multi-byte form ends at gap. */
4534 /* Discard the unwind protect for closing the file. */
4538 error ("IO error reading %s: %s",
4539 SDATA (orig_filename
), emacs_strerror (errno
));
4543 if (NILP (coding_system
))
4545 /* The coding system is not yet decided. Decide it by an
4546 optimized method for handling `coding:' tag.
4548 Note that we can get here only if the buffer was empty
4549 before the insertion. */
4551 if (!NILP (Vcoding_system_for_read
))
4552 coding_system
= Vcoding_system_for_read
;
4555 /* Since we are sure that the current buffer was empty
4556 before the insertion, we can toggle
4557 enable-multibyte-characters directly here without taking
4558 care of marker adjustment. By this way, we can run Lisp
4559 program safely before decoding the inserted text. */
4560 Lisp_Object unwind_data
;
4561 int count
= SPECPDL_INDEX ();
4563 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4564 Fcons (current_buffer
->undo_list
,
4565 Fcurrent_buffer ()));
4566 current_buffer
->enable_multibyte_characters
= Qnil
;
4567 current_buffer
->undo_list
= Qt
;
4568 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4570 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4572 coding_system
= call2 (Vset_auto_coding_function
,
4573 filename
, make_number (inserted
));
4576 if (NILP (coding_system
))
4578 /* If the coding system is not yet decided, check
4579 file-coding-system-alist. */
4580 Lisp_Object args
[6];
4582 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4583 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4584 coding_system
= Ffind_operation_coding_system (6, args
);
4585 if (CONSP (coding_system
))
4586 coding_system
= XCAR (coding_system
);
4588 unbind_to (count
, Qnil
);
4589 inserted
= Z_BYTE
- BEG_BYTE
;
4592 if (NILP (coding_system
))
4593 coding_system
= Qundecided
;
4595 CHECK_CODING_SYSTEM (coding_system
);
4597 if (NILP (current_buffer
->enable_multibyte_characters
))
4598 /* We must suppress all character code conversion except for
4599 end-of-line conversion. */
4600 coding_system
= raw_text_coding_system (coding_system
);
4601 setup_coding_system (coding_system
, &coding
);
4602 /* Ensure we set Vlast_coding_system_used. */
4603 set_coding_system
= 1;
4608 /* When we visit a file by raw-text, we change the buffer to
4610 if (CODING_FOR_UNIBYTE (&coding
)
4611 /* Can't do this if part of the buffer might be preserved. */
4613 /* Visiting a file with these coding system makes the buffer
4615 current_buffer
->enable_multibyte_characters
= Qnil
;
4618 coding
.dst_multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
4619 if (CODING_MAY_REQUIRE_DECODING (&coding
)
4620 && (inserted
> 0 || CODING_REQUIRE_FLUSHING (&coding
)))
4622 move_gap_both (PT
, PT_BYTE
);
4623 GAP_SIZE
+= inserted
;
4624 ZV_BYTE
-= inserted
;
4628 decode_coding_gap (&coding
, inserted
, inserted
);
4629 inserted
= coding
.produced_char
;
4630 coding_system
= CODING_ID_NAME (coding
.id
);
4632 else if (inserted
> 0)
4633 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4636 /* Now INSERTED is measured in characters. */
4639 /* Use the conversion type to determine buffer-file-type
4640 (find-buffer-file-type is now used to help determine the
4642 if ((VECTORP (CODING_ID_EOL_TYPE (coding
.id
))
4643 || EQ (CODING_ID_EOL_TYPE (coding
.id
), Qunix
))
4644 && ! CODING_REQUIRE_DECODING (&coding
))
4645 current_buffer
->buffer_file_type
= Qt
;
4647 current_buffer
->buffer_file_type
= Qnil
;
4654 if (!EQ (current_buffer
->undo_list
, Qt
) && !nochange
)
4655 current_buffer
->undo_list
= Qnil
;
4659 current_buffer
->modtime
= st
.st_mtime
;
4660 current_buffer
->filename
= orig_filename
;
4663 SAVE_MODIFF
= MODIFF
;
4664 current_buffer
->auto_save_modified
= MODIFF
;
4665 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4666 #ifdef CLASH_DETECTION
4669 if (!NILP (current_buffer
->file_truename
))
4670 unlock_file (current_buffer
->file_truename
);
4671 unlock_file (filename
);
4673 #endif /* CLASH_DETECTION */
4675 xsignal2 (Qfile_error
,
4676 build_string ("not a regular file"), orig_filename
);
4679 if (set_coding_system
)
4680 Vlast_coding_system_used
= coding_system
;
4682 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4684 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4686 if (! NILP (insval
))
4688 CHECK_NUMBER (insval
);
4689 inserted
= XFASTINT (insval
);
4693 /* Decode file format */
4696 /* Don't run point motion or modification hooks when decoding. */
4697 int count
= SPECPDL_INDEX ();
4698 specbind (Qinhibit_point_motion_hooks
, Qt
);
4699 specbind (Qinhibit_modification_hooks
, Qt
);
4701 /* Save old undo list and don't record undo for decoding. */
4702 old_undo
= current_buffer
->undo_list
;
4703 current_buffer
->undo_list
= Qt
;
4707 insval
= call3 (Qformat_decode
,
4708 Qnil
, make_number (inserted
), visit
);
4709 CHECK_NUMBER (insval
);
4710 inserted
= XFASTINT (insval
);
4714 /* If REPLACE is non-nil and we succeeded in not replacing the
4715 beginning or end of the buffer text with the file's contents,
4716 call format-decode with `point' positioned at the beginning of
4717 the buffer and `inserted' equalling the number of characters
4718 in the buffer. Otherwise, format-decode might fail to
4719 correctly analyze the beginning or end of the buffer. Hence
4720 we temporarily save `point' and `inserted' here and restore
4721 `point' iff format-decode did not insert or delete any text.
4722 Otherwise we leave `point' at point-min. */
4724 int opoint_byte
= PT_BYTE
;
4725 int oinserted
= ZV
- BEGV
;
4726 int ochars_modiff
= CHARS_MODIFF
;
4728 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4729 insval
= call3 (Qformat_decode
,
4730 Qnil
, make_number (oinserted
), visit
);
4731 CHECK_NUMBER (insval
);
4732 if (ochars_modiff
== CHARS_MODIFF
)
4733 /* format_decode didn't modify buffer's characters => move
4734 point back to position before inserted text and leave
4735 value of inserted alone. */
4736 SET_PT_BOTH (opoint
, opoint_byte
);
4738 /* format_decode modified buffer's characters => consider
4739 entire buffer changed and leave point at point-min. */
4740 inserted
= XFASTINT (insval
);
4743 /* For consistency with format-decode call these now iff inserted > 0
4744 (martin 2007-06-28) */
4745 p
= Vafter_insert_file_functions
;
4750 insval
= call1 (XCAR (p
), make_number (inserted
));
4753 CHECK_NUMBER (insval
);
4754 inserted
= XFASTINT (insval
);
4759 /* For the rationale of this see the comment on format-decode above. */
4761 int opoint_byte
= PT_BYTE
;
4762 int oinserted
= ZV
- BEGV
;
4763 int ochars_modiff
= CHARS_MODIFF
;
4765 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4766 insval
= call1 (XCAR (p
), make_number (oinserted
));
4769 CHECK_NUMBER (insval
);
4770 if (ochars_modiff
== CHARS_MODIFF
)
4771 /* after_insert_file_functions didn't modify
4772 buffer's characters => move point back to
4773 position before inserted text and leave value of
4775 SET_PT_BOTH (opoint
, opoint_byte
);
4777 /* after_insert_file_functions did modify buffer's
4778 characters => consider entire buffer changed and
4779 leave point at point-min. */
4780 inserted
= XFASTINT (insval
);
4790 Lisp_Object lbeg
, lend
;
4792 XSETINT (lend
, PT
+ inserted
);
4793 if (CONSP (old_undo
))
4795 Lisp_Object tem
= XCAR (old_undo
);
4796 if (CONSP (tem
) && INTEGERP (XCAR (tem
)) &&
4797 INTEGERP (XCDR (tem
)) && EQ (XCAR (tem
), lbeg
))
4798 /* In the non-visiting case record only the final insertion. */
4799 current_buffer
->undo_list
=
4800 Fcons (Fcons (lbeg
, lend
), Fcdr (old_undo
));
4804 /* If undo_list was Qt before, keep it that way.
4805 Otherwise start with an empty undo_list. */
4806 current_buffer
->undo_list
= EQ (old_undo
, Qt
) ? Qt
: Qnil
;
4808 unbind_to (count
, Qnil
);
4811 /* Call after-change hooks for the inserted text, aside from the case
4812 of normal visiting (not with REPLACE), which is done in a new buffer
4813 "before" the buffer is changed. */
4814 if (inserted
> 0 && total
> 0
4815 && (NILP (visit
) || !NILP (replace
)))
4817 signal_after_change (PT
, 0, inserted
);
4818 update_compositions (PT
, PT
, CHECK_BORDER
);
4822 && current_buffer
->modtime
== -1)
4824 /* If visiting nonexistent file, return nil. */
4825 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4829 Fsignal (Qquit
, Qnil
);
4831 /* ??? Retval needs to be dealt with in all cases consistently. */
4833 val
= Fcons (orig_filename
,
4834 Fcons (make_number (inserted
),
4837 RETURN_UNGCPRO (unbind_to (count
, val
));
4840 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4842 /* If build_annotations switched buffers, switch back to BUF.
4843 Kill the temporary buffer that was selected in the meantime.
4845 Since this kill only the last temporary buffer, some buffers remain
4846 not killed if build_annotations switched buffers more than once.
4850 build_annotations_unwind (buf
)
4855 if (XBUFFER (buf
) == current_buffer
)
4857 tembuf
= Fcurrent_buffer ();
4859 Fkill_buffer (tembuf
);
4863 /* Decide the coding-system to encode the data with. */
4866 choose_write_coding_system (start
, end
, filename
,
4867 append
, visit
, lockname
, coding
)
4868 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4869 struct coding_system
*coding
;
4872 Lisp_Object eol_parent
= Qnil
;
4875 && NILP (Fstring_equal (current_buffer
->filename
,
4876 current_buffer
->auto_save_file_name
)))
4881 else if (!NILP (Vcoding_system_for_write
))
4883 val
= Vcoding_system_for_write
;
4884 if (coding_system_require_warning
4885 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4886 /* Confirm that VAL can surely encode the current region. */
4887 val
= call5 (Vselect_safe_coding_system_function
,
4888 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4893 /* If the variable `buffer-file-coding-system' is set locally,
4894 it means that the file was read with some kind of code
4895 conversion or the variable is explicitly set by users. We
4896 had better write it out with the same coding system even if
4897 `enable-multibyte-characters' is nil.
4899 If it is not set locally, we anyway have to convert EOL
4900 format if the default value of `buffer-file-coding-system'
4901 tells that it is not Unix-like (LF only) format. */
4902 int using_default_coding
= 0;
4903 int force_raw_text
= 0;
4905 val
= current_buffer
->buffer_file_coding_system
;
4907 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4910 if (NILP (current_buffer
->enable_multibyte_characters
))
4916 /* Check file-coding-system-alist. */
4917 Lisp_Object args
[7], coding_systems
;
4919 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4920 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4922 coding_systems
= Ffind_operation_coding_system (7, args
);
4923 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4924 val
= XCDR (coding_systems
);
4929 /* If we still have not decided a coding system, use the
4930 default value of buffer-file-coding-system. */
4931 val
= current_buffer
->buffer_file_coding_system
;
4932 using_default_coding
= 1;
4935 if (! NILP (val
) && ! force_raw_text
)
4937 Lisp_Object spec
, attrs
;
4939 CHECK_CODING_SYSTEM_GET_SPEC (val
, spec
);
4940 attrs
= AREF (spec
, 0);
4941 if (EQ (CODING_ATTR_TYPE (attrs
), Qraw_text
))
4946 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4947 /* Confirm that VAL can surely encode the current region. */
4948 val
= call5 (Vselect_safe_coding_system_function
,
4949 start
, end
, val
, Qnil
, filename
);
4951 /* If the decided coding-system doesn't specify end-of-line
4952 format, we use that of
4953 `default-buffer-file-coding-system'. */
4954 if (! using_default_coding
4955 && ! NILP (buffer_defaults
.buffer_file_coding_system
))
4956 val
= (coding_inherit_eol_type
4957 (val
, buffer_defaults
.buffer_file_coding_system
));
4959 /* If we decide not to encode text, use `raw-text' or one of its
4962 val
= raw_text_coding_system (val
);
4965 val
= coding_inherit_eol_type (val
, eol_parent
);
4966 setup_coding_system (val
, coding
);
4968 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4969 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4973 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4974 "r\nFWrite region to file: \ni\ni\ni\np",
4975 doc
: /* Write current region into specified file.
4976 When called from a program, requires three arguments:
4977 START, END and FILENAME. START and END are normally buffer positions
4978 specifying the part of the buffer to write.
4979 If START is nil, that means to use the entire buffer contents.
4980 If START is a string, then output that string to the file
4981 instead of any buffer contents; END is ignored.
4983 Optional fourth argument APPEND if non-nil means
4984 append to existing file contents (if any). If it is an integer,
4985 seek to that offset in the file before writing.
4986 Optional fifth argument VISIT, if t or a string, means
4987 set the last-save-file-modtime of buffer to this file's modtime
4988 and mark buffer not modified.
4989 If VISIT is a string, it is a second file name;
4990 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4991 VISIT is also the file name to lock and unlock for clash detection.
4992 If VISIT is neither t nor nil nor a string,
4993 that means do not display the \"Wrote file\" message.
4994 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4995 use for locking and unlocking, overriding FILENAME and VISIT.
4996 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4997 for an existing file with the same name. If MUSTBENEW is `excl',
4998 that means to get an error if the file already exists; never overwrite.
4999 If MUSTBENEW is neither nil nor `excl', that means ask for
5000 confirmation before overwriting, but do go ahead and overwrite the file
5001 if the user confirms.
5003 This does code conversion according to the value of
5004 `coding-system-for-write', `buffer-file-coding-system', or
5005 `file-coding-system-alist', and sets the variable
5006 `last-coding-system-used' to the coding system actually used. */)
5007 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
5008 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
5013 const unsigned char *fn
;
5015 int count
= SPECPDL_INDEX ();
5018 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
5020 Lisp_Object handler
;
5021 Lisp_Object visit_file
;
5022 Lisp_Object annotations
;
5023 Lisp_Object encoded_filename
;
5024 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
5025 int quietly
= !NILP (visit
);
5026 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5027 struct buffer
*given_buffer
;
5029 int buffer_file_type
= O_BINARY
;
5031 struct coding_system coding
;
5033 if (current_buffer
->base_buffer
&& visiting
)
5034 error ("Cannot do file visiting in an indirect buffer");
5036 if (!NILP (start
) && !STRINGP (start
))
5037 validate_region (&start
, &end
);
5040 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
5042 filename
= Fexpand_file_name (filename
, Qnil
);
5044 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
5045 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
5047 if (STRINGP (visit
))
5048 visit_file
= Fexpand_file_name (visit
, Qnil
);
5050 visit_file
= filename
;
5052 if (NILP (lockname
))
5053 lockname
= visit_file
;
5057 /* If the file name has special constructs in it,
5058 call the corresponding file handler. */
5059 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
5060 /* If FILENAME has no handler, see if VISIT has one. */
5061 if (NILP (handler
) && STRINGP (visit
))
5062 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
5064 if (!NILP (handler
))
5067 val
= call6 (handler
, Qwrite_region
, start
, end
,
5068 filename
, append
, visit
);
5072 SAVE_MODIFF
= MODIFF
;
5073 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5074 current_buffer
->filename
= visit_file
;
5080 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
5082 /* Special kludge to simplify auto-saving. */
5085 /* Do it later, so write-region-annotate-function can work differently
5086 if we save "the buffer" vs "a region".
5087 This is useful in tar-mode. --Stef
5088 XSETFASTINT (start, BEG);
5089 XSETFASTINT (end, Z); */
5093 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
5094 count1
= SPECPDL_INDEX ();
5096 given_buffer
= current_buffer
;
5098 if (!STRINGP (start
))
5100 annotations
= build_annotations (start
, end
);
5102 if (current_buffer
!= given_buffer
)
5104 XSETFASTINT (start
, BEGV
);
5105 XSETFASTINT (end
, ZV
);
5111 XSETFASTINT (start
, BEGV
);
5112 XSETFASTINT (end
, ZV
);
5117 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
5119 /* Decide the coding-system to encode the data with.
5120 We used to make this choice before calling build_annotations, but that
5121 leads to problems when a write-annotate-function takes care of
5122 unsavable chars (as was the case with X-Symbol). */
5123 Vlast_coding_system_used
5124 = choose_write_coding_system (start
, end
, filename
,
5125 append
, visit
, lockname
, &coding
);
5127 #ifdef CLASH_DETECTION
5130 #if 0 /* This causes trouble for GNUS. */
5131 /* If we've locked this file for some other buffer,
5132 query before proceeding. */
5133 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5134 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5137 lock_file (lockname
);
5139 #endif /* CLASH_DETECTION */
5141 encoded_filename
= ENCODE_FILE (filename
);
5143 fn
= SDATA (encoded_filename
);
5147 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5148 #else /* not DOS_NT */
5149 desc
= emacs_open (fn
, O_WRONLY
, 0);
5150 #endif /* not DOS_NT */
5152 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5154 if (auto_saving
) /* Overwrite any previous version of autosave file */
5156 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5157 desc
= emacs_open (fn
, O_RDWR
, 0);
5159 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5160 ? SDATA (current_buffer
->filename
) : 0,
5163 else /* Write to temporary name and rename if no errors */
5165 Lisp_Object temp_name
;
5166 temp_name
= Ffile_name_directory (filename
);
5168 if (!NILP (temp_name
))
5170 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5171 build_string ("$$SAVE$$")));
5172 fname
= SDATA (filename
);
5173 fn
= SDATA (temp_name
);
5174 desc
= creat_copy_attrs (fname
, fn
);
5177 /* If we can't open the temporary file, try creating a new
5178 version of the original file. VMS "creat" creates a
5179 new version rather than truncating an existing file. */
5182 desc
= creat (fn
, 0666);
5183 #if 0 /* This can clobber an existing file and fail to replace it,
5184 if the user runs out of space. */
5187 /* We can't make a new version;
5188 try to truncate and rewrite existing version if any. */
5190 desc
= emacs_open (fn
, O_RDWR
, 0);
5196 desc
= creat (fn
, 0666);
5200 desc
= emacs_open (fn
,
5201 O_WRONLY
| O_CREAT
| buffer_file_type
5202 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5203 S_IREAD
| S_IWRITE
);
5204 #else /* not DOS_NT */
5205 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5206 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5207 auto_saving
? auto_save_mode_bits
: 0666);
5208 #endif /* not DOS_NT */
5209 #endif /* not VMS */
5213 #ifdef CLASH_DETECTION
5215 if (!auto_saving
) unlock_file (lockname
);
5217 #endif /* CLASH_DETECTION */
5219 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5222 record_unwind_protect (close_file_unwind
, make_number (desc
));
5224 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5228 if (NUMBERP (append
))
5229 ret
= lseek (desc
, XINT (append
), 1);
5231 ret
= lseek (desc
, 0, 2);
5234 #ifdef CLASH_DETECTION
5235 if (!auto_saving
) unlock_file (lockname
);
5236 #endif /* CLASH_DETECTION */
5238 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5246 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5247 * if we do writes that don't end with a carriage return. Furthermore
5248 * it cannot handle writes of more then 16K. The modified
5249 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5250 * this EXCEPT for the last record (if it doesn't end with a carriage
5251 * return). This implies that if your buffer doesn't end with a carriage
5252 * return, you get one free... tough. However it also means that if
5253 * we make two calls to sys_write (a la the following code) you can
5254 * get one at the gap as well. The easiest way to fix this (honest)
5255 * is to move the gap to the next newline (or the end of the buffer).
5260 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5261 move_gap (find_next_newline (GPT
, 1));
5264 /* The new encoding routine doesn't require the following. */
5266 /* Whether VMS or not, we must move the gap to the next of newline
5267 when we must put designation sequences at beginning of line. */
5268 if (INTEGERP (start
)
5269 && coding
.type
== coding_type_iso2022
5270 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5271 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5273 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5274 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5275 move_gap_both (PT
, PT_BYTE
);
5276 SET_PT_BOTH (opoint
, opoint_byte
);
5284 if (STRINGP (start
))
5286 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5287 &annotations
, &coding
);
5290 else if (XINT (start
) != XINT (end
))
5292 failure
= 0 > a_write (desc
, Qnil
,
5293 XINT (start
), XINT (end
) - XINT (start
),
5294 &annotations
, &coding
);
5299 /* If file was empty, still need to write the annotations */
5300 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5301 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5305 if (CODING_REQUIRE_FLUSHING (&coding
)
5306 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5309 /* We have to flush out a data. */
5310 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5311 failure
= 0 > e_write (desc
, Qnil
, 1, 1, &coding
);
5318 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5319 Disk full in NFS may be reported here. */
5320 /* mib says that closing the file will try to write as fast as NFS can do
5321 it, and that means the fsync here is not crucial for autosave files. */
5322 if (!auto_saving
&& !write_region_inhibit_fsync
&& fsync (desc
) < 0)
5324 /* If fsync fails with EINTR, don't treat that as serious. Also
5325 ignore EINVAL which happens when fsync is not supported on this
5327 if (errno
!= EINTR
&& errno
!= EINVAL
)
5328 failure
= 1, save_errno
= errno
;
5332 /* Spurious "file has changed on disk" warnings have been
5333 observed on Suns as well.
5334 It seems that `close' can change the modtime, under nfs.
5336 (This has supposedly been fixed in Sunos 4,
5337 but who knows about all the other machines with NFS?) */
5340 /* On VMS, must do the stat after the close
5341 since closing changes the modtime. */
5343 /* Recall that #if defined does not work on VMS. */
5349 /* NFS can report a write failure now. */
5350 if (emacs_close (desc
) < 0)
5351 failure
= 1, save_errno
= errno
;
5354 /* If we wrote to a temporary name and had no errors, rename to real name. */
5358 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5366 /* Discard the unwind protect for close_file_unwind. */
5367 specpdl_ptr
= specpdl
+ count1
;
5368 /* Restore the original current buffer. */
5369 visit_file
= unbind_to (count
, visit_file
);
5371 #ifdef CLASH_DETECTION
5373 unlock_file (lockname
);
5374 #endif /* CLASH_DETECTION */
5376 /* Do this before reporting IO error
5377 to avoid a "file has changed on disk" warning on
5378 next attempt to save. */
5380 current_buffer
->modtime
= st
.st_mtime
;
5383 error ("IO error writing %s: %s", SDATA (filename
),
5384 emacs_strerror (save_errno
));
5388 SAVE_MODIFF
= MODIFF
;
5389 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5390 current_buffer
->filename
= visit_file
;
5391 update_mode_lines
++;
5396 && ! NILP (Fstring_equal (current_buffer
->filename
,
5397 current_buffer
->auto_save_file_name
)))
5398 SAVE_MODIFF
= MODIFF
;
5404 message_with_string ((INTEGERP (append
)
5414 Lisp_Object
merge ();
5416 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5417 doc
: /* Return t if (car A) is numerically less than (car B). */)
5421 return Flss (Fcar (a
), Fcar (b
));
5424 /* Build the complete list of annotations appropriate for writing out
5425 the text between START and END, by calling all the functions in
5426 write-region-annotate-functions and merging the lists they return.
5427 If one of these functions switches to a different buffer, we assume
5428 that buffer contains altered text. Therefore, the caller must
5429 make sure to restore the current buffer in all cases,
5430 as save-excursion would do. */
5433 build_annotations (start
, end
)
5434 Lisp_Object start
, end
;
5436 Lisp_Object annotations
;
5438 struct gcpro gcpro1
, gcpro2
;
5439 Lisp_Object original_buffer
;
5440 int i
, used_global
= 0;
5442 XSETBUFFER (original_buffer
, current_buffer
);
5445 p
= Vwrite_region_annotate_functions
;
5446 GCPRO2 (annotations
, p
);
5449 struct buffer
*given_buffer
= current_buffer
;
5450 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5451 { /* Use the global value of the hook. */
5454 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5456 p
= Fappend (2, arg
);
5459 Vwrite_region_annotations_so_far
= annotations
;
5460 res
= call2 (XCAR (p
), start
, end
);
5461 /* If the function makes a different buffer current,
5462 assume that means this buffer contains altered text to be output.
5463 Reset START and END from the buffer bounds
5464 and discard all previous annotations because they should have
5465 been dealt with by this function. */
5466 if (current_buffer
!= given_buffer
)
5468 XSETFASTINT (start
, BEGV
);
5469 XSETFASTINT (end
, ZV
);
5472 Flength (res
); /* Check basic validity of return value */
5473 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5477 /* Now do the same for annotation functions implied by the file-format */
5478 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
5479 p
= current_buffer
->auto_save_file_format
;
5481 p
= current_buffer
->file_format
;
5482 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5484 struct buffer
*given_buffer
= current_buffer
;
5486 Vwrite_region_annotations_so_far
= annotations
;
5488 /* Value is either a list of annotations or nil if the function
5489 has written annotations to a temporary buffer, which is now
5491 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5492 original_buffer
, make_number (i
));
5493 if (current_buffer
!= given_buffer
)
5495 XSETFASTINT (start
, BEGV
);
5496 XSETFASTINT (end
, ZV
);
5501 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5509 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5510 If STRING is nil, POS is the character position in the current buffer.
5511 Intersperse with them the annotations from *ANNOT
5512 which fall within the range of POS to POS + NCHARS,
5513 each at its appropriate position.
5515 We modify *ANNOT by discarding elements as we use them up.
5517 The return value is negative in case of system call failure. */
5520 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5523 register int nchars
;
5526 struct coding_system
*coding
;
5530 int lastpos
= pos
+ nchars
;
5532 while (NILP (*annot
) || CONSP (*annot
))
5534 tem
= Fcar_safe (Fcar (*annot
));
5537 nextpos
= XFASTINT (tem
);
5539 /* If there are no more annotations in this range,
5540 output the rest of the range all at once. */
5541 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5542 return e_write (desc
, string
, pos
, lastpos
, coding
);
5544 /* Output buffer text up to the next annotation's position. */
5547 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5551 /* Output the annotation. */
5552 tem
= Fcdr (Fcar (*annot
));
5555 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5558 *annot
= Fcdr (*annot
);
5564 /* Write text in the range START and END into descriptor DESC,
5565 encoding them with coding system CODING. If STRING is nil, START
5566 and END are character positions of the current buffer, else they
5567 are indexes to the string STRING. */
5570 e_write (desc
, string
, start
, end
, coding
)
5574 struct coding_system
*coding
;
5576 if (STRINGP (string
))
5579 end
= SCHARS (string
);
5582 /* We used to have a code for handling selective display here. But,
5583 now it is handled within encode_coding. */
5587 if (STRINGP (string
))
5589 coding
->src_multibyte
= SCHARS (string
) < SBYTES (string
);
5590 if (CODING_REQUIRE_ENCODING (coding
))
5592 encode_coding_object (coding
, string
,
5593 start
, string_char_to_byte (string
, start
),
5594 end
, string_char_to_byte (string
, end
), Qt
);
5598 coding
->dst_object
= string
;
5599 coding
->consumed_char
= SCHARS (string
);
5600 coding
->produced
= SBYTES (string
);
5605 int start_byte
= CHAR_TO_BYTE (start
);
5606 int end_byte
= CHAR_TO_BYTE (end
);
5608 coding
->src_multibyte
= (end
- start
) < (end_byte
- start_byte
);
5609 if (CODING_REQUIRE_ENCODING (coding
))
5611 encode_coding_object (coding
, Fcurrent_buffer (),
5612 start
, start_byte
, end
, end_byte
, Qt
);
5616 coding
->dst_object
= Qnil
;
5617 coding
->dst_pos_byte
= start_byte
;
5618 if (start
>= GPT
|| end
<= GPT
)
5620 coding
->consumed_char
= end
- start
;
5621 coding
->produced
= end_byte
- start_byte
;
5625 coding
->consumed_char
= GPT
- start
;
5626 coding
->produced
= GPT_BYTE
- start_byte
;
5631 if (coding
->produced
> 0)
5635 STRINGP (coding
->dst_object
)
5636 ? SDATA (coding
->dst_object
)
5637 : BYTE_POS_ADDR (coding
->dst_pos_byte
),
5640 if (coding
->produced
)
5643 start
+= coding
->consumed_char
;
5649 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5650 Sverify_visited_file_modtime
, 1, 1, 0,
5651 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5652 This means that the file has not been changed since it was visited or saved.
5653 See Info node `(elisp)Modification Time' for more details. */)
5659 Lisp_Object handler
;
5660 Lisp_Object filename
;
5665 if (!STRINGP (b
->filename
)) return Qt
;
5666 if (b
->modtime
== 0) return Qt
;
5668 /* If the file name has special constructs in it,
5669 call the corresponding file handler. */
5670 handler
= Ffind_file_name_handler (b
->filename
,
5671 Qverify_visited_file_modtime
);
5672 if (!NILP (handler
))
5673 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5675 filename
= ENCODE_FILE (b
->filename
);
5677 if (stat (SDATA (filename
), &st
) < 0)
5679 /* If the file doesn't exist now and didn't exist before,
5680 we say that it isn't modified, provided the error is a tame one. */
5681 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5686 if (st
.st_mtime
== b
->modtime
5687 /* If both are positive, accept them if they are off by one second. */
5688 || (st
.st_mtime
> 0 && b
->modtime
> 0
5689 && (st
.st_mtime
== b
->modtime
+ 1
5690 || st
.st_mtime
== b
->modtime
- 1)))
5695 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5696 Sclear_visited_file_modtime
, 0, 0, 0,
5697 doc
: /* Clear out records of last mod time of visited file.
5698 Next attempt to save will certainly not complain of a discrepancy. */)
5701 current_buffer
->modtime
= 0;
5705 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5706 Svisited_file_modtime
, 0, 0, 0,
5707 doc
: /* Return the current buffer's recorded visited file modification time.
5708 The value is a list of the form (HIGH LOW), like the time values
5709 that `file-attributes' returns. If the current buffer has no recorded
5710 file modification time, this function returns 0.
5711 See Info node `(elisp)Modification Time' for more details. */)
5714 if (! current_buffer
->modtime
)
5715 return make_number (0);
5716 return make_time ((time_t) current_buffer
->modtime
);
5719 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5720 Sset_visited_file_modtime
, 0, 1, 0,
5721 doc
: /* Update buffer's recorded modification time from the visited file's time.
5722 Useful if the buffer was not read from the file normally
5723 or if the file itself has been changed for some known benign reason.
5724 An argument specifies the modification time value to use
5725 \(instead of that of the visited file), in the form of a list
5726 \(HIGH . LOW) or (HIGH LOW). */)
5728 Lisp_Object time_list
;
5730 if (!NILP (time_list
))
5731 current_buffer
->modtime
= cons_to_long (time_list
);
5734 register Lisp_Object filename
;
5736 Lisp_Object handler
;
5738 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5740 /* If the file name has special constructs in it,
5741 call the corresponding file handler. */
5742 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5743 if (!NILP (handler
))
5744 /* The handler can find the file name the same way we did. */
5745 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5747 filename
= ENCODE_FILE (filename
);
5749 if (stat (SDATA (filename
), &st
) >= 0)
5750 current_buffer
->modtime
= st
.st_mtime
;
5757 auto_save_error (error
)
5760 Lisp_Object args
[3], msg
;
5762 struct gcpro gcpro1
;
5766 auto_save_error_occurred
= 1;
5768 ring_bell (XFRAME (selected_frame
));
5770 args
[0] = build_string ("Auto-saving %s: %s");
5771 args
[1] = current_buffer
->name
;
5772 args
[2] = Ferror_message_string (error
);
5773 msg
= Fformat (3, args
);
5775 nbytes
= SBYTES (msg
);
5776 SAFE_ALLOCA (msgbuf
, char *, nbytes
);
5777 bcopy (SDATA (msg
), msgbuf
, nbytes
);
5779 for (i
= 0; i
< 3; ++i
)
5782 message2 (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5784 message2_nolog (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5785 Fsleep_for (make_number (1), Qnil
);
5799 auto_save_mode_bits
= 0666;
5801 /* Get visited file's mode to become the auto save file's mode. */
5802 if (! NILP (current_buffer
->filename
))
5804 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5805 /* But make sure we can overwrite it later! */
5806 auto_save_mode_bits
= st
.st_mode
| 0600;
5807 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5809 /* Remote files don't cooperate with stat. */
5810 auto_save_mode_bits
= XINT (modes
) | 0600;
5814 Fwrite_region (Qnil
, Qnil
,
5815 current_buffer
->auto_save_file_name
,
5816 Qnil
, Qlambda
, Qnil
, Qnil
);
5820 do_auto_save_unwind (arg
) /* used as unwind-protect function */
5823 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
5835 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5838 minibuffer_auto_raise
= XINT (value
);
5843 do_auto_save_make_dir (dir
)
5848 call2 (Qmake_directory
, dir
, Qt
);
5849 XSETFASTINT (mode
, 0700);
5850 return Fset_file_modes (dir
, mode
);
5854 do_auto_save_eh (ignore
)
5860 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5861 doc
: /* Auto-save all buffers that need it.
5862 This is all buffers that have auto-saving enabled
5863 and are changed since last auto-saved.
5864 Auto-saving writes the buffer into a file
5865 so that your editing is not lost if the system crashes.
5866 This file is not the file you visited; that changes only when you save.
5867 Normally we run the normal hook `auto-save-hook' before saving.
5869 A non-nil NO-MESSAGE argument means do not print any message if successful.
5870 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5871 (no_message
, current_only
)
5872 Lisp_Object no_message
, current_only
;
5874 struct buffer
*old
= current_buffer
, *b
;
5875 Lisp_Object tail
, buf
;
5877 int do_handled_files
;
5879 FILE *stream
= NULL
;
5880 int count
= SPECPDL_INDEX ();
5881 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5882 int old_message_p
= 0;
5883 struct gcpro gcpro1
, gcpro2
;
5885 if (max_specpdl_size
< specpdl_size
+ 40)
5886 max_specpdl_size
= specpdl_size
+ 40;
5891 if (NILP (no_message
))
5893 old_message_p
= push_message ();
5894 record_unwind_protect (pop_message_unwind
, Qnil
);
5897 /* Ordinarily don't quit within this function,
5898 but don't make it impossible to quit (in case we get hung in I/O). */
5902 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5903 point to non-strings reached from Vbuffer_alist. */
5905 if (!NILP (Vrun_hooks
))
5906 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5908 if (STRINGP (Vauto_save_list_file_name
))
5910 Lisp_Object listfile
;
5912 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5914 /* Don't try to create the directory when shutting down Emacs,
5915 because creating the directory might signal an error, and
5916 that would leave Emacs in a strange state. */
5917 if (!NILP (Vrun_hooks
))
5921 GCPRO2 (dir
, listfile
);
5922 dir
= Ffile_name_directory (listfile
);
5923 if (NILP (Ffile_directory_p (dir
)))
5924 internal_condition_case_1 (do_auto_save_make_dir
,
5925 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5930 stream
= fopen (SDATA (listfile
), "w");
5933 record_unwind_protect (do_auto_save_unwind
,
5934 make_save_value (stream
, 0));
5935 record_unwind_protect (do_auto_save_unwind_1
,
5936 make_number (minibuffer_auto_raise
));
5937 minibuffer_auto_raise
= 0;
5939 auto_save_error_occurred
= 0;
5941 /* On first pass, save all files that don't have handlers.
5942 On second pass, save all files that do have handlers.
5944 If Emacs is crashing, the handlers may tweak what is causing
5945 Emacs to crash in the first place, and it would be a shame if
5946 Emacs failed to autosave perfectly ordinary files because it
5947 couldn't handle some ange-ftp'd file. */
5949 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5950 for (tail
= Vbuffer_alist
; CONSP (tail
); tail
= XCDR (tail
))
5952 buf
= XCDR (XCAR (tail
));
5955 /* Record all the buffers that have auto save mode
5956 in the special file that lists them. For each of these buffers,
5957 Record visited name (if any) and auto save name. */
5958 if (STRINGP (b
->auto_save_file_name
)
5959 && stream
!= NULL
&& do_handled_files
== 0)
5962 if (!NILP (b
->filename
))
5964 fwrite (SDATA (b
->filename
), 1,
5965 SBYTES (b
->filename
), stream
);
5967 putc ('\n', stream
);
5968 fwrite (SDATA (b
->auto_save_file_name
), 1,
5969 SBYTES (b
->auto_save_file_name
), stream
);
5970 putc ('\n', stream
);
5974 if (!NILP (current_only
)
5975 && b
!= current_buffer
)
5978 /* Don't auto-save indirect buffers.
5979 The base buffer takes care of it. */
5983 /* Check for auto save enabled
5984 and file changed since last auto save
5985 and file changed since last real save. */
5986 if (STRINGP (b
->auto_save_file_name
)
5987 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5988 && b
->auto_save_modified
< BUF_MODIFF (b
)
5989 /* -1 means we've turned off autosaving for a while--see below. */
5990 && XINT (b
->save_length
) >= 0
5991 && (do_handled_files
5992 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5995 EMACS_TIME before_time
, after_time
;
5997 EMACS_GET_TIME (before_time
);
5999 /* If we had a failure, don't try again for 20 minutes. */
6000 if (b
->auto_save_failure_time
>= 0
6001 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
6004 if ((XFASTINT (b
->save_length
) * 10
6005 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
6006 /* A short file is likely to change a large fraction;
6007 spare the user annoying messages. */
6008 && XFASTINT (b
->save_length
) > 5000
6009 /* These messages are frequent and annoying for `*mail*'. */
6010 && !EQ (b
->filename
, Qnil
)
6011 && NILP (no_message
))
6013 /* It has shrunk too much; turn off auto-saving here. */
6014 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
6015 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
6017 minibuffer_auto_raise
= 0;
6018 /* Turn off auto-saving until there's a real save,
6019 and prevent any more warnings. */
6020 XSETINT (b
->save_length
, -1);
6021 Fsleep_for (make_number (1), Qnil
);
6024 set_buffer_internal (b
);
6025 if (!auto_saved
&& NILP (no_message
))
6026 message1 ("Auto-saving...");
6027 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
6029 b
->auto_save_modified
= BUF_MODIFF (b
);
6030 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6031 set_buffer_internal (old
);
6033 EMACS_GET_TIME (after_time
);
6035 /* If auto-save took more than 60 seconds,
6036 assume it was an NFS failure that got a timeout. */
6037 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
6038 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
6042 /* Prevent another auto save till enough input events come in. */
6043 record_auto_save ();
6045 if (auto_saved
&& NILP (no_message
))
6049 /* If we are going to restore an old message,
6050 give time to read ours. */
6051 sit_for (make_number (1), 0, 0);
6054 else if (!auto_save_error_occurred
)
6055 /* Don't overwrite the error message if an error occurred.
6056 If we displayed a message and then restored a state
6057 with no message, leave a "done" message on the screen. */
6058 message1 ("Auto-saving...done");
6063 /* This restores the message-stack status. */
6064 unbind_to (count
, Qnil
);
6068 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
6069 Sset_buffer_auto_saved
, 0, 0, 0,
6070 doc
: /* Mark current buffer as auto-saved with its current text.
6071 No auto-save file will be written until the buffer changes again. */)
6074 current_buffer
->auto_save_modified
= MODIFF
;
6075 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6076 current_buffer
->auto_save_failure_time
= -1;
6080 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
6081 Sclear_buffer_auto_save_failure
, 0, 0, 0,
6082 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
6085 current_buffer
->auto_save_failure_time
= -1;
6089 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6091 doc
: /* Return t if current buffer has been auto-saved recently.
6092 More precisely, if it has been auto-saved since last read from or saved
6093 in the visited file. If the buffer has no visited file,
6094 then any auto-save counts as "recent". */)
6097 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6100 /* Reading and completing file names */
6102 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
6103 Snext_read_file_uses_dialog_p
, 0, 0, 0,
6104 doc
: /* Return t if a call to `read-file-name' will use a dialog.
6105 The return value is only relevant for a call to `read-file-name' that happens
6106 before any other event (mouse or keypress) is handeled. */)
6109 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6110 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6120 Fread_file_name (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6121 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6123 struct gcpro gcpro1
, gcpro2
;
6124 Lisp_Object args
[7];
6126 GCPRO1 (default_filename
);
6127 args
[0] = intern ("read-file-name");
6130 args
[3] = default_filename
;
6131 args
[4] = mustmatch
;
6133 args
[6] = predicate
;
6134 RETURN_UNGCPRO (Ffuncall (7, args
));
6141 /* Must be set before any path manipulation is performed. */
6142 XSETFASTINT (Vdirectory_sep_char
, '/');
6149 Qoperations
= intern ("operations");
6150 Qexpand_file_name
= intern ("expand-file-name");
6151 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6152 Qdirectory_file_name
= intern ("directory-file-name");
6153 Qfile_name_directory
= intern ("file-name-directory");
6154 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6155 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6156 Qfile_name_as_directory
= intern ("file-name-as-directory");
6157 Qcopy_file
= intern ("copy-file");
6158 Qmake_directory_internal
= intern ("make-directory-internal");
6159 Qmake_directory
= intern ("make-directory");
6160 Qdelete_directory
= intern ("delete-directory");
6161 Qdelete_file
= intern ("delete-file");
6162 Qrename_file
= intern ("rename-file");
6163 Qadd_name_to_file
= intern ("add-name-to-file");
6164 Qmake_symbolic_link
= intern ("make-symbolic-link");
6165 Qfile_exists_p
= intern ("file-exists-p");
6166 Qfile_executable_p
= intern ("file-executable-p");
6167 Qfile_readable_p
= intern ("file-readable-p");
6168 Qfile_writable_p
= intern ("file-writable-p");
6169 Qfile_symlink_p
= intern ("file-symlink-p");
6170 Qaccess_file
= intern ("access-file");
6171 Qfile_directory_p
= intern ("file-directory-p");
6172 Qfile_regular_p
= intern ("file-regular-p");
6173 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6174 Qfile_modes
= intern ("file-modes");
6175 Qset_file_modes
= intern ("set-file-modes");
6176 Qset_file_times
= intern ("set-file-times");
6177 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6178 Qinsert_file_contents
= intern ("insert-file-contents");
6179 Qwrite_region
= intern ("write-region");
6180 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6181 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6182 Qauto_save_coding
= intern ("auto-save-coding");
6184 staticpro (&Qoperations
);
6185 staticpro (&Qexpand_file_name
);
6186 staticpro (&Qsubstitute_in_file_name
);
6187 staticpro (&Qdirectory_file_name
);
6188 staticpro (&Qfile_name_directory
);
6189 staticpro (&Qfile_name_nondirectory
);
6190 staticpro (&Qunhandled_file_name_directory
);
6191 staticpro (&Qfile_name_as_directory
);
6192 staticpro (&Qcopy_file
);
6193 staticpro (&Qmake_directory_internal
);
6194 staticpro (&Qmake_directory
);
6195 staticpro (&Qdelete_directory
);
6196 staticpro (&Qdelete_file
);
6197 staticpro (&Qrename_file
);
6198 staticpro (&Qadd_name_to_file
);
6199 staticpro (&Qmake_symbolic_link
);
6200 staticpro (&Qfile_exists_p
);
6201 staticpro (&Qfile_executable_p
);
6202 staticpro (&Qfile_readable_p
);
6203 staticpro (&Qfile_writable_p
);
6204 staticpro (&Qaccess_file
);
6205 staticpro (&Qfile_symlink_p
);
6206 staticpro (&Qfile_directory_p
);
6207 staticpro (&Qfile_regular_p
);
6208 staticpro (&Qfile_accessible_directory_p
);
6209 staticpro (&Qfile_modes
);
6210 staticpro (&Qset_file_modes
);
6211 staticpro (&Qset_file_times
);
6212 staticpro (&Qfile_newer_than_file_p
);
6213 staticpro (&Qinsert_file_contents
);
6214 staticpro (&Qwrite_region
);
6215 staticpro (&Qverify_visited_file_modtime
);
6216 staticpro (&Qset_visited_file_modtime
);
6217 staticpro (&Qauto_save_coding
);
6219 Qfile_name_history
= intern ("file-name-history");
6220 Fset (Qfile_name_history
, Qnil
);
6221 staticpro (&Qfile_name_history
);
6223 Qfile_error
= intern ("file-error");
6224 staticpro (&Qfile_error
);
6225 Qfile_already_exists
= intern ("file-already-exists");
6226 staticpro (&Qfile_already_exists
);
6227 Qfile_date_error
= intern ("file-date-error");
6228 staticpro (&Qfile_date_error
);
6229 Qexcl
= intern ("excl");
6233 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6234 staticpro (&Qfind_buffer_file_type
);
6237 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6238 doc
: /* *Coding system for encoding file names.
6239 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6240 Vfile_name_coding_system
= Qnil
;
6242 DEFVAR_LISP ("default-file-name-coding-system",
6243 &Vdefault_file_name_coding_system
,
6244 doc
: /* Default coding system for encoding file names.
6245 This variable is used only when `file-name-coding-system' is nil.
6247 This variable is set/changed by the command `set-language-environment'.
6248 User should not set this variable manually,
6249 instead use `file-name-coding-system' to get a constant encoding
6250 of file names regardless of the current language environment. */);
6251 Vdefault_file_name_coding_system
= Qnil
;
6253 Qformat_decode
= intern ("format-decode");
6254 staticpro (&Qformat_decode
);
6255 Qformat_annotate_function
= intern ("format-annotate-function");
6256 staticpro (&Qformat_annotate_function
);
6257 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6258 staticpro (&Qafter_insert_file_set_coding
);
6260 Qcar_less_than_car
= intern ("car-less-than-car");
6261 staticpro (&Qcar_less_than_car
);
6263 Fput (Qfile_error
, Qerror_conditions
,
6264 list2 (Qfile_error
, Qerror
));
6265 Fput (Qfile_error
, Qerror_message
,
6266 build_string ("File error"));
6268 Fput (Qfile_already_exists
, Qerror_conditions
,
6269 list3 (Qfile_already_exists
, Qfile_error
, Qerror
));
6270 Fput (Qfile_already_exists
, Qerror_message
,
6271 build_string ("File already exists"));
6273 Fput (Qfile_date_error
, Qerror_conditions
,
6274 list3 (Qfile_date_error
, Qfile_error
, Qerror
));
6275 Fput (Qfile_date_error
, Qerror_message
,
6276 build_string ("Cannot set file date"));
6278 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6279 doc
: /* *Non-nil means write new files with record format `stmlf'.
6280 nil means use format `var'. This variable is meaningful only on VMS. */);
6281 vms_stmlf_recfm
= 0;
6283 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6284 doc
: /* Directory separator character for built-in functions that return file names.
6285 The value is always ?/. Don't use this variable, just use `/'. */);
6287 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6288 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6289 If a file name matches REGEXP, then all I/O on that file is done by calling
6292 The first argument given to HANDLER is the name of the I/O primitive
6293 to be handled; the remaining arguments are the arguments that were
6294 passed to that primitive. For example, if you do
6295 (file-exists-p FILENAME)
6296 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6297 (funcall HANDLER 'file-exists-p FILENAME)
6298 The function `find-file-name-handler' checks this list for a handler
6299 for its argument. */);
6300 Vfile_name_handler_alist
= Qnil
;
6302 DEFVAR_LISP ("set-auto-coding-function",
6303 &Vset_auto_coding_function
,
6304 doc
: /* If non-nil, a function to call to decide a coding system of file.
6305 Two arguments are passed to this function: the file name
6306 and the length of a file contents following the point.
6307 This function should return a coding system to decode the file contents.
6308 It should check the file name against `auto-coding-alist'.
6309 If no coding system is decided, it should check a coding system
6310 specified in the heading lines with the format:
6311 -*- ... coding: CODING-SYSTEM; ... -*-
6312 or local variable spec of the tailing lines with `coding:' tag. */);
6313 Vset_auto_coding_function
= Qnil
;
6315 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6316 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6317 Each is passed one argument, the number of characters inserted,
6318 with point at the start of the inserted text. Each function
6319 should leave point the same, and return the new character count.
6320 If `insert-file-contents' is intercepted by a handler from
6321 `file-name-handler-alist', that handler is responsible for calling the
6322 functions in `after-insert-file-functions' if appropriate. */);
6323 Vafter_insert_file_functions
= Qnil
;
6325 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6326 doc
: /* A list of functions to be called at the start of `write-region'.
6327 Each is passed two arguments, START and END as for `write-region'.
6328 These are usually two numbers but not always; see the documentation
6329 for `write-region'. The function should return a list of pairs
6330 of the form (POSITION . STRING), consisting of strings to be effectively
6331 inserted at the specified positions of the file being written (1 means to
6332 insert before the first byte written). The POSITIONs must be sorted into
6333 increasing order. If there are several functions in the list, the several
6334 lists are merged destructively. Alternatively, the function can return
6335 with a different buffer current; in that case it should pay attention
6336 to the annotations returned by previous functions and listed in
6337 `write-region-annotations-so-far'.*/);
6338 Vwrite_region_annotate_functions
= Qnil
;
6339 staticpro (&Qwrite_region_annotate_functions
);
6340 Qwrite_region_annotate_functions
6341 = intern ("write-region-annotate-functions");
6343 DEFVAR_LISP ("write-region-annotations-so-far",
6344 &Vwrite_region_annotations_so_far
,
6345 doc
: /* When an annotation function is called, this holds the previous annotations.
6346 These are the annotations made by other annotation functions
6347 that were already called. See also `write-region-annotate-functions'. */);
6348 Vwrite_region_annotations_so_far
= Qnil
;
6350 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6351 doc
: /* A list of file name handlers that temporarily should not be used.
6352 This applies only to the operation `inhibit-file-name-operation'. */);
6353 Vinhibit_file_name_handlers
= Qnil
;
6355 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6356 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6357 Vinhibit_file_name_operation
= Qnil
;
6359 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6360 doc
: /* File name in which we write a list of all auto save file names.
6361 This variable is initialized automatically from `auto-save-list-file-prefix'
6362 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6363 a non-nil value. */);
6364 Vauto_save_list_file_name
= Qnil
;
6367 DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync
,
6368 doc
: /* *Non-nil means don't call fsync in `write-region'.
6369 This variable affects calls to `write-region' as well as save commands.
6370 A non-nil value may result in data loss! */);
6371 write_region_inhibit_fsync
= 0;
6374 DEFVAR_BOOL ("delete-by-moving-to-trash", &delete_by_moving_to_trash
,
6375 doc
: /* Specifies whether to use the system's trash can.
6376 When non-nil, the function `move-file-to-trash' will be used by
6377 `delete-file' and `delete-directory'. */);
6378 delete_by_moving_to_trash
= 0;
6379 Qmove_file_to_trash
= intern ("move-file-to-trash");
6380 staticpro (&Qmove_file_to_trash
);
6382 defsubr (&Sfind_file_name_handler
);
6383 defsubr (&Sfile_name_directory
);
6384 defsubr (&Sfile_name_nondirectory
);
6385 defsubr (&Sunhandled_file_name_directory
);
6386 defsubr (&Sfile_name_as_directory
);
6387 defsubr (&Sdirectory_file_name
);
6388 defsubr (&Smake_temp_name
);
6389 defsubr (&Sexpand_file_name
);
6390 defsubr (&Ssubstitute_in_file_name
);
6391 defsubr (&Scopy_file
);
6392 defsubr (&Smake_directory_internal
);
6393 defsubr (&Sdelete_directory
);
6394 defsubr (&Sdelete_file
);
6395 defsubr (&Srename_file
);
6396 defsubr (&Sadd_name_to_file
);
6397 defsubr (&Smake_symbolic_link
);
6399 defsubr (&Sdefine_logical_name
);
6402 defsubr (&Ssysnetunam
);
6403 #endif /* HPUX_NET */
6404 defsubr (&Sfile_name_absolute_p
);
6405 defsubr (&Sfile_exists_p
);
6406 defsubr (&Sfile_executable_p
);
6407 defsubr (&Sfile_readable_p
);
6408 defsubr (&Sfile_writable_p
);
6409 defsubr (&Saccess_file
);
6410 defsubr (&Sfile_symlink_p
);
6411 defsubr (&Sfile_directory_p
);
6412 defsubr (&Sfile_accessible_directory_p
);
6413 defsubr (&Sfile_regular_p
);
6414 defsubr (&Sfile_modes
);
6415 defsubr (&Sset_file_modes
);
6416 defsubr (&Sset_file_times
);
6417 defsubr (&Sset_default_file_modes
);
6418 defsubr (&Sdefault_file_modes
);
6419 defsubr (&Sfile_newer_than_file_p
);
6420 defsubr (&Sinsert_file_contents
);
6421 defsubr (&Swrite_region
);
6422 defsubr (&Scar_less_than_car
);
6423 defsubr (&Sverify_visited_file_modtime
);
6424 defsubr (&Sclear_visited_file_modtime
);
6425 defsubr (&Svisited_file_modtime
);
6426 defsubr (&Sset_visited_file_modtime
);
6427 defsubr (&Sdo_auto_save
);
6428 defsubr (&Sset_buffer_auto_saved
);
6429 defsubr (&Sclear_buffer_auto_save_failure
);
6430 defsubr (&Srecent_auto_save_p
);
6432 defsubr (&Snext_read_file_uses_dialog_p
);
6435 defsubr (&Sunix_sync
);
6439 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6440 (do not change this comment) */