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))
132 #include "commands.h"
133 extern int use_dialog_box
;
134 extern int use_file_dialog
;
148 #ifndef FILE_SYSTEM_CASE
149 #define FILE_SYSTEM_CASE(filename) (filename)
152 /* Nonzero during writing of auto-save files */
155 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
156 a new file with the same mode as the original */
157 int auto_save_mode_bits
;
159 /* Set by auto_save_1 if an error occurred during the last auto-save. */
160 int auto_save_error_occurred
;
162 /* The symbol bound to coding-system-for-read when
163 insert-file-contents is called for recovering a file. This is not
164 an actual coding system name, but just an indicator to tell
165 insert-file-contents to use `emacs-mule' with a special flag for
166 auto saving and recovering a file. */
167 Lisp_Object Qauto_save_coding
;
169 /* Coding system for file names, or nil if none. */
170 Lisp_Object Vfile_name_coding_system
;
172 /* Coding system for file names used only when
173 Vfile_name_coding_system is nil. */
174 Lisp_Object Vdefault_file_name_coding_system
;
176 /* Alist of elements (REGEXP . HANDLER) for file names
177 whose I/O is done with a special handler. */
178 Lisp_Object Vfile_name_handler_alist
;
180 /* Property name of a file name handler,
181 which gives a list of operations it handles.. */
182 Lisp_Object Qoperations
;
184 /* Lisp functions for translating file formats */
185 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
187 /* Function to be called to decide a coding system of a reading file. */
188 Lisp_Object Vset_auto_coding_function
;
190 /* Functions to be called to process text properties in inserted file. */
191 Lisp_Object Vafter_insert_file_functions
;
193 /* Lisp function for setting buffer-file-coding-system and the
194 multibyteness of the current buffer after inserting a file. */
195 Lisp_Object Qafter_insert_file_set_coding
;
197 /* Functions to be called to create text property annotations for file. */
198 Lisp_Object Vwrite_region_annotate_functions
;
199 Lisp_Object Qwrite_region_annotate_functions
;
201 /* During build_annotations, each time an annotation function is called,
202 this holds the annotations made by the previous functions. */
203 Lisp_Object Vwrite_region_annotations_so_far
;
205 /* File name in which we write a list of all our auto save files. */
206 Lisp_Object Vauto_save_list_file_name
;
208 /* On VMS, nonzero means write new files with record format stmlf.
209 Zero means use var format. */
212 /* On NT, specifies the directory separator character, used (eg.) when
213 expanding file names. This can be bound to / or \. */
214 Lisp_Object Vdirectory_sep_char
;
217 /* Nonzero means skip the call to fsync in Fwrite-region. */
218 int write_region_inhibit_fsync
;
221 extern Lisp_Object Vuser_login_name
;
224 extern Lisp_Object Vw32_get_true_file_attributes
;
227 extern int minibuf_level
;
229 extern int minibuffer_auto_raise
;
231 extern int history_delete_duplicates
;
233 /* These variables describe handlers that have "already" had a chance
234 to handle the current operation.
236 Vinhibit_file_name_handlers is a list of file name handlers.
237 Vinhibit_file_name_operation is the operation being handled.
238 If we try to handle that operation, we ignore those handlers. */
240 static Lisp_Object Vinhibit_file_name_handlers
;
241 static Lisp_Object Vinhibit_file_name_operation
;
243 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
245 Lisp_Object Qfile_name_history
;
247 Lisp_Object Qcar_less_than_car
;
249 static int a_write
P_ ((int, Lisp_Object
, int, int,
250 Lisp_Object
*, struct coding_system
*));
251 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
255 report_file_error (string
, data
)
259 Lisp_Object errstring
;
263 synchronize_system_messages_locale ();
264 str
= strerror (errorno
);
265 errstring
= code_convert_string_norecord (make_unibyte_string (str
,
267 Vlocale_coding_system
, 0);
273 xsignal (Qfile_already_exists
, Fcons (errstring
, data
));
276 /* System error messages are capitalized. Downcase the initial
277 unless it is followed by a slash. */
278 if (SREF (errstring
, 1) != '/')
279 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
281 xsignal (Qfile_error
,
282 Fcons (build_string (string
), Fcons (errstring
, data
)));
287 close_file_unwind (fd
)
290 emacs_close (XFASTINT (fd
));
294 /* Restore point, having saved it as a marker. */
297 restore_point_unwind (location
)
298 Lisp_Object location
;
300 Fgoto_char (location
);
301 Fset_marker (location
, Qnil
, Qnil
);
306 Lisp_Object Qexpand_file_name
;
307 Lisp_Object Qsubstitute_in_file_name
;
308 Lisp_Object Qdirectory_file_name
;
309 Lisp_Object Qfile_name_directory
;
310 Lisp_Object Qfile_name_nondirectory
;
311 Lisp_Object Qunhandled_file_name_directory
;
312 Lisp_Object Qfile_name_as_directory
;
313 Lisp_Object Qcopy_file
;
314 Lisp_Object Qmake_directory_internal
;
315 Lisp_Object Qmake_directory
;
316 Lisp_Object Qdelete_directory
;
317 Lisp_Object Qdelete_file
;
318 Lisp_Object Qrename_file
;
319 Lisp_Object Qadd_name_to_file
;
320 Lisp_Object Qmake_symbolic_link
;
321 Lisp_Object Qfile_exists_p
;
322 Lisp_Object Qfile_executable_p
;
323 Lisp_Object Qfile_readable_p
;
324 Lisp_Object Qfile_writable_p
;
325 Lisp_Object Qfile_symlink_p
;
326 Lisp_Object Qaccess_file
;
327 Lisp_Object Qfile_directory_p
;
328 Lisp_Object Qfile_regular_p
;
329 Lisp_Object Qfile_accessible_directory_p
;
330 Lisp_Object Qfile_modes
;
331 Lisp_Object Qset_file_modes
;
332 Lisp_Object Qset_file_times
;
333 Lisp_Object Qfile_newer_than_file_p
;
334 Lisp_Object Qinsert_file_contents
;
335 Lisp_Object Qwrite_region
;
336 Lisp_Object Qverify_visited_file_modtime
;
337 Lisp_Object Qset_visited_file_modtime
;
339 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
340 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
341 Otherwise, return nil.
342 A file name is handled if one of the regular expressions in
343 `file-name-handler-alist' matches it.
345 If OPERATION equals `inhibit-file-name-operation', then we ignore
346 any handlers that are members of `inhibit-file-name-handlers',
347 but we still do run any other handlers. This lets handlers
348 use the standard functions without calling themselves recursively. */)
349 (filename
, operation
)
350 Lisp_Object filename
, operation
;
352 /* This function must not munge the match data. */
353 Lisp_Object chain
, inhibited_handlers
, result
;
357 CHECK_STRING (filename
);
359 if (EQ (operation
, Vinhibit_file_name_operation
))
360 inhibited_handlers
= Vinhibit_file_name_handlers
;
362 inhibited_handlers
= Qnil
;
364 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
365 chain
= XCDR (chain
))
371 Lisp_Object string
= XCAR (elt
);
373 Lisp_Object handler
= XCDR (elt
);
374 Lisp_Object operations
= Qnil
;
376 if (SYMBOLP (handler
))
377 operations
= Fget (handler
, Qoperations
);
380 && (match_pos
= fast_string_match (string
, filename
)) > pos
381 && (NILP (operations
) || ! NILP (Fmemq (operation
, operations
))))
385 handler
= XCDR (elt
);
386 tem
= Fmemq (handler
, inhibited_handlers
);
400 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
402 doc
: /* Return the directory component in file name FILENAME.
403 Return nil if FILENAME does not include a directory.
404 Otherwise return a directory name.
405 Given a Unix syntax file name, returns a string ending in slash;
406 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
408 Lisp_Object filename
;
411 register const unsigned char *beg
;
413 register unsigned char *beg
;
415 register const unsigned char *p
;
418 CHECK_STRING (filename
);
420 /* If the file name has special constructs in it,
421 call the corresponding file handler. */
422 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
424 return call2 (handler
, Qfile_name_directory
, filename
);
426 filename
= FILE_SYSTEM_CASE (filename
);
427 beg
= SDATA (filename
);
429 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
431 p
= beg
+ SBYTES (filename
);
433 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
435 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
438 /* only recognise drive specifier at the beginning */
440 /* handle the "/:d:foo" and "/:foo" cases correctly */
441 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
442 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
449 /* Expansion of "c:" to drive and default directory. */
452 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
453 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
454 unsigned char *r
= res
;
456 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
458 strncpy (res
, beg
, 2);
463 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
465 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
468 p
= beg
+ strlen (beg
);
471 CORRECT_DIR_SEPS (beg
);
474 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
477 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
478 Sfile_name_nondirectory
, 1, 1, 0,
479 doc
: /* Return file name FILENAME sans its directory.
480 For example, in a Unix-syntax file name,
481 this is everything after the last slash,
482 or the entire name if it contains no slash. */)
484 Lisp_Object filename
;
486 register const unsigned char *beg
, *p
, *end
;
489 CHECK_STRING (filename
);
491 /* If the file name has special constructs in it,
492 call the corresponding file handler. */
493 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
495 return call2 (handler
, Qfile_name_nondirectory
, filename
);
497 beg
= SDATA (filename
);
498 end
= p
= beg
+ SBYTES (filename
);
500 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
502 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
505 /* only recognise drive specifier at beginning */
507 /* handle the "/:d:foo" case correctly */
508 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
513 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
516 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
517 Sunhandled_file_name_directory
, 1, 1, 0,
518 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
519 A `directly usable' directory name is one that may be used without the
520 intervention of any file handler.
521 If FILENAME is a directly usable file itself, return
522 \(file-name-directory FILENAME).
523 If FILENAME refers to a file which is not accessible from a local process,
524 then this should return nil.
525 The `call-process' and `start-process' functions use this function to
526 get a current directory to run processes in. */)
528 Lisp_Object filename
;
532 /* If the file name has special constructs in it,
533 call the corresponding file handler. */
534 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
536 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
538 return Ffile_name_directory (filename
);
543 file_name_as_directory (out
, in
)
546 int size
= strlen (in
) - 1;
559 /* Is it already a directory string? */
560 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
562 /* Is it a VMS directory file name? If so, hack VMS syntax. */
563 else if (! index (in
, '/')
564 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
565 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
566 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
567 || ! strncmp (&in
[size
- 5], ".dir", 4))
568 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
569 && in
[size
] == '1')))
571 register char *p
, *dot
;
575 dir:x.dir --> dir:[x]
576 dir:[x]y.dir --> dir:[x.y] */
578 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
581 strncpy (out
, in
, p
- in
);
600 dot
= index (p
, '.');
603 /* blindly remove any extension */
604 size
= strlen (out
) + (dot
- p
);
605 strncat (out
, p
, dot
- p
);
616 /* For Unix syntax, Append a slash if necessary */
617 if (!IS_DIRECTORY_SEP (out
[size
]))
619 /* Cannot use DIRECTORY_SEP, which could have any value */
621 out
[size
+ 2] = '\0';
624 CORRECT_DIR_SEPS (out
);
630 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
631 Sfile_name_as_directory
, 1, 1, 0,
632 doc
: /* Return a string representing the file name FILE interpreted as a directory.
633 This operation exists because a directory is also a file, but its name as
634 a directory is different from its name as a file.
635 The result can be used as the value of `default-directory'
636 or passed as second argument to `expand-file-name'.
637 For a Unix-syntax file name, just appends a slash.
638 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
649 /* If the file name has special constructs in it,
650 call the corresponding file handler. */
651 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
653 return call2 (handler
, Qfile_name_as_directory
, file
);
655 buf
= (char *) alloca (SBYTES (file
) + 10);
656 file_name_as_directory (buf
, SDATA (file
));
657 return make_specified_string (buf
, -1, strlen (buf
),
658 STRING_MULTIBYTE (file
));
662 * Convert from directory name to filename.
664 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
665 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
666 * On UNIX, it's simple: just make sure there isn't a terminating /
668 * Value is nonzero if the string output is different from the input.
672 directory_file_name (src
, dst
)
680 struct FAB fab
= cc$rms_fab
;
681 struct NAM nam
= cc$rms_nam
;
682 char esa
[NAM$C_MAXRSS
];
687 if (! index (src
, '/')
688 && (src
[slen
- 1] == ']'
689 || src
[slen
- 1] == ':'
690 || src
[slen
- 1] == '>'))
692 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
694 fab
.fab$b_fns
= slen
;
695 fab
.fab$l_nam
= &nam
;
696 fab
.fab$l_fop
= FAB$M_NAM
;
699 nam
.nam$b_ess
= sizeof esa
;
700 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
702 /* We call SYS$PARSE to handle such things as [--] for us. */
703 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
705 slen
= nam
.nam$b_esl
;
706 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
711 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
713 /* what about when we have logical_name:???? */
714 if (src
[slen
- 1] == ':')
715 { /* Xlate logical name and see what we get */
716 ptr
= strcpy (dst
, src
); /* upper case for getenv */
719 if ('a' <= *ptr
&& *ptr
<= 'z')
723 dst
[slen
- 1] = 0; /* remove colon */
724 if (!(src
= egetenv (dst
)))
726 /* should we jump to the beginning of this procedure?
727 Good points: allows us to use logical names that xlate
729 Bad points: can be a problem if we just translated to a device
731 For now, I'll punt and always expect VMS names, and hope for
734 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
735 { /* no recursion here! */
741 { /* not a directory spec */
746 bracket
= src
[slen
- 1];
748 /* If bracket is ']' or '>', bracket - 2 is the corresponding
750 ptr
= index (src
, bracket
- 2);
752 { /* no opening bracket */
756 if (!(rptr
= rindex (src
, '.')))
759 strncpy (dst
, src
, slen
);
763 dst
[slen
++] = bracket
;
768 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
769 then translate the device and recurse. */
770 if (dst
[slen
- 1] == ':'
771 && dst
[slen
- 2] != ':' /* skip decnet nodes */
772 && strcmp (src
+ slen
, "[000000]") == 0)
774 dst
[slen
- 1] = '\0';
775 if ((ptr
= egetenv (dst
))
776 && (rlen
= strlen (ptr
) - 1) > 0
777 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
778 && ptr
[rlen
- 1] == '.')
780 char * buf
= (char *) alloca (strlen (ptr
) + 1);
784 return directory_file_name (buf
, dst
);
789 strcat (dst
, "[000000]");
793 rlen
= strlen (rptr
) - 1;
794 strncat (dst
, rptr
, rlen
);
795 dst
[slen
+ rlen
] = '\0';
796 strcat (dst
, ".DIR.1");
800 /* Process as Unix format: just remove any final slash.
801 But leave "/" unchanged; do not change it to "". */
804 && IS_DIRECTORY_SEP (dst
[slen
- 1])
806 && !IS_ANY_SEP (dst
[slen
- 2])
811 CORRECT_DIR_SEPS (dst
);
816 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
818 doc
: /* Returns the file name of the directory named DIRECTORY.
819 This is the name of the file that holds the data for the directory DIRECTORY.
820 This operation exists because a directory is also a file, but its name as
821 a directory is different from its name as a file.
822 In Unix-syntax, this function just removes the final slash.
823 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
824 it returns a file name such as \"[X]Y.DIR.1\". */)
826 Lisp_Object directory
;
831 CHECK_STRING (directory
);
833 if (NILP (directory
))
836 /* If the file name has special constructs in it,
837 call the corresponding file handler. */
838 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
840 return call2 (handler
, Qdirectory_file_name
, directory
);
843 /* 20 extra chars is insufficient for VMS, since we might perform a
844 logical name translation. an equivalence string can be up to 255
845 chars long, so grab that much extra space... - sss */
846 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
848 buf
= (char *) alloca (SBYTES (directory
) + 20);
850 directory_file_name (SDATA (directory
), buf
);
851 return make_specified_string (buf
, -1, strlen (buf
),
852 STRING_MULTIBYTE (directory
));
855 static char make_temp_name_tbl
[64] =
857 'A','B','C','D','E','F','G','H',
858 'I','J','K','L','M','N','O','P',
859 'Q','R','S','T','U','V','W','X',
860 'Y','Z','a','b','c','d','e','f',
861 'g','h','i','j','k','l','m','n',
862 'o','p','q','r','s','t','u','v',
863 'w','x','y','z','0','1','2','3',
864 '4','5','6','7','8','9','-','_'
867 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
869 /* Value is a temporary file name starting with PREFIX, a string.
871 The Emacs process number forms part of the result, so there is
872 no danger of generating a name being used by another process.
873 In addition, this function makes an attempt to choose a name
874 which has no existing file. To make this work, PREFIX should be
875 an absolute file name.
877 BASE64_P non-zero means add the pid as 3 characters in base64
878 encoding. In this case, 6 characters will be added to PREFIX to
879 form the file name. Otherwise, if Emacs is running on a system
880 with long file names, add the pid as a decimal number.
882 This function signals an error if no unique file name could be
886 make_temp_name (prefix
, base64_p
)
893 unsigned char *p
, *data
;
897 CHECK_STRING (prefix
);
899 /* VAL is created by adding 6 characters to PREFIX. The first
900 three are the PID of this process, in base 64, and the second
901 three are incremented if the file already exists. This ensures
902 262144 unique file names per PID per PREFIX. */
904 pid
= (int) getpid ();
908 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
909 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
910 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
915 #ifdef HAVE_LONG_FILE_NAMES
916 sprintf (pidbuf
, "%d", pid
);
917 pidlen
= strlen (pidbuf
);
919 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
920 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
921 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
926 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
927 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
928 if (!STRING_MULTIBYTE (prefix
))
929 STRING_SET_UNIBYTE (val
);
931 bcopy(SDATA (prefix
), data
, len
);
934 bcopy (pidbuf
, p
, pidlen
);
937 /* Here we try to minimize useless stat'ing when this function is
938 invoked many times successively with the same PREFIX. We achieve
939 this by initializing count to a random value, and incrementing it
942 We don't want make-temp-name to be called while dumping,
943 because then make_temp_name_count_initialized_p would get set
944 and then make_temp_name_count would not be set when Emacs starts. */
946 if (!make_temp_name_count_initialized_p
)
948 make_temp_name_count
= (unsigned) time (NULL
);
949 make_temp_name_count_initialized_p
= 1;
955 unsigned num
= make_temp_name_count
;
957 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
958 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
959 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
961 /* Poor man's congruential RN generator. Replace with
962 ++make_temp_name_count for debugging. */
963 make_temp_name_count
+= 25229;
964 make_temp_name_count
%= 225307;
966 if (stat (data
, &ignored
) < 0)
968 /* We want to return only if errno is ENOENT. */
972 /* The error here is dubious, but there is little else we
973 can do. The alternatives are to return nil, which is
974 as bad as (and in many cases worse than) throwing the
975 error, or to ignore the error, which will likely result
976 in looping through 225307 stat's, which is not only
977 dog-slow, but also useless since it will fallback to
978 the errow below, anyway. */
979 report_file_error ("Cannot create temporary name for prefix",
980 Fcons (prefix
, Qnil
));
985 error ("Cannot create temporary name for prefix `%s'",
991 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
992 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
993 The Emacs process number forms part of the result,
994 so there is no danger of generating a name being used by another process.
996 In addition, this function makes an attempt to choose a name
997 which has no existing file. To make this work,
998 PREFIX should be an absolute file name.
1000 There is a race condition between calling `make-temp-name' and creating the
1001 file which opens all kinds of security holes. For that reason, you should
1002 probably use `make-temp-file' instead, except in three circumstances:
1004 * If you are creating the file in the user's home directory.
1005 * If you are creating a directory rather than an ordinary file.
1006 * If you are taking special precautions as `make-temp-file' does. */)
1010 return make_temp_name (prefix
, 0);
1015 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1016 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1017 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1018 \(does not start with slash or tilde); if DEFAULT-DIRECTORY is nil or missing,
1019 the current buffer's value of `default-directory' is used.
1020 File name components that are `.' are removed, and
1021 so are file name components followed by `..', along with the `..' itself;
1022 note that these simplifications are done without checking the resulting
1023 file names in the file system.
1024 An initial `~/' expands to your home directory.
1025 An initial `~USER/' expands to USER's home directory.
1026 See also the function `substitute-in-file-name'. */)
1027 (name
, default_directory
)
1028 Lisp_Object name
, default_directory
;
1030 /* These point to SDATA and need to be careful with string-relocation
1031 during GC (via DECODE_FILE). */
1032 unsigned char *nm
, *newdir
;
1034 /* This should only point to alloca'd data. */
1035 unsigned char *target
;
1040 unsigned char * colon
= 0;
1041 unsigned char * close
= 0;
1042 unsigned char * slash
= 0;
1043 unsigned char * brack
= 0;
1044 int lbrack
= 0, rbrack
= 0;
1049 int collapse_newdir
= 1;
1053 Lisp_Object handler
, result
;
1057 CHECK_STRING (name
);
1059 /* If the file name has special constructs in it,
1060 call the corresponding file handler. */
1061 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1062 if (!NILP (handler
))
1063 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1065 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1066 if (NILP (default_directory
))
1067 default_directory
= current_buffer
->directory
;
1068 if (! STRINGP (default_directory
))
1071 /* "/" is not considered a root directory on DOS_NT, so using "/"
1072 here causes an infinite recursion in, e.g., the following:
1074 (let (default-directory)
1075 (expand-file-name "a"))
1077 To avoid this, we set default_directory to the root of the
1079 extern char *emacs_root_dir (void);
1081 default_directory
= build_string (emacs_root_dir ());
1083 default_directory
= build_string ("/");
1087 if (!NILP (default_directory
))
1089 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1090 if (!NILP (handler
))
1091 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1095 unsigned char *o
= SDATA (default_directory
);
1097 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1098 It would be better to do this down below where we actually use
1099 default_directory. Unfortunately, calling Fexpand_file_name recursively
1100 could invoke GC, and the strings might be relocated. This would
1101 be annoying because we have pointers into strings lying around
1102 that would need adjusting, and people would add new pointers to
1103 the code and forget to adjust them, resulting in intermittent bugs.
1104 Putting this call here avoids all that crud.
1106 The EQ test avoids infinite recursion. */
1107 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1108 /* Save time in some common cases - as long as default_directory
1109 is not relative, it can be canonicalized with name below (if it
1110 is needed at all) without requiring it to be expanded now. */
1112 /* Detect MSDOS file names with drive specifiers. */
1113 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1])
1114 && IS_DIRECTORY_SEP (o
[2]))
1116 /* Detect Windows file names in UNC format. */
1117 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1119 #else /* not DOS_NT */
1120 /* Detect Unix absolute file names (/... alone is not absolute on
1122 && ! (IS_DIRECTORY_SEP (o
[0]))
1123 #endif /* not DOS_NT */
1126 struct gcpro gcpro1
;
1129 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1133 name
= FILE_SYSTEM_CASE (name
);
1134 multibyte
= STRING_MULTIBYTE (name
);
1135 if (multibyte
!= STRING_MULTIBYTE (default_directory
))
1138 default_directory
= string_to_multibyte (default_directory
);
1141 name
= string_to_multibyte (name
);
1150 /* We will force directory separators to be either all \ or /, so make
1151 a local copy to modify, even if there ends up being no change. */
1152 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1155 /* Note if special escape prefix is present, but remove for now. */
1156 if (nm
[0] == '/' && nm
[1] == ':')
1162 /* Find and remove drive specifier if present; this makes nm absolute
1163 even if the rest of the name appears to be relative. Only look for
1164 drive specifier at the beginning. */
1165 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1172 /* If we see "c://somedir", we want to strip the first slash after the
1173 colon when stripping the drive letter. Otherwise, this expands to
1175 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1178 /* Discard any previous drive specifier if nm is now in UNC format. */
1179 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1183 #endif /* WINDOWSNT */
1186 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1187 none are found, we can probably return right away. We will avoid
1188 allocating a new string if name is already fully expanded. */
1190 IS_DIRECTORY_SEP (nm
[0])
1192 && drive
&& !is_escaped
1195 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1202 /* If it turns out that the filename we want to return is just a
1203 suffix of FILENAME, we don't need to go through and edit
1204 things; we just need to construct a new string using data
1205 starting at the middle of FILENAME. If we set lose to a
1206 non-zero value, that means we've discovered that we can't do
1209 unsigned char *p
= nm
;
1213 /* Since we know the name is absolute, we can assume that each
1214 element starts with a "/". */
1216 /* "." and ".." are hairy. */
1217 if (IS_DIRECTORY_SEP (p
[0])
1219 && (IS_DIRECTORY_SEP (p
[2])
1221 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1224 /* We want to replace multiple `/' in a row with a single
1227 && IS_DIRECTORY_SEP (p
[0])
1228 && IS_DIRECTORY_SEP (p
[1]))
1235 /* if dev:[dir]/, move nm to / */
1236 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1237 nm
= (brack
? brack
+ 1 : colon
+ 1);
1238 lbrack
= rbrack
= 0;
1245 #ifdef NO_HYPHENS_IN_FILENAMES
1246 if (lbrack
== rbrack
)
1248 /* Avoid clobbering negative version numbers. */
1253 #endif /* NO_HYPHENS_IN_FILENAMES */
1255 && ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<')
1256 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1258 #ifdef NO_HYPHENS_IN_FILENAMES
1261 #endif /* NO_HYPHENS_IN_FILENAMES */
1262 /* count open brackets, reset close bracket pointer */
1263 if (p
[0] == '[' || p
[0] == '<')
1264 lbrack
++, brack
= 0;
1265 /* count close brackets, set close bracket pointer */
1266 if (p
[0] == ']' || p
[0] == '>')
1267 rbrack
++, brack
= p
;
1268 /* detect ][ or >< */
1269 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1271 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1272 nm
= p
+ 1, lose
= 1;
1273 if (p
[0] == ':' && (colon
|| slash
))
1274 /* if dev1:[dir]dev2:, move nm to dev2: */
1280 /* if /name/dev:, move nm to dev: */
1283 /* if node::dev:, move colon following dev */
1284 else if (colon
&& colon
[-1] == ':')
1286 /* if dev1:dev2:, move nm to dev2: */
1287 else if (colon
&& colon
[-1] != ':')
1292 if (p
[0] == ':' && !colon
)
1298 if (lbrack
== rbrack
)
1301 else if (p
[0] == '.')
1309 if (index (nm
, '/'))
1311 nm
= sys_translate_unix (nm
);
1313 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1317 /* Make sure directories are all separated with / or \ as
1318 desired, but avoid allocation of a new string when not
1320 CORRECT_DIR_SEPS (nm
);
1322 if (IS_DIRECTORY_SEP (nm
[1]))
1324 if (strcmp (nm
, SDATA (name
)) != 0)
1325 name
= make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1329 /* drive must be set, so this is okay */
1330 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1334 name
= make_specified_string (nm
, -1, p
- nm
, multibyte
);
1335 temp
[0] = DRIVE_LETTER (drive
);
1336 name
= concat2 (build_string (temp
), name
);
1339 #else /* not DOS_NT */
1340 if (nm
== SDATA (name
))
1342 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1343 #endif /* not DOS_NT */
1347 /* At this point, nm might or might not be an absolute file name. We
1348 need to expand ~ or ~user if present, otherwise prefix nm with
1349 default_directory if nm is not absolute, and finally collapse /./
1350 and /foo/../ sequences.
1352 We set newdir to be the appropriate prefix if one is needed:
1353 - the relevant user directory if nm starts with ~ or ~user
1354 - the specified drive's working dir (DOS/NT only) if nm does not
1356 - the value of default_directory.
1358 Note that these prefixes are not guaranteed to be absolute (except
1359 for the working dir of a drive). Therefore, to ensure we always
1360 return an absolute name, if the final prefix is not absolute we
1361 append it to the current working directory. */
1365 if (nm
[0] == '~') /* prefix ~ */
1367 if (IS_DIRECTORY_SEP (nm
[1])
1371 || nm
[1] == 0) /* ~ by itself */
1375 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1376 newdir
= (unsigned char *) "";
1378 /* egetenv may return a unibyte string, which will bite us since
1379 we expect the directory to be multibyte. */
1380 tem
= build_string (newdir
);
1381 if (!STRING_MULTIBYTE (tem
))
1383 /* FIXME: DECODE_FILE may GC, which may move SDATA(name),
1384 after which `nm' won't point to the right place any more. */
1385 int offset
= nm
- SDATA (name
);
1386 hdir
= DECODE_FILE (tem
);
1387 newdir
= SDATA (hdir
);
1389 nm
= SDATA (name
) + offset
;
1392 collapse_newdir
= 0;
1395 nm
++; /* Don't leave the slash in nm. */
1398 else /* ~user/filename */
1400 unsigned char *o
, *p
;
1401 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1406 o
= alloca (p
- nm
+ 1);
1407 bcopy ((char *) nm
, o
, p
- nm
);
1411 pw
= (struct passwd
*) getpwnam (o
+ 1);
1415 newdir
= (unsigned char *) pw
-> pw_dir
;
1417 nm
= p
+ 1; /* skip the terminator */
1421 collapse_newdir
= 0;
1426 /* If we don't find a user of that name, leave the name
1427 unchanged; don't move nm forward to p. */
1432 /* On DOS and Windows, nm is absolute if a drive name was specified;
1433 use the drive's current directory as the prefix if needed. */
1434 if (!newdir
&& drive
)
1436 /* Get default directory if needed to make nm absolute. */
1437 if (!IS_DIRECTORY_SEP (nm
[0]))
1439 newdir
= alloca (MAXPATHLEN
+ 1);
1440 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1445 /* Either nm starts with /, or drive isn't mounted. */
1446 newdir
= alloca (4);
1447 newdir
[0] = DRIVE_LETTER (drive
);
1455 /* Finally, if no prefix has been specified and nm is not absolute,
1456 then it must be expanded relative to default_directory. */
1460 /* /... alone is not absolute on DOS and Windows. */
1461 && !IS_DIRECTORY_SEP (nm
[0])
1464 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1471 newdir
= SDATA (default_directory
);
1473 /* Note if special escape prefix is present, but remove for now. */
1474 if (newdir
[0] == '/' && newdir
[1] == ':')
1485 /* First ensure newdir is an absolute name. */
1487 /* Detect MSDOS file names with drive specifiers. */
1488 ! (IS_DRIVE (newdir
[0])
1489 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1491 /* Detect Windows file names in UNC format. */
1492 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1496 /* Effectively, let newdir be (expand-file-name newdir cwd).
1497 Because of the admonition against calling expand-file-name
1498 when we have pointers into lisp strings, we accomplish this
1499 indirectly by prepending newdir to nm if necessary, and using
1500 cwd (or the wd of newdir's drive) as the new newdir. */
1502 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1507 if (!IS_DIRECTORY_SEP (nm
[0]))
1509 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1510 file_name_as_directory (tmp
, newdir
);
1514 newdir
= alloca (MAXPATHLEN
+ 1);
1517 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1524 /* Strip off drive name from prefix, if present. */
1525 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1531 /* Keep only a prefix from newdir if nm starts with slash
1532 (//server/share for UNC, nothing otherwise). */
1533 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1536 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1539 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1541 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1543 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1555 /* Get rid of any slash at the end of newdir, unless newdir is
1556 just / or // (an incomplete UNC name). */
1557 length
= strlen (newdir
);
1558 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1560 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1564 unsigned char *temp
= (unsigned char *) alloca (length
);
1565 bcopy (newdir
, temp
, length
- 1);
1566 temp
[length
- 1] = 0;
1574 /* Now concatenate the directory and name to new space in the stack frame */
1575 tlen
+= strlen (nm
) + 1;
1577 /* Reserve space for drive specifier and escape prefix, since either
1578 or both may need to be inserted. (The Microsoft x86 compiler
1579 produces incorrect code if the following two lines are combined.) */
1580 target
= (unsigned char *) alloca (tlen
+ 4);
1582 #else /* not DOS_NT */
1583 target
= (unsigned char *) alloca (tlen
);
1584 #endif /* not DOS_NT */
1590 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1593 /* If newdir is effectively "C:/", then the drive letter will have
1594 been stripped and newdir will be "/". Concatenating with an
1595 absolute directory in nm produces "//", which will then be
1596 incorrectly treated as a network share. Ignore newdir in
1597 this case (keeping the drive letter). */
1598 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1599 && newdir
[1] == '\0'))
1601 strcpy (target
, newdir
);
1605 file_name_as_directory (target
, newdir
);
1608 strcat (target
, nm
);
1610 if (index (target
, '/'))
1611 strcpy (target
, sys_translate_unix (target
));
1614 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1616 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1620 unsigned char *p
= target
;
1621 unsigned char *o
= target
;
1626 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1632 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1633 /* brackets are offset from each other by 2 */
1636 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1637 /* convert [foo][bar] to [bar] */
1638 while (o
[-1] != '[' && o
[-1] != '<')
1640 else if (*p
== '-' && *o
!= '.')
1643 else if (p
[0] == '-' && o
[-1] == '.'
1644 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1645 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1649 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1650 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1652 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1654 /* else [foo.-] ==> [-] */
1658 #ifdef NO_HYPHENS_IN_FILENAMES
1660 && o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.'
1661 && p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1663 #endif /* NO_HYPHENS_IN_FILENAMES */
1667 if (!IS_DIRECTORY_SEP (*p
))
1671 else if (p
[1] == '.'
1672 && (IS_DIRECTORY_SEP (p
[2])
1675 /* If "/." is the entire filename, keep the "/". Otherwise,
1676 just delete the whole "/.". */
1677 if (o
== target
&& p
[2] == '\0')
1681 else if (p
[1] == '.' && p
[2] == '.'
1682 /* `/../' is the "superroot" on certain file systems.
1683 Turned off on DOS_NT systems because they have no
1684 "superroot" and because this causes us to produce
1685 file names like "d:/../foo" which fail file-related
1686 functions of the underlying OS. (To reproduce, try a
1687 long series of "../../" in default_directory, longer
1688 than the number of levels from the root.) */
1692 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1694 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1696 /* Keep initial / only if this is the whole name. */
1697 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1701 else if (p
> target
&& IS_DIRECTORY_SEP (p
[1]))
1702 /* Collapse multiple `/' in a row. */
1708 #endif /* not VMS */
1712 /* At last, set drive name. */
1714 /* Except for network file name. */
1715 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1716 #endif /* WINDOWSNT */
1718 if (!drive
) abort ();
1720 target
[0] = DRIVE_LETTER (drive
);
1723 /* Reinsert the escape prefix if required. */
1730 CORRECT_DIR_SEPS (target
);
1733 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1736 /* Again look to see if the file name has special constructs in it
1737 and perhaps call the corresponding file handler. This is needed
1738 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1739 the ".." component gives us "/user@host:/bar/../baz" which needs
1740 to be expanded again. */
1741 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1742 if (!NILP (handler
))
1743 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1749 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1750 This is the old version of expand-file-name, before it was thoroughly
1751 rewritten for Emacs 10.31. We leave this version here commented-out,
1752 because the code is very complex and likely to have subtle bugs. If
1753 bugs _are_ found, it might be of interest to look at the old code and
1754 see what did it do in the relevant situation.
1756 Don't remove this code: it's true that it will be accessible via CVS,
1757 but a few years from deletion, people will forget it is there. */
1759 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1760 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1761 "Convert FILENAME to absolute, and canonicalize it.\n\
1762 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1763 \(does not start with slash); if DEFAULT is nil or missing,\n\
1764 the current buffer's value of default-directory is used.\n\
1765 Filenames containing `.' or `..' as components are simplified;\n\
1766 initial `~/' expands to your home directory.\n\
1767 See also the function `substitute-in-file-name'.")
1769 Lisp_Object name
, defalt
;
1773 register unsigned char *newdir
, *p
, *o
;
1775 unsigned char *target
;
1779 unsigned char * colon
= 0;
1780 unsigned char * close
= 0;
1781 unsigned char * slash
= 0;
1782 unsigned char * brack
= 0;
1783 int lbrack
= 0, rbrack
= 0;
1787 CHECK_STRING (name
);
1790 /* Filenames on VMS are always upper case. */
1791 name
= Fupcase (name
);
1796 /* If nm is absolute, flush ...// and detect /./ and /../.
1797 If no /./ or /../ we can return right away. */
1809 if (p
[0] == '/' && p
[1] == '/'
1812 if (p
[0] == '/' && p
[1] == '~')
1813 nm
= p
+ 1, lose
= 1;
1814 if (p
[0] == '/' && p
[1] == '.'
1815 && (p
[2] == '/' || p
[2] == 0
1816 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1822 /* if dev:[dir]/, move nm to / */
1823 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1824 nm
= (brack
? brack
+ 1 : colon
+ 1);
1825 lbrack
= rbrack
= 0;
1833 /* VMS pre V4.4,convert '-'s in filenames. */
1834 if (lbrack
== rbrack
)
1836 if (dots
< 2) /* this is to allow negative version numbers */
1842 && ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<')
1843 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1849 /* count open brackets, reset close bracket pointer */
1850 if (p
[0] == '[' || p
[0] == '<')
1851 lbrack
++, brack
= 0;
1852 /* count close brackets, set close bracket pointer */
1853 if (p
[0] == ']' || p
[0] == '>')
1854 rbrack
++, brack
= p
;
1855 /* detect ][ or >< */
1856 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1858 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1859 nm
= p
+ 1, lose
= 1;
1860 if (p
[0] == ':' && (colon
|| slash
))
1861 /* if dev1:[dir]dev2:, move nm to dev2: */
1867 /* If /name/dev:, move nm to dev: */
1870 /* If node::dev:, move colon following dev */
1871 else if (colon
&& colon
[-1] == ':')
1873 /* If dev1:dev2:, move nm to dev2: */
1874 else if (colon
&& colon
[-1] != ':')
1879 if (p
[0] == ':' && !colon
)
1885 if (lbrack
== rbrack
)
1888 else if (p
[0] == '.')
1896 if (index (nm
, '/'))
1897 return build_string (sys_translate_unix (nm
));
1899 if (nm
== SDATA (name
))
1901 return build_string (nm
);
1905 /* Now determine directory to start with and put it in NEWDIR */
1909 if (nm
[0] == '~') /* prefix ~ */
1914 || nm
[1] == 0)/* ~/filename */
1916 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1917 newdir
= (unsigned char *) "";
1920 nm
++; /* Don't leave the slash in nm. */
1923 else /* ~user/filename */
1925 /* Get past ~ to user */
1926 unsigned char *user
= nm
+ 1;
1927 /* Find end of name. */
1928 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1929 int len
= ptr
? ptr
- user
: strlen (user
);
1931 unsigned char *ptr1
= index (user
, ':');
1932 if (ptr1
!= 0 && ptr1
- user
< len
)
1935 /* Copy the user name into temp storage. */
1936 o
= (unsigned char *) alloca (len
+ 1);
1937 bcopy ((char *) user
, o
, len
);
1940 /* Look up the user name. */
1942 pw
= (struct passwd
*) getpwnam (o
+ 1);
1945 error ("\"%s\" isn't a registered user", o
+ 1);
1947 newdir
= (unsigned char *) pw
->pw_dir
;
1949 /* Discard the user name from NM. */
1956 #endif /* not VMS */
1960 defalt
= current_buffer
->directory
;
1961 CHECK_STRING (defalt
);
1962 newdir
= SDATA (defalt
);
1965 /* Now concatenate the directory and name to new space in the stack frame */
1967 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1968 target
= (unsigned char *) alloca (tlen
);
1974 if (nm
[0] == 0 || nm
[0] == '/')
1975 strcpy (target
, newdir
);
1978 file_name_as_directory (target
, newdir
);
1981 strcat (target
, nm
);
1983 if (index (target
, '/'))
1984 strcpy (target
, sys_translate_unix (target
));
1987 /* Now canonicalize by removing /. and /foo/.. if they appear */
1995 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
2001 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
2002 /* brackets are offset from each other by 2 */
2005 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
2006 /* convert [foo][bar] to [bar] */
2007 while (o
[-1] != '[' && o
[-1] != '<')
2009 else if (*p
== '-' && *o
!= '.')
2012 else if (p
[0] == '-' && o
[-1] == '.'
2013 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
2014 /* flush .foo.- ; leave - if stopped by '[' or '<' */
2018 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
2019 if (p
[1] == '.') /* foo.-.bar ==> bar. */
2021 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
2023 /* else [foo.-] ==> [-] */
2029 && o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.'
2030 && p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2040 else if (!strncmp (p
, "//", 2)
2046 else if (p
[0] == '/' && p
[1] == '.'
2047 && (p
[2] == '/' || p
[2] == 0))
2049 else if (!strncmp (p
, "/..", 3)
2050 /* `/../' is the "superroot" on certain file systems. */
2052 && (p
[3] == '/' || p
[3] == 0))
2054 while (o
!= target
&& *--o
!= '/')
2056 if (o
== target
&& *o
== '/')
2064 #endif /* not VMS */
2067 return make_string (target
, o
- target
);
2071 /* If /~ or // appears, discard everything through first slash. */
2073 file_name_absolute_p (filename
)
2074 const unsigned char *filename
;
2077 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
2079 /* ??? This criterion is probably wrong for '<'. */
2080 || index (filename
, ':') || index (filename
, '<')
2081 || (*filename
== '[' && (filename
[1] != '-'
2082 || (filename
[2] != '.' && filename
[2] != ']'))
2083 && filename
[1] != '.')
2086 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
2087 && IS_DIRECTORY_SEP (filename
[2]))
2092 static unsigned char *
2093 search_embedded_absfilename (nm
, endp
)
2094 unsigned char *nm
, *endp
;
2096 unsigned char *p
, *s
;
2098 for (p
= nm
+ 1; p
< endp
; p
++)
2102 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2104 || IS_DIRECTORY_SEP (p
[-1]))
2105 && file_name_absolute_p (p
)
2106 #if defined (WINDOWSNT) || defined(CYGWIN)
2107 /* // at start of file name is meaningful in Apollo,
2108 WindowsNT and Cygwin systems. */
2109 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
2110 #endif /* not (WINDOWSNT || CYGWIN) */
2113 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2118 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2120 unsigned char *o
= alloca (s
- p
+ 1);
2122 bcopy (p
, o
, s
- p
);
2125 /* If we have ~user and `user' exists, discard
2126 everything up to ~. But if `user' does not exist, leave
2127 ~user alone, it might be a literal file name. */
2129 pw
= getpwnam (o
+ 1);
2141 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2142 Ssubstitute_in_file_name
, 1, 1, 0,
2143 doc
: /* Substitute environment variables referred to in FILENAME.
2144 `$FOO' where FOO is an environment variable name means to substitute
2145 the value of that variable. The variable name should be terminated
2146 with a character not a letter, digit or underscore; otherwise, enclose
2147 the entire variable name in braces.
2148 If `/~' appears, all of FILENAME through that `/' is discarded.
2150 On VMS, `$' substitution is not done; this function does little and only
2151 duplicates what `expand-file-name' does. */)
2153 Lisp_Object filename
;
2157 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2158 unsigned char *target
= NULL
;
2160 int substituted
= 0;
2162 Lisp_Object handler
;
2164 CHECK_STRING (filename
);
2166 /* If the file name has special constructs in it,
2167 call the corresponding file handler. */
2168 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2169 if (!NILP (handler
))
2170 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2172 nm
= SDATA (filename
);
2174 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2175 CORRECT_DIR_SEPS (nm
);
2176 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2178 endp
= nm
+ SBYTES (filename
);
2180 /* If /~ or // appears, discard everything through first slash. */
2181 p
= search_embedded_absfilename (nm
, endp
);
2183 /* Start over with the new string, so we check the file-name-handler
2184 again. Important with filenames like "/home/foo//:/hello///there"
2185 which whould substitute to "/:/hello///there" rather than "/there". */
2186 return Fsubstitute_in_file_name
2187 (make_specified_string (p
, -1, endp
- p
,
2188 STRING_MULTIBYTE (filename
)));
2194 /* See if any variables are substituted into the string
2195 and find the total length of their values in `total' */
2197 for (p
= nm
; p
!= endp
;)
2207 /* "$$" means a single "$" */
2216 while (p
!= endp
&& *p
!= '}') p
++;
2217 if (*p
!= '}') goto missingclose
;
2223 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2227 /* Copy out the variable name */
2228 target
= (unsigned char *) alloca (s
- o
+ 1);
2229 strncpy (target
, o
, s
- o
);
2232 strupr (target
); /* $home == $HOME etc. */
2235 /* Get variable value */
2236 o
= (unsigned char *) egetenv (target
);
2238 { /* Eight-bit chars occupy upto 2 bytes in multibyte. */
2239 total
+= strlen (o
) * (STRING_MULTIBYTE (filename
) ? 2 : 1);
2249 /* If substitution required, recopy the string and do it */
2250 /* Make space in stack frame for the new copy */
2251 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2254 /* Copy the rest of the name through, replacing $ constructs with values */
2271 while (p
!= endp
&& *p
!= '}') p
++;
2272 if (*p
!= '}') goto missingclose
;
2278 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2282 /* Copy out the variable name */
2283 target
= (unsigned char *) alloca (s
- o
+ 1);
2284 strncpy (target
, o
, s
- o
);
2287 strupr (target
); /* $home == $HOME etc. */
2290 /* Get variable value */
2291 o
= (unsigned char *) egetenv (target
);
2295 strcpy (x
, target
); x
+= strlen (target
);
2297 else if (STRING_MULTIBYTE (filename
))
2299 /* If the original string is multibyte,
2300 convert what we substitute into multibyte. */
2304 c
= unibyte_char_to_multibyte (c
);
2305 x
+= CHAR_STRING (c
, x
);
2317 /* If /~ or // appears, discard everything through first slash. */
2318 while ((p
= search_embedded_absfilename (xnm
, x
)))
2319 /* This time we do not start over because we've already expanded envvars
2320 and replaced $$ with $. Maybe we should start over as well, but we'd
2321 need to quote some $ to $$ first. */
2324 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2327 error ("Bad format environment-variable substitution");
2329 error ("Missing \"}\" in environment-variable substitution");
2331 error ("Substituting nonexistent environment variable \"%s\"", target
);
2334 #endif /* not VMS */
2338 /* A slightly faster and more convenient way to get
2339 (directory-file-name (expand-file-name FOO)). */
2342 expand_and_dir_to_file (filename
, defdir
)
2343 Lisp_Object filename
, defdir
;
2345 register Lisp_Object absname
;
2347 absname
= Fexpand_file_name (filename
, defdir
);
2350 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2351 if (c
== ':' || c
== ']' || c
== '>')
2352 absname
= Fdirectory_file_name (absname
);
2355 /* Remove final slash, if any (unless this is the root dir).
2356 stat behaves differently depending! */
2357 if (SCHARS (absname
) > 1
2358 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2359 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2360 /* We cannot take shortcuts; they might be wrong for magic file names. */
2361 absname
= Fdirectory_file_name (absname
);
2366 /* Signal an error if the file ABSNAME already exists.
2367 If INTERACTIVE is nonzero, ask the user whether to proceed,
2368 and bypass the error if the user says to go ahead.
2369 QUERYSTRING is a name for the action that is being considered
2372 *STATPTR is used to store the stat information if the file exists.
2373 If the file does not exist, STATPTR->st_mode is set to 0.
2374 If STATPTR is null, we don't store into it.
2376 If QUICK is nonzero, we ask for y or n, not yes or no. */
2379 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2380 Lisp_Object absname
;
2381 unsigned char *querystring
;
2383 struct stat
*statptr
;
2386 register Lisp_Object tem
, encoded_filename
;
2387 struct stat statbuf
;
2388 struct gcpro gcpro1
;
2390 encoded_filename
= ENCODE_FILE (absname
);
2392 /* stat is a good way to tell whether the file exists,
2393 regardless of what access permissions it has. */
2394 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
2397 xsignal2 (Qfile_already_exists
,
2398 build_string ("File already exists"), absname
);
2400 tem
= format2 ("File %s already exists; %s anyway? ",
2401 absname
, build_string (querystring
));
2403 tem
= Fy_or_n_p (tem
);
2405 tem
= do_yes_or_no_p (tem
);
2408 xsignal2 (Qfile_already_exists
,
2409 build_string ("File already exists"), absname
);
2416 statptr
->st_mode
= 0;
2421 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 5,
2422 "fCopy file: \nGCopy %s to file: \np\nP",
2423 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2424 If NEWNAME names a directory, copy FILE there.
2426 This function always sets the file modes of the output file to match
2429 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
2430 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
2431 signal a `file-already-exists' error without overwriting. If
2432 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
2433 about overwriting; this is what happens in interactive use with M-x.
2434 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
2437 Fourth arg KEEP-TIME non-nil means give the output file the same
2438 last-modified time as the old one. (This works on only some systems.)
2440 A prefix arg makes KEEP-TIME non-nil.
2442 If PRESERVE-UID-GID is non-nil, we try to transfer the
2443 uid and gid of FILE to NEWNAME. */)
2444 (file
, newname
, ok_if_already_exists
, keep_time
, preserve_uid_gid
)
2445 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2446 Lisp_Object preserve_uid_gid
;
2449 char buf
[16 * 1024];
2450 struct stat st
, out_st
;
2451 Lisp_Object handler
;
2452 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2453 int count
= SPECPDL_INDEX ();
2454 int input_file_statable_p
;
2455 Lisp_Object encoded_file
, encoded_newname
;
2457 encoded_file
= encoded_newname
= Qnil
;
2458 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2459 CHECK_STRING (file
);
2460 CHECK_STRING (newname
);
2462 if (!NILP (Ffile_directory_p (newname
)))
2463 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2465 newname
= Fexpand_file_name (newname
, Qnil
);
2467 file
= Fexpand_file_name (file
, Qnil
);
2469 /* If the input file name has special constructs in it,
2470 call the corresponding file handler. */
2471 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2472 /* Likewise for output file name. */
2474 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2475 if (!NILP (handler
))
2476 RETURN_UNGCPRO (call6 (handler
, Qcopy_file
, file
, newname
,
2477 ok_if_already_exists
, keep_time
, preserve_uid_gid
));
2479 encoded_file
= ENCODE_FILE (file
);
2480 encoded_newname
= ENCODE_FILE (newname
);
2482 if (NILP (ok_if_already_exists
)
2483 || INTEGERP (ok_if_already_exists
))
2484 barf_or_query_if_file_exists (newname
, "copy to it",
2485 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2486 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2490 if (!CopyFile (SDATA (encoded_file
),
2491 SDATA (encoded_newname
),
2493 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2494 /* CopyFile retains the timestamp by default. */
2495 else if (NILP (keep_time
))
2501 EMACS_GET_TIME (now
);
2502 filename
= SDATA (encoded_newname
);
2504 /* Ensure file is writable while its modified time is set. */
2505 attributes
= GetFileAttributes (filename
);
2506 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2507 if (set_file_times (filename
, now
, now
))
2509 /* Restore original attributes. */
2510 SetFileAttributes (filename
, attributes
);
2511 xsignal2 (Qfile_date_error
,
2512 build_string ("Cannot set file date"), newname
);
2514 /* Restore original attributes. */
2515 SetFileAttributes (filename
, attributes
);
2517 #else /* not WINDOWSNT */
2519 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2523 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2525 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2527 /* We can only copy regular files and symbolic links. Other files are not
2529 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2531 #if !defined (MSDOS) || __DJGPP__ > 1
2532 if (out_st
.st_mode
!= 0
2533 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2536 report_file_error ("Input and output files are the same",
2537 Fcons (file
, Fcons (newname
, Qnil
)));
2541 #if defined (S_ISREG) && defined (S_ISLNK)
2542 if (input_file_statable_p
)
2544 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2546 #if defined (EISDIR)
2547 /* Get a better looking error message. */
2550 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2553 #endif /* S_ISREG && S_ISLNK */
2556 /* Create the copy file with the same record format as the input file */
2557 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2560 /* System's default file type was set to binary by _fmode in emacs.c. */
2561 ofd
= emacs_open (SDATA (encoded_newname
),
2562 O_WRONLY
| O_TRUNC
| O_CREAT
2563 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2564 S_IREAD
| S_IWRITE
);
2565 #else /* not MSDOS */
2566 ofd
= emacs_open (SDATA (encoded_newname
),
2567 O_WRONLY
| O_TRUNC
| O_CREAT
2568 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2570 #endif /* not MSDOS */
2573 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2575 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2579 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2580 if (emacs_write (ofd
, buf
, n
) != n
)
2581 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2585 /* Preserve the original file modes, and if requested, also its
2587 if (input_file_statable_p
)
2589 if (! NILP (preserve_uid_gid
))
2590 fchown (ofd
, st
.st_uid
, st
.st_gid
);
2591 fchmod (ofd
, st
.st_mode
& 07777);
2593 #endif /* not MSDOS */
2595 /* Closing the output clobbers the file times on some systems. */
2596 if (emacs_close (ofd
) < 0)
2597 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2599 if (input_file_statable_p
)
2601 if (!NILP (keep_time
))
2603 EMACS_TIME atime
, mtime
;
2604 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2605 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2606 if (set_file_times (SDATA (encoded_newname
),
2608 xsignal2 (Qfile_date_error
,
2609 build_string ("Cannot set file date"), newname
);
2615 #if defined (__DJGPP__) && __DJGPP__ > 1
2616 if (input_file_statable_p
)
2618 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2619 and if it can't, it tells so. Otherwise, under MSDOS we usually
2620 get only the READ bit, which will make the copied file read-only,
2621 so it's better not to chmod at all. */
2622 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2623 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2625 #endif /* DJGPP version 2 or newer */
2626 #endif /* not WINDOWSNT */
2628 /* Discard the unwind protects. */
2629 specpdl_ptr
= specpdl
+ count
;
2635 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2636 Smake_directory_internal
, 1, 1, 0,
2637 doc
: /* Create a new directory named DIRECTORY. */)
2639 Lisp_Object directory
;
2641 const unsigned char *dir
;
2642 Lisp_Object handler
;
2643 Lisp_Object encoded_dir
;
2645 CHECK_STRING (directory
);
2646 directory
= Fexpand_file_name (directory
, Qnil
);
2648 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2649 if (!NILP (handler
))
2650 return call2 (handler
, Qmake_directory_internal
, directory
);
2652 encoded_dir
= ENCODE_FILE (directory
);
2654 dir
= SDATA (encoded_dir
);
2657 if (mkdir (dir
) != 0)
2659 if (mkdir (dir
, 0777) != 0)
2661 report_file_error ("Creating directory", list1 (directory
));
2666 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2667 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2669 Lisp_Object directory
;
2671 const unsigned char *dir
;
2672 Lisp_Object handler
;
2673 Lisp_Object encoded_dir
;
2675 CHECK_STRING (directory
);
2676 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2678 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2679 if (!NILP (handler
))
2680 return call2 (handler
, Qdelete_directory
, directory
);
2682 encoded_dir
= ENCODE_FILE (directory
);
2684 dir
= SDATA (encoded_dir
);
2686 if (rmdir (dir
) != 0)
2687 report_file_error ("Removing directory", list1 (directory
));
2692 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2693 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2694 If file has multiple names, it continues to exist with the other names. */)
2696 Lisp_Object filename
;
2698 Lisp_Object handler
;
2699 Lisp_Object encoded_file
;
2700 struct gcpro gcpro1
;
2703 if (!NILP (Ffile_directory_p (filename
))
2704 && NILP (Ffile_symlink_p (filename
)))
2705 xsignal2 (Qfile_error
,
2706 build_string ("Removing old name: is a directory"),
2709 filename
= Fexpand_file_name (filename
, Qnil
);
2711 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2712 if (!NILP (handler
))
2713 return call2 (handler
, Qdelete_file
, filename
);
2715 encoded_file
= ENCODE_FILE (filename
);
2717 if (0 > unlink (SDATA (encoded_file
)))
2718 report_file_error ("Removing old name", list1 (filename
));
2723 internal_delete_file_1 (ignore
)
2729 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2732 internal_delete_file (filename
)
2733 Lisp_Object filename
;
2736 tem
= internal_condition_case_1 (Fdelete_file
, filename
,
2737 Qt
, internal_delete_file_1
);
2741 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2742 "fRename file: \nGRename %s to file: \np",
2743 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2744 If file has names other than FILE, it continues to have those names.
2745 Signals a `file-already-exists' error if a file NEWNAME already exists
2746 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2747 A number as third arg means request confirmation if NEWNAME already exists.
2748 This is what happens in interactive use with M-x. */)
2749 (file
, newname
, ok_if_already_exists
)
2750 Lisp_Object file
, newname
, ok_if_already_exists
;
2752 Lisp_Object handler
;
2753 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2754 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2756 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2757 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2758 CHECK_STRING (file
);
2759 CHECK_STRING (newname
);
2760 file
= Fexpand_file_name (file
, Qnil
);
2762 if ((!NILP (Ffile_directory_p (newname
)))
2764 /* If the file names are identical but for the case,
2765 don't attempt to move directory to itself. */
2766 && (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2769 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2771 newname
= Fexpand_file_name (newname
, Qnil
);
2773 /* If the file name has special constructs in it,
2774 call the corresponding file handler. */
2775 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2777 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2778 if (!NILP (handler
))
2779 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2780 file
, newname
, ok_if_already_exists
));
2782 encoded_file
= ENCODE_FILE (file
);
2783 encoded_newname
= ENCODE_FILE (newname
);
2786 /* If the file names are identical but for the case, don't ask for
2787 confirmation: they simply want to change the letter-case of the
2789 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2791 if (NILP (ok_if_already_exists
)
2792 || INTEGERP (ok_if_already_exists
))
2793 barf_or_query_if_file_exists (newname
, "rename to it",
2794 INTEGERP (ok_if_already_exists
), 0, 0);
2796 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2798 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2799 || 0 > unlink (SDATA (encoded_file
)))
2805 symlink_target
= Ffile_symlink_p (file
);
2806 if (! NILP (symlink_target
))
2807 Fmake_symbolic_link (symlink_target
, newname
,
2808 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2811 Fcopy_file (file
, newname
,
2812 /* We have already prompted if it was an integer,
2813 so don't have copy-file prompt again. */
2814 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2817 Fdelete_file (file
);
2820 report_file_error ("Renaming", list2 (file
, newname
));
2826 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2827 "fAdd name to file: \nGName to add to %s: \np",
2828 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2829 Signals a `file-already-exists' error if a file NEWNAME already exists
2830 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2831 A number as third arg means request confirmation if NEWNAME already exists.
2832 This is what happens in interactive use with M-x. */)
2833 (file
, newname
, ok_if_already_exists
)
2834 Lisp_Object file
, newname
, ok_if_already_exists
;
2836 Lisp_Object handler
;
2837 Lisp_Object encoded_file
, encoded_newname
;
2838 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2840 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2841 encoded_file
= encoded_newname
= Qnil
;
2842 CHECK_STRING (file
);
2843 CHECK_STRING (newname
);
2844 file
= Fexpand_file_name (file
, Qnil
);
2846 if (!NILP (Ffile_directory_p (newname
)))
2847 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2849 newname
= Fexpand_file_name (newname
, Qnil
);
2851 /* If the file name has special constructs in it,
2852 call the corresponding file handler. */
2853 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2854 if (!NILP (handler
))
2855 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2856 newname
, ok_if_already_exists
));
2858 /* If the new name has special constructs in it,
2859 call the corresponding file handler. */
2860 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2861 if (!NILP (handler
))
2862 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2863 newname
, ok_if_already_exists
));
2865 encoded_file
= ENCODE_FILE (file
);
2866 encoded_newname
= ENCODE_FILE (newname
);
2868 if (NILP (ok_if_already_exists
)
2869 || INTEGERP (ok_if_already_exists
))
2870 barf_or_query_if_file_exists (newname
, "make it a new name",
2871 INTEGERP (ok_if_already_exists
), 0, 0);
2873 unlink (SDATA (newname
));
2874 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2875 report_file_error ("Adding new name", list2 (file
, newname
));
2881 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2882 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2883 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2884 Both args must be strings.
2885 Signals a `file-already-exists' error if a file LINKNAME already exists
2886 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2887 A number as third arg means request confirmation if LINKNAME already exists.
2888 This happens for interactive use with M-x. */)
2889 (filename
, linkname
, ok_if_already_exists
)
2890 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2892 Lisp_Object handler
;
2893 Lisp_Object encoded_filename
, encoded_linkname
;
2894 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2896 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2897 encoded_filename
= encoded_linkname
= Qnil
;
2898 CHECK_STRING (filename
);
2899 CHECK_STRING (linkname
);
2900 /* If the link target has a ~, we must expand it to get
2901 a truly valid file name. Otherwise, do not expand;
2902 we want to permit links to relative file names. */
2903 if (SREF (filename
, 0) == '~')
2904 filename
= Fexpand_file_name (filename
, Qnil
);
2906 if (!NILP (Ffile_directory_p (linkname
)))
2907 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2909 linkname
= Fexpand_file_name (linkname
, Qnil
);
2911 /* If the file name has special constructs in it,
2912 call the corresponding file handler. */
2913 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2914 if (!NILP (handler
))
2915 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2916 linkname
, ok_if_already_exists
));
2918 /* If the new link name has special constructs in it,
2919 call the corresponding file handler. */
2920 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2921 if (!NILP (handler
))
2922 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2923 linkname
, ok_if_already_exists
));
2926 encoded_filename
= ENCODE_FILE (filename
);
2927 encoded_linkname
= ENCODE_FILE (linkname
);
2929 if (NILP (ok_if_already_exists
)
2930 || INTEGERP (ok_if_already_exists
))
2931 barf_or_query_if_file_exists (linkname
, "make it a link",
2932 INTEGERP (ok_if_already_exists
), 0, 0);
2933 if (0 > symlink (SDATA (encoded_filename
),
2934 SDATA (encoded_linkname
)))
2936 /* If we didn't complain already, silently delete existing file. */
2937 if (errno
== EEXIST
)
2939 unlink (SDATA (encoded_linkname
));
2940 if (0 <= symlink (SDATA (encoded_filename
),
2941 SDATA (encoded_linkname
)))
2948 report_file_error ("Making symbolic link", list2 (filename
, linkname
));
2955 xsignal1 (Qfile_error
, build_string ("Symbolic links are not supported"));
2957 #endif /* S_IFLNK */
2962 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2963 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2964 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2965 If STRING is nil or a null string, the logical name NAME is deleted. */)
2970 CHECK_STRING (name
);
2972 delete_logical_name (SDATA (name
));
2975 CHECK_STRING (string
);
2977 if (SCHARS (string
) == 0)
2978 delete_logical_name (SDATA (name
));
2980 define_logical_name (SDATA (name
), SDATA (string
));
2989 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2990 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2992 Lisp_Object path
, login
;
2996 CHECK_STRING (path
);
2997 CHECK_STRING (login
);
2999 netresult
= netunam (SDATA (path
), SDATA (login
));
3001 if (netresult
== -1)
3006 #endif /* HPUX_NET */
3008 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
3010 doc
: /* Return t if file FILENAME specifies an absolute file name.
3011 On Unix, this is a name starting with a `/' or a `~'. */)
3013 Lisp_Object filename
;
3015 CHECK_STRING (filename
);
3016 return file_name_absolute_p (SDATA (filename
)) ? Qt
: Qnil
;
3019 /* Return nonzero if file FILENAME exists and can be executed. */
3022 check_executable (filename
)
3026 int len
= strlen (filename
);
3029 if (stat (filename
, &st
) < 0)
3031 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
3032 return ((st
.st_mode
& S_IEXEC
) != 0);
3034 return (S_ISREG (st
.st_mode
)
3036 && (xstrcasecmp ((suffix
= filename
+ len
-4), ".com") == 0
3037 || xstrcasecmp (suffix
, ".exe") == 0
3038 || xstrcasecmp (suffix
, ".bat") == 0)
3039 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3040 #endif /* not WINDOWSNT */
3041 #else /* not DOS_NT */
3042 #ifdef HAVE_EUIDACCESS
3043 return (euidaccess (filename
, 1) >= 0);
3045 /* Access isn't quite right because it uses the real uid
3046 and we really want to test with the effective uid.
3047 But Unix doesn't give us a right way to do it. */
3048 return (access (filename
, 1) >= 0);
3050 #endif /* not DOS_NT */
3053 /* Return nonzero if file FILENAME exists and can be written. */
3056 check_writable (filename
)
3061 if (stat (filename
, &st
) < 0)
3063 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3064 #else /* not MSDOS */
3065 #ifdef HAVE_EUIDACCESS
3066 return (euidaccess (filename
, 2) >= 0);
3068 /* Access isn't quite right because it uses the real uid
3069 and we really want to test with the effective uid.
3070 But Unix doesn't give us a right way to do it.
3071 Opening with O_WRONLY could work for an ordinary file,
3072 but would lose for directories. */
3073 return (access (filename
, 2) >= 0);
3075 #endif /* not MSDOS */
3078 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3079 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
3080 See also `file-readable-p' and `file-attributes'.
3081 This returns nil for a symlink to a nonexistent file.
3082 Use `file-symlink-p' to test for such links. */)
3084 Lisp_Object filename
;
3086 Lisp_Object absname
;
3087 Lisp_Object handler
;
3088 struct stat statbuf
;
3090 CHECK_STRING (filename
);
3091 absname
= Fexpand_file_name (filename
, Qnil
);
3093 /* If the file name has special constructs in it,
3094 call the corresponding file handler. */
3095 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3096 if (!NILP (handler
))
3097 return call2 (handler
, Qfile_exists_p
, absname
);
3099 absname
= ENCODE_FILE (absname
);
3101 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3104 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3105 doc
: /* Return t if FILENAME can be executed by you.
3106 For a directory, this means you can access files in that directory. */)
3108 Lisp_Object filename
;
3110 Lisp_Object absname
;
3111 Lisp_Object handler
;
3113 CHECK_STRING (filename
);
3114 absname
= Fexpand_file_name (filename
, Qnil
);
3116 /* If the file name has special constructs in it,
3117 call the corresponding file handler. */
3118 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3119 if (!NILP (handler
))
3120 return call2 (handler
, Qfile_executable_p
, absname
);
3122 absname
= ENCODE_FILE (absname
);
3124 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3127 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3128 doc
: /* Return t if file FILENAME exists and you can read it.
3129 See also `file-exists-p' and `file-attributes'. */)
3131 Lisp_Object filename
;
3133 Lisp_Object absname
;
3134 Lisp_Object handler
;
3137 struct stat statbuf
;
3139 CHECK_STRING (filename
);
3140 absname
= Fexpand_file_name (filename
, Qnil
);
3142 /* If the file name has special constructs in it,
3143 call the corresponding file handler. */
3144 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3145 if (!NILP (handler
))
3146 return call2 (handler
, Qfile_readable_p
, absname
);
3148 absname
= ENCODE_FILE (absname
);
3150 #if defined(DOS_NT) || defined(macintosh)
3151 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3153 if (access (SDATA (absname
), 0) == 0)
3156 #else /* not DOS_NT and not macintosh */
3158 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3159 /* Opening a fifo without O_NONBLOCK can wait.
3160 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3161 except in the case of a fifo, on a system which handles it. */
3162 desc
= stat (SDATA (absname
), &statbuf
);
3165 if (S_ISFIFO (statbuf
.st_mode
))
3166 flags
|= O_NONBLOCK
;
3168 desc
= emacs_open (SDATA (absname
), flags
, 0);
3173 #endif /* not DOS_NT and not macintosh */
3176 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3178 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3179 doc
: /* Return t if file FILENAME can be written or created by you. */)
3181 Lisp_Object filename
;
3183 Lisp_Object absname
, dir
, encoded
;
3184 Lisp_Object handler
;
3185 struct stat statbuf
;
3187 CHECK_STRING (filename
);
3188 absname
= Fexpand_file_name (filename
, Qnil
);
3190 /* If the file name has special constructs in it,
3191 call the corresponding file handler. */
3192 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3193 if (!NILP (handler
))
3194 return call2 (handler
, Qfile_writable_p
, absname
);
3196 encoded
= ENCODE_FILE (absname
);
3197 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3198 return (check_writable (SDATA (encoded
))
3201 dir
= Ffile_name_directory (absname
);
3204 dir
= Fdirectory_file_name (dir
);
3208 dir
= Fdirectory_file_name (dir
);
3211 dir
= ENCODE_FILE (dir
);
3213 /* The read-only attribute of the parent directory doesn't affect
3214 whether a file or directory can be created within it. Some day we
3215 should check ACLs though, which do affect this. */
3216 if (stat (SDATA (dir
), &statbuf
) < 0)
3218 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3220 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3225 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3226 doc
: /* Access file FILENAME, and get an error if that does not work.
3227 The second argument STRING is used in the error message.
3228 If there is no error, returns nil. */)
3230 Lisp_Object filename
, string
;
3232 Lisp_Object handler
, encoded_filename
, absname
;
3235 CHECK_STRING (filename
);
3236 absname
= Fexpand_file_name (filename
, Qnil
);
3238 CHECK_STRING (string
);
3240 /* If the file name has special constructs in it,
3241 call the corresponding file handler. */
3242 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3243 if (!NILP (handler
))
3244 return call3 (handler
, Qaccess_file
, absname
, string
);
3246 encoded_filename
= ENCODE_FILE (absname
);
3248 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3250 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3256 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3257 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3258 The value is the link target, as a string.
3259 Otherwise it returns nil.
3261 This function returns t when given the name of a symlink that
3262 points to a nonexistent file. */)
3264 Lisp_Object filename
;
3266 Lisp_Object handler
;
3268 CHECK_STRING (filename
);
3269 filename
= Fexpand_file_name (filename
, Qnil
);
3271 /* If the file name has special constructs in it,
3272 call the corresponding file handler. */
3273 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3274 if (!NILP (handler
))
3275 return call2 (handler
, Qfile_symlink_p
, filename
);
3284 filename
= ENCODE_FILE (filename
);
3291 buf
= (char *) xrealloc (buf
, bufsize
);
3292 bzero (buf
, bufsize
);
3295 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3299 /* HP-UX reports ERANGE if buffer is too small. */
3300 if (errno
== ERANGE
)
3310 while (valsize
>= bufsize
);
3312 val
= make_string (buf
, valsize
);
3313 if (buf
[0] == '/' && index (buf
, ':'))
3314 val
= concat2 (build_string ("/:"), val
);
3316 val
= DECODE_FILE (val
);
3319 #else /* not S_IFLNK */
3321 #endif /* not S_IFLNK */
3324 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3325 doc
: /* Return t if FILENAME names an existing directory.
3326 Symbolic links to directories count as directories.
3327 See `file-symlink-p' to distinguish symlinks. */)
3329 Lisp_Object filename
;
3331 register Lisp_Object absname
;
3333 Lisp_Object handler
;
3335 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3337 /* If the file name has special constructs in it,
3338 call the corresponding file handler. */
3339 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3340 if (!NILP (handler
))
3341 return call2 (handler
, Qfile_directory_p
, absname
);
3343 absname
= ENCODE_FILE (absname
);
3345 if (stat (SDATA (absname
), &st
) < 0)
3347 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3350 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3351 doc
: /* Return t if file FILENAME names a directory you can open.
3352 For the value to be t, FILENAME must specify the name of a directory as a file,
3353 and the directory must allow you to open files in it. In order to use a
3354 directory as a buffer's current directory, this predicate must return true.
3355 A directory name spec may be given instead; then the value is t
3356 if the directory so specified exists and really is a readable and
3357 searchable directory. */)
3359 Lisp_Object filename
;
3361 Lisp_Object handler
;
3363 struct gcpro gcpro1
;
3365 /* If the file name has special constructs in it,
3366 call the corresponding file handler. */
3367 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3368 if (!NILP (handler
))
3369 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3372 tem
= (NILP (Ffile_directory_p (filename
))
3373 || NILP (Ffile_executable_p (filename
)));
3375 return tem
? Qnil
: Qt
;
3378 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3379 doc
: /* Return t if FILENAME names a regular file.
3380 This is the sort of file that holds an ordinary stream of data bytes.
3381 Symbolic links to regular files count as regular files.
3382 See `file-symlink-p' to distinguish symlinks. */)
3384 Lisp_Object filename
;
3386 register Lisp_Object absname
;
3388 Lisp_Object handler
;
3390 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3392 /* If the file name has special constructs in it,
3393 call the corresponding file handler. */
3394 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3395 if (!NILP (handler
))
3396 return call2 (handler
, Qfile_regular_p
, absname
);
3398 absname
= ENCODE_FILE (absname
);
3403 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3405 /* Tell stat to use expensive method to get accurate info. */
3406 Vw32_get_true_file_attributes
= Qt
;
3407 result
= stat (SDATA (absname
), &st
);
3408 Vw32_get_true_file_attributes
= tem
;
3412 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3415 if (stat (SDATA (absname
), &st
) < 0)
3417 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3421 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3422 doc
: /* Return mode bits of file named FILENAME, as an integer.
3423 Return nil, if file does not exist or is not accessible. */)
3425 Lisp_Object filename
;
3427 Lisp_Object absname
;
3429 Lisp_Object handler
;
3431 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3433 /* If the file name has special constructs in it,
3434 call the corresponding file handler. */
3435 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3436 if (!NILP (handler
))
3437 return call2 (handler
, Qfile_modes
, absname
);
3439 absname
= ENCODE_FILE (absname
);
3441 if (stat (SDATA (absname
), &st
) < 0)
3443 #if defined (MSDOS) && __DJGPP__ < 2
3444 if (check_executable (SDATA (absname
)))
3445 st
.st_mode
|= S_IEXEC
;
3446 #endif /* MSDOS && __DJGPP__ < 2 */
3448 return make_number (st
.st_mode
& 07777);
3451 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2,
3452 "(let ((file (read-file-name \"File: \"))) \
3453 (list file (read-file-modes nil file)))",
3454 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3455 Only the 12 low bits of MODE are used. */)
3457 Lisp_Object filename
, mode
;
3459 Lisp_Object absname
, encoded_absname
;
3460 Lisp_Object handler
;
3462 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3463 CHECK_NUMBER (mode
);
3465 /* If the file name has special constructs in it,
3466 call the corresponding file handler. */
3467 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3468 if (!NILP (handler
))
3469 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3471 encoded_absname
= ENCODE_FILE (absname
);
3473 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3474 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3479 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3480 doc
: /* Set the file permission bits for newly created files.
3481 The argument MODE should be an integer; only the low 9 bits are used.
3482 This setting is inherited by subprocesses. */)
3486 CHECK_NUMBER (mode
);
3488 umask ((~ XINT (mode
)) & 0777);
3493 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3494 doc
: /* Return the default file protection for created files.
3495 The value is an integer. */)
3501 realmask
= umask (0);
3504 XSETINT (value
, (~ realmask
) & 0777);
3508 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3510 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3511 doc
: /* Set times of file FILENAME to TIME.
3512 Set both access and modification times.
3513 Return t on success, else nil.
3514 Use the current time if TIME is nil. TIME is in the format of
3517 Lisp_Object filename
, time
;
3519 Lisp_Object absname
, encoded_absname
;
3520 Lisp_Object handler
;
3524 if (! lisp_time_argument (time
, &sec
, &usec
))
3525 error ("Invalid time specification");
3527 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3529 /* If the file name has special constructs in it,
3530 call the corresponding file handler. */
3531 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3532 if (!NILP (handler
))
3533 return call3 (handler
, Qset_file_times
, absname
, time
);
3535 encoded_absname
= ENCODE_FILE (absname
);
3540 EMACS_SET_SECS (t
, sec
);
3541 EMACS_SET_USECS (t
, usec
);
3543 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3548 /* Setting times on a directory always fails. */
3549 if (stat (SDATA (encoded_absname
), &st
) == 0
3550 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3553 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3562 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3563 doc
: /* Tell Unix to finish all pending disk updates. */)
3570 #endif /* HAVE_SYNC */
3572 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3573 doc
: /* Return t if file FILE1 is newer than file FILE2.
3574 If FILE1 does not exist, the answer is nil;
3575 otherwise, if FILE2 does not exist, the answer is t. */)
3577 Lisp_Object file1
, file2
;
3579 Lisp_Object absname1
, absname2
;
3582 Lisp_Object handler
;
3583 struct gcpro gcpro1
, gcpro2
;
3585 CHECK_STRING (file1
);
3586 CHECK_STRING (file2
);
3589 GCPRO2 (absname1
, file2
);
3590 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3591 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3594 /* If the file name has special constructs in it,
3595 call the corresponding file handler. */
3596 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3598 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3599 if (!NILP (handler
))
3600 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3602 GCPRO2 (absname1
, absname2
);
3603 absname1
= ENCODE_FILE (absname1
);
3604 absname2
= ENCODE_FILE (absname2
);
3607 if (stat (SDATA (absname1
), &st
) < 0)
3610 mtime1
= st
.st_mtime
;
3612 if (stat (SDATA (absname2
), &st
) < 0)
3615 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3619 Lisp_Object Qfind_buffer_file_type
;
3622 #ifndef READ_BUF_SIZE
3623 #define READ_BUF_SIZE (64 << 10)
3626 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3628 /* This function is called after Lisp functions to decide a coding
3629 system are called, or when they cause an error. Before they are
3630 called, the current buffer is set unibyte and it contains only a
3631 newly inserted text (thus the buffer was empty before the
3634 The functions may set markers, overlays, text properties, or even
3635 alter the buffer contents, change the current buffer.
3637 Here, we reset all those changes by:
3638 o set back the current buffer.
3639 o move all markers and overlays to BEG.
3640 o remove all text properties.
3641 o set back the buffer multibyteness. */
3644 decide_coding_unwind (unwind_data
)
3645 Lisp_Object unwind_data
;
3647 Lisp_Object multibyte
, undo_list
, buffer
;
3649 multibyte
= XCAR (unwind_data
);
3650 unwind_data
= XCDR (unwind_data
);
3651 undo_list
= XCAR (unwind_data
);
3652 buffer
= XCDR (unwind_data
);
3654 if (current_buffer
!= XBUFFER (buffer
))
3655 set_buffer_internal (XBUFFER (buffer
));
3656 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3657 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3658 BUF_INTERVALS (current_buffer
) = 0;
3659 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3661 /* Now we are safe to change the buffer's multibyteness directly. */
3662 current_buffer
->enable_multibyte_characters
= multibyte
;
3663 current_buffer
->undo_list
= undo_list
;
3669 /* Used to pass values from insert-file-contents to read_non_regular. */
3671 static int non_regular_fd
;
3672 static int non_regular_inserted
;
3673 static int non_regular_nbytes
;
3676 /* Read from a non-regular file.
3677 Read non_regular_trytry bytes max from non_regular_fd.
3678 Non_regular_inserted specifies where to put the read bytes.
3679 Value is the number of bytes read. */
3688 nbytes
= emacs_read (non_regular_fd
,
3689 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3690 non_regular_nbytes
);
3692 return make_number (nbytes
);
3696 /* Condition-case handler used when reading from non-regular files
3697 in insert-file-contents. */
3700 read_non_regular_quit ()
3706 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3708 doc
: /* Insert contents of file FILENAME after point.
3709 Returns list of absolute file name and number of characters inserted.
3710 If second argument VISIT is non-nil, the buffer's visited filename and
3711 last save file modtime are set, and it is marked unmodified. If
3712 visiting and the file does not exist, visiting is completed before the
3715 The optional third and fourth arguments BEG and END specify what portion
3716 of the file to insert. These arguments count bytes in the file, not
3717 characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
3719 If optional fifth argument REPLACE is non-nil, replace the current
3720 buffer contents (in the accessible portion) with the file contents.
3721 This is better than simply deleting and inserting the whole thing
3722 because (1) it preserves some marker positions and (2) it puts less data
3723 in the undo list. When REPLACE is non-nil, the second return value is
3724 the number of characters that replace previous buffer contents.
3726 This function does code conversion according to the value of
3727 `coding-system-for-read' or `file-coding-system-alist', and sets the
3728 variable `last-coding-system-used' to the coding system actually used. */)
3729 (filename
, visit
, beg
, end
, replace
)
3730 Lisp_Object filename
, visit
, beg
, end
, replace
;
3736 register int how_much
;
3737 register int unprocessed
;
3738 int count
= SPECPDL_INDEX ();
3739 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3740 Lisp_Object handler
, val
, insval
, orig_filename
, old_undo
;
3743 int not_regular
= 0;
3744 unsigned char read_buf
[READ_BUF_SIZE
];
3745 struct coding_system coding
;
3746 unsigned char buffer
[1 << 14];
3747 int replace_handled
= 0;
3748 int set_coding_system
= 0;
3749 Lisp_Object coding_system
;
3751 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3752 int we_locked_file
= 0;
3754 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3755 error ("Cannot do file visiting in an indirect buffer");
3757 if (!NILP (current_buffer
->read_only
))
3758 Fbarf_if_buffer_read_only ();
3762 orig_filename
= Qnil
;
3765 GCPRO5 (filename
, val
, p
, orig_filename
, old_undo
);
3767 CHECK_STRING (filename
);
3768 filename
= Fexpand_file_name (filename
, Qnil
);
3770 /* The value Qnil means that the coding system is not yet
3772 coding_system
= Qnil
;
3774 /* If the file name has special constructs in it,
3775 call the corresponding file handler. */
3776 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3777 if (!NILP (handler
))
3779 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3780 visit
, beg
, end
, replace
);
3781 if (CONSP (val
) && CONSP (XCDR (val
)))
3782 inserted
= XINT (XCAR (XCDR (val
)));
3786 orig_filename
= filename
;
3787 filename
= ENCODE_FILE (filename
);
3793 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3795 /* Tell stat to use expensive method to get accurate info. */
3796 Vw32_get_true_file_attributes
= Qt
;
3797 total
= stat (SDATA (filename
), &st
);
3798 Vw32_get_true_file_attributes
= tem
;
3802 if (stat (SDATA (filename
), &st
) < 0)
3803 #endif /* WINDOWSNT */
3805 if (fd
>= 0) emacs_close (fd
);
3808 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3811 if (!NILP (Vcoding_system_for_read
))
3812 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3817 /* This code will need to be changed in order to work on named
3818 pipes, and it's probably just not worth it. So we should at
3819 least signal an error. */
3820 if (!S_ISREG (st
.st_mode
))
3827 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3828 xsignal2 (Qfile_error
,
3829 build_string ("not a regular file"), orig_filename
);
3834 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3837 /* Replacement should preserve point as it preserves markers. */
3838 if (!NILP (replace
))
3839 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3841 record_unwind_protect (close_file_unwind
, make_number (fd
));
3843 /* Supposedly happens on VMS. */
3844 /* Can happen on any platform that uses long as type of off_t, but allows
3845 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3846 give a message suitable for the latter case. */
3847 if (! not_regular
&& st
.st_size
< 0)
3848 error ("Maximum buffer size exceeded");
3850 /* Prevent redisplay optimizations. */
3851 current_buffer
->clip_changed
= 1;
3855 if (!NILP (beg
) || !NILP (end
))
3856 error ("Attempt to visit less than an entire file");
3857 if (BEG
< Z
&& NILP (replace
))
3858 error ("Cannot do file visiting in a non-empty buffer");
3864 XSETFASTINT (beg
, 0);
3872 XSETINT (end
, st
.st_size
);
3874 /* Arithmetic overflow can occur if an Emacs integer cannot
3875 represent the file size, or if the calculations below
3876 overflow. The calculations below double the file size
3877 twice, so check that it can be multiplied by 4 safely. */
3878 if (XINT (end
) != st
.st_size
3879 || st
.st_size
> INT_MAX
/ 4)
3880 error ("Maximum buffer size exceeded");
3882 /* The file size returned from stat may be zero, but data
3883 may be readable nonetheless, for example when this is a
3884 file in the /proc filesystem. */
3885 if (st
.st_size
== 0)
3886 XSETINT (end
, READ_BUF_SIZE
);
3890 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3892 coding_system
= coding_inherit_eol_type (Qutf_8_emacs
, Qunix
);
3893 setup_coding_system (coding_system
, &coding
);
3894 /* Ensure we set Vlast_coding_system_used. */
3895 set_coding_system
= 1;
3899 /* Decide the coding system to use for reading the file now
3900 because we can't use an optimized method for handling
3901 `coding:' tag if the current buffer is not empty. */
3902 if (!NILP (Vcoding_system_for_read
))
3903 coding_system
= Vcoding_system_for_read
;
3906 /* Don't try looking inside a file for a coding system
3907 specification if it is not seekable. */
3908 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3910 /* Find a coding system specified in the heading two
3911 lines or in the tailing several lines of the file.
3912 We assume that the 1K-byte and 3K-byte for heading
3913 and tailing respectively are sufficient for this
3917 if (st
.st_size
<= (1024 * 4))
3918 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3921 nread
= emacs_read (fd
, read_buf
, 1024);
3924 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3925 report_file_error ("Setting file position",
3926 Fcons (orig_filename
, Qnil
));
3927 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3932 error ("IO error reading %s: %s",
3933 SDATA (orig_filename
), emacs_strerror (errno
));
3936 struct buffer
*prev
= current_buffer
;
3940 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3942 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3943 buf
= XBUFFER (buffer
);
3945 delete_all_overlays (buf
);
3946 buf
->directory
= current_buffer
->directory
;
3947 buf
->read_only
= Qnil
;
3948 buf
->filename
= Qnil
;
3949 buf
->undo_list
= Qt
;
3950 eassert (buf
->overlays_before
== NULL
);
3951 eassert (buf
->overlays_after
== NULL
);
3953 set_buffer_internal (buf
);
3955 buf
->enable_multibyte_characters
= Qnil
;
3957 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3958 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3959 coding_system
= call2 (Vset_auto_coding_function
,
3960 filename
, make_number (nread
));
3961 set_buffer_internal (prev
);
3963 /* Discard the unwind protect for recovering the
3967 /* Rewind the file for the actual read done later. */
3968 if (lseek (fd
, 0, 0) < 0)
3969 report_file_error ("Setting file position",
3970 Fcons (orig_filename
, Qnil
));
3974 if (NILP (coding_system
))
3976 /* If we have not yet decided a coding system, check
3977 file-coding-system-alist. */
3978 Lisp_Object args
[6];
3980 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3981 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3982 coding_system
= Ffind_operation_coding_system (6, args
);
3983 if (CONSP (coding_system
))
3984 coding_system
= XCAR (coding_system
);
3988 if (NILP (coding_system
))
3989 coding_system
= Qundecided
;
3991 CHECK_CODING_SYSTEM (coding_system
);
3993 if (NILP (current_buffer
->enable_multibyte_characters
))
3994 /* We must suppress all character code conversion except for
3995 end-of-line conversion. */
3996 coding_system
= raw_text_coding_system (coding_system
);
3998 setup_coding_system (coding_system
, &coding
);
3999 /* Ensure we set Vlast_coding_system_used. */
4000 set_coding_system
= 1;
4003 /* If requested, replace the accessible part of the buffer
4004 with the file contents. Avoid replacing text at the
4005 beginning or end of the buffer that matches the file contents;
4006 that preserves markers pointing to the unchanged parts.
4008 Here we implement this feature in an optimized way
4009 for the case where code conversion is NOT needed.
4010 The following if-statement handles the case of conversion
4011 in a less optimal way.
4013 If the code conversion is "automatic" then we try using this
4014 method and hope for the best.
4015 But if we discover the need for conversion, we give up on this method
4016 and let the following if-statement handle the replace job. */
4019 && (NILP (coding_system
)
4020 || ! CODING_REQUIRE_DECODING (&coding
)))
4022 /* same_at_start and same_at_end count bytes,
4023 because file access counts bytes
4024 and BEG and END count bytes. */
4025 int same_at_start
= BEGV_BYTE
;
4026 int same_at_end
= ZV_BYTE
;
4028 /* There is still a possibility we will find the need to do code
4029 conversion. If that happens, we set this variable to 1 to
4030 give up on handling REPLACE in the optimized way. */
4031 int giveup_match_end
= 0;
4033 if (XINT (beg
) != 0)
4035 if (lseek (fd
, XINT (beg
), 0) < 0)
4036 report_file_error ("Setting file position",
4037 Fcons (orig_filename
, Qnil
));
4042 /* Count how many chars at the start of the file
4043 match the text at the beginning of the buffer. */
4048 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4050 error ("IO error reading %s: %s",
4051 SDATA (orig_filename
), emacs_strerror (errno
));
4052 else if (nread
== 0)
4055 if (CODING_REQUIRE_DETECTION (&coding
))
4057 coding_system
= detect_coding_system (buffer
, nread
, nread
, 1, 0,
4059 setup_coding_system (coding_system
, &coding
);
4062 if (CODING_REQUIRE_DECODING (&coding
))
4063 /* We found that the file should be decoded somehow.
4064 Let's give up here. */
4066 giveup_match_end
= 1;
4071 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4072 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4073 same_at_start
++, bufpos
++;
4074 /* If we found a discrepancy, stop the scan.
4075 Otherwise loop around and scan the next bufferful. */
4076 if (bufpos
!= nread
)
4080 /* If the file matches the buffer completely,
4081 there's no need to replace anything. */
4082 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4086 /* Truncate the buffer to the size of the file. */
4087 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4092 /* Count how many chars at the end of the file
4093 match the text at the end of the buffer. But, if we have
4094 already found that decoding is necessary, don't waste time. */
4095 while (!giveup_match_end
)
4097 int total_read
, nread
, bufpos
, curpos
, trial
;
4099 /* At what file position are we now scanning? */
4100 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4101 /* If the entire file matches the buffer tail, stop the scan. */
4104 /* How much can we scan in the next step? */
4105 trial
= min (curpos
, sizeof buffer
);
4106 if (lseek (fd
, curpos
- trial
, 0) < 0)
4107 report_file_error ("Setting file position",
4108 Fcons (orig_filename
, Qnil
));
4110 total_read
= nread
= 0;
4111 while (total_read
< trial
)
4113 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4115 error ("IO error reading %s: %s",
4116 SDATA (orig_filename
), emacs_strerror (errno
));
4117 else if (nread
== 0)
4119 total_read
+= nread
;
4122 /* Scan this bufferful from the end, comparing with
4123 the Emacs buffer. */
4124 bufpos
= total_read
;
4126 /* Compare with same_at_start to avoid counting some buffer text
4127 as matching both at the file's beginning and at the end. */
4128 while (bufpos
> 0 && same_at_end
> same_at_start
4129 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4130 same_at_end
--, bufpos
--;
4132 /* If we found a discrepancy, stop the scan.
4133 Otherwise loop around and scan the preceding bufferful. */
4136 /* If this discrepancy is because of code conversion,
4137 we cannot use this method; giveup and try the other. */
4138 if (same_at_end
> same_at_start
4139 && FETCH_BYTE (same_at_end
- 1) >= 0200
4140 && ! NILP (current_buffer
->enable_multibyte_characters
)
4141 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4142 giveup_match_end
= 1;
4151 if (! giveup_match_end
)
4155 /* We win! We can handle REPLACE the optimized way. */
4157 /* Extend the start of non-matching text area to multibyte
4158 character boundary. */
4159 if (! NILP (current_buffer
->enable_multibyte_characters
))
4160 while (same_at_start
> BEGV_BYTE
4161 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4164 /* Extend the end of non-matching text area to multibyte
4165 character boundary. */
4166 if (! NILP (current_buffer
->enable_multibyte_characters
))
4167 while (same_at_end
< ZV_BYTE
4168 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4171 /* Don't try to reuse the same piece of text twice. */
4172 overlap
= (same_at_start
- BEGV_BYTE
4173 - (same_at_end
+ st
.st_size
- ZV
));
4175 same_at_end
+= overlap
;
4177 /* Arrange to read only the nonmatching middle part of the file. */
4178 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4179 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4181 del_range_byte (same_at_start
, same_at_end
, 0);
4182 /* Insert from the file at the proper position. */
4183 temp
= BYTE_TO_CHAR (same_at_start
);
4184 SET_PT_BOTH (temp
, same_at_start
);
4186 /* If display currently starts at beginning of line,
4187 keep it that way. */
4188 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4189 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4191 replace_handled
= 1;
4195 /* If requested, replace the accessible part of the buffer
4196 with the file contents. Avoid replacing text at the
4197 beginning or end of the buffer that matches the file contents;
4198 that preserves markers pointing to the unchanged parts.
4200 Here we implement this feature for the case where code conversion
4201 is needed, in a simple way that needs a lot of memory.
4202 The preceding if-statement handles the case of no conversion
4203 in a more optimized way. */
4204 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4206 EMACS_INT same_at_start
= BEGV_BYTE
;
4207 EMACS_INT same_at_end
= ZV_BYTE
;
4208 EMACS_INT same_at_start_charpos
;
4209 EMACS_INT inserted_chars
;
4212 unsigned char *decoded
;
4214 int this_count
= SPECPDL_INDEX ();
4215 int multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
4216 Lisp_Object conversion_buffer
;
4218 conversion_buffer
= code_conversion_save (1, multibyte
);
4220 /* First read the whole file, performing code conversion into
4221 CONVERSION_BUFFER. */
4223 if (lseek (fd
, XINT (beg
), 0) < 0)
4224 report_file_error ("Setting file position",
4225 Fcons (orig_filename
, Qnil
));
4227 total
= st
.st_size
; /* Total bytes in the file. */
4228 how_much
= 0; /* Bytes read from file so far. */
4229 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4230 unprocessed
= 0; /* Bytes not processed in previous loop. */
4232 GCPRO1 (conversion_buffer
);
4233 while (how_much
< total
)
4235 /* We read one bunch by one (READ_BUF_SIZE bytes) to allow
4236 quitting while reading a huge while. */
4237 /* try is reserved in some compilers (Microsoft C) */
4238 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4241 /* Allow quitting out of the actual I/O. */
4244 this = emacs_read (fd
, read_buf
+ unprocessed
, trytry
);
4256 BUF_TEMP_SET_PT (XBUFFER (conversion_buffer
),
4257 BUF_Z (XBUFFER (conversion_buffer
)));
4258 decode_coding_c_string (&coding
, read_buf
, unprocessed
+ this,
4260 unprocessed
= coding
.carryover_bytes
;
4261 if (coding
.carryover_bytes
> 0)
4262 bcopy (coding
.carryover
, read_buf
, unprocessed
);
4267 /* At this point, HOW_MUCH should equal TOTAL, or should be <= 0
4268 if we couldn't read the file. */
4271 error ("IO error reading %s: %s",
4272 SDATA (orig_filename
), emacs_strerror (errno
));
4274 if (unprocessed
> 0)
4276 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4277 decode_coding_c_string (&coding
, read_buf
, unprocessed
,
4279 coding
.mode
&= ~CODING_MODE_LAST_BLOCK
;
4282 decoded
= BUF_BEG_ADDR (XBUFFER (conversion_buffer
));
4283 inserted
= (BUF_Z_BYTE (XBUFFER (conversion_buffer
))
4284 - BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
4286 /* Compare the beginning of the converted string with the buffer
4290 while (bufpos
< inserted
&& same_at_start
< same_at_end
4291 && FETCH_BYTE (same_at_start
) == decoded
[bufpos
])
4292 same_at_start
++, bufpos
++;
4294 /* If the file matches the head of buffer completely,
4295 there's no need to replace anything. */
4297 if (bufpos
== inserted
)
4300 /* Truncate the buffer to the size of the file. */
4301 if (same_at_start
== same_at_end
)
4304 del_range_byte (same_at_start
, same_at_end
, 0);
4307 unbind_to (this_count
, Qnil
);
4311 /* Extend the start of non-matching text area to the previous
4312 multibyte character boundary. */
4313 if (! NILP (current_buffer
->enable_multibyte_characters
))
4314 while (same_at_start
> BEGV_BYTE
4315 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4318 /* Scan this bufferful from the end, comparing with
4319 the Emacs buffer. */
4322 /* Compare with same_at_start to avoid counting some buffer text
4323 as matching both at the file's beginning and at the end. */
4324 while (bufpos
> 0 && same_at_end
> same_at_start
4325 && FETCH_BYTE (same_at_end
- 1) == decoded
[bufpos
- 1])
4326 same_at_end
--, bufpos
--;
4328 /* Extend the end of non-matching text area to the next
4329 multibyte character boundary. */
4330 if (! NILP (current_buffer
->enable_multibyte_characters
))
4331 while (same_at_end
< ZV_BYTE
4332 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4335 /* Don't try to reuse the same piece of text twice. */
4336 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4338 same_at_end
+= overlap
;
4340 /* If display currently starts at beginning of line,
4341 keep it that way. */
4342 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4343 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4345 /* Replace the chars that we need to replace,
4346 and update INSERTED to equal the number of bytes
4347 we are taking from the decoded string. */
4348 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4350 if (same_at_end
!= same_at_start
)
4352 del_range_byte (same_at_start
, same_at_end
, 0);
4354 same_at_start
= GPT_BYTE
;
4358 temp
= BYTE_TO_CHAR (same_at_start
);
4360 /* Insert from the file at the proper position. */
4361 SET_PT_BOTH (temp
, same_at_start
);
4362 same_at_start_charpos
4363 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4364 same_at_start
- BEGV_BYTE
4365 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
4367 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4368 same_at_start
+ inserted
- BEGV_BYTE
4369 + BUF_BEG_BYTE (XBUFFER (conversion_buffer
)))
4370 - same_at_start_charpos
);
4371 /* This binding is to avoid ask-user-about-supersession-threat
4372 being called in insert_from_buffer (via in
4373 prepare_to_modify_buffer). */
4374 specbind (intern ("buffer-file-name"), Qnil
);
4375 insert_from_buffer (XBUFFER (conversion_buffer
),
4376 same_at_start_charpos
, inserted_chars
, 0);
4377 /* Set `inserted' to the number of inserted characters. */
4378 inserted
= PT
- temp
;
4379 /* Set point before the inserted characters. */
4380 SET_PT_BOTH (temp
, same_at_start
);
4382 unbind_to (this_count
, Qnil
);
4389 register Lisp_Object temp
;
4391 total
= XINT (end
) - XINT (beg
);
4393 /* Make sure point-max won't overflow after this insertion. */
4394 XSETINT (temp
, total
);
4395 if (total
!= XINT (temp
))
4396 error ("Maximum buffer size exceeded");
4399 /* For a special file, all we can do is guess. */
4400 total
= READ_BUF_SIZE
;
4402 if (NILP (visit
) && inserted
> 0)
4404 #ifdef CLASH_DETECTION
4405 if (!NILP (current_buffer
->file_truename
)
4406 /* Make binding buffer-file-name to nil effective. */
4407 && !NILP (current_buffer
->filename
)
4408 && SAVE_MODIFF
>= MODIFF
)
4410 #endif /* CLASH_DETECTION */
4411 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
4415 if (GAP_SIZE
< total
)
4416 make_gap (total
- GAP_SIZE
);
4418 if (XINT (beg
) != 0 || !NILP (replace
))
4420 if (lseek (fd
, XINT (beg
), 0) < 0)
4421 report_file_error ("Setting file position",
4422 Fcons (orig_filename
, Qnil
));
4425 /* In the following loop, HOW_MUCH contains the total bytes read so
4426 far for a regular file, and not changed for a special file. But,
4427 before exiting the loop, it is set to a negative value if I/O
4431 /* Total bytes inserted. */
4434 /* Here, we don't do code conversion in the loop. It is done by
4435 decode_coding_gap after all data are read into the buffer. */
4437 int gap_size
= GAP_SIZE
;
4439 while (how_much
< total
)
4441 /* try is reserved in some compilers (Microsoft C) */
4442 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4449 /* Maybe make more room. */
4450 if (gap_size
< trytry
)
4452 make_gap (total
- gap_size
);
4453 gap_size
= GAP_SIZE
;
4456 /* Read from the file, capturing `quit'. When an
4457 error occurs, end the loop, and arrange for a quit
4458 to be signaled after decoding the text we read. */
4459 non_regular_fd
= fd
;
4460 non_regular_inserted
= inserted
;
4461 non_regular_nbytes
= trytry
;
4462 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4463 read_non_regular_quit
);
4474 /* Allow quitting out of the actual I/O. We don't make text
4475 part of the buffer until all the reading is done, so a C-g
4476 here doesn't do any harm. */
4479 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4491 /* For a regular file, where TOTAL is the real size,
4492 count HOW_MUCH to compare with it.
4493 For a special file, where TOTAL is just a buffer size,
4494 so don't bother counting in HOW_MUCH.
4495 (INSERTED is where we count the number of characters inserted.) */
4502 /* Now we have read all the file data into the gap.
4503 If it was empty, undo marking the buffer modified. */
4507 #ifdef CLASH_DETECTION
4509 unlock_file (current_buffer
->file_truename
);
4511 Vdeactivate_mark
= old_Vdeactivate_mark
;
4514 Vdeactivate_mark
= Qt
;
4516 /* Make the text read part of the buffer. */
4517 GAP_SIZE
-= inserted
;
4519 GPT_BYTE
+= inserted
;
4521 ZV_BYTE
+= inserted
;
4526 /* Put an anchor to ensure multi-byte form ends at gap. */
4531 /* Discard the unwind protect for closing the file. */
4535 error ("IO error reading %s: %s",
4536 SDATA (orig_filename
), emacs_strerror (errno
));
4540 if (NILP (coding_system
))
4542 /* The coding system is not yet decided. Decide it by an
4543 optimized method for handling `coding:' tag.
4545 Note that we can get here only if the buffer was empty
4546 before the insertion. */
4548 if (!NILP (Vcoding_system_for_read
))
4549 coding_system
= Vcoding_system_for_read
;
4552 /* Since we are sure that the current buffer was empty
4553 before the insertion, we can toggle
4554 enable-multibyte-characters directly here without taking
4555 care of marker adjustment. By this way, we can run Lisp
4556 program safely before decoding the inserted text. */
4557 Lisp_Object unwind_data
;
4558 int count
= SPECPDL_INDEX ();
4560 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4561 Fcons (current_buffer
->undo_list
,
4562 Fcurrent_buffer ()));
4563 current_buffer
->enable_multibyte_characters
= Qnil
;
4564 current_buffer
->undo_list
= Qt
;
4565 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4567 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4569 coding_system
= call2 (Vset_auto_coding_function
,
4570 filename
, make_number (inserted
));
4573 if (NILP (coding_system
))
4575 /* If the coding system is not yet decided, check
4576 file-coding-system-alist. */
4577 Lisp_Object args
[6];
4579 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4580 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4581 coding_system
= Ffind_operation_coding_system (6, args
);
4582 if (CONSP (coding_system
))
4583 coding_system
= XCAR (coding_system
);
4585 unbind_to (count
, Qnil
);
4586 inserted
= Z_BYTE
- BEG_BYTE
;
4589 if (NILP (coding_system
))
4590 coding_system
= Qundecided
;
4592 CHECK_CODING_SYSTEM (coding_system
);
4594 if (NILP (current_buffer
->enable_multibyte_characters
))
4595 /* We must suppress all character code conversion except for
4596 end-of-line conversion. */
4597 coding_system
= raw_text_coding_system (coding_system
);
4598 setup_coding_system (coding_system
, &coding
);
4599 /* Ensure we set Vlast_coding_system_used. */
4600 set_coding_system
= 1;
4605 /* When we visit a file by raw-text, we change the buffer to
4607 if (CODING_FOR_UNIBYTE (&coding
)
4608 /* Can't do this if part of the buffer might be preserved. */
4610 /* Visiting a file with these coding system makes the buffer
4612 current_buffer
->enable_multibyte_characters
= Qnil
;
4615 coding
.dst_multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
4616 if (CODING_MAY_REQUIRE_DECODING (&coding
)
4617 && (inserted
> 0 || CODING_REQUIRE_FLUSHING (&coding
)))
4619 move_gap_both (PT
, PT_BYTE
);
4620 GAP_SIZE
+= inserted
;
4621 ZV_BYTE
-= inserted
;
4625 decode_coding_gap (&coding
, inserted
, inserted
);
4626 inserted
= coding
.produced_char
;
4627 coding_system
= CODING_ID_NAME (coding
.id
);
4629 else if (inserted
> 0)
4630 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4633 /* Now INSERTED is measured in characters. */
4636 /* Use the conversion type to determine buffer-file-type
4637 (find-buffer-file-type is now used to help determine the
4639 if ((VECTORP (CODING_ID_EOL_TYPE (coding
.id
))
4640 || EQ (CODING_ID_EOL_TYPE (coding
.id
), Qunix
))
4641 && ! CODING_REQUIRE_DECODING (&coding
))
4642 current_buffer
->buffer_file_type
= Qt
;
4644 current_buffer
->buffer_file_type
= Qnil
;
4651 if (!EQ (current_buffer
->undo_list
, Qt
) && !nochange
)
4652 current_buffer
->undo_list
= Qnil
;
4656 current_buffer
->modtime
= st
.st_mtime
;
4657 current_buffer
->filename
= orig_filename
;
4660 SAVE_MODIFF
= MODIFF
;
4661 current_buffer
->auto_save_modified
= MODIFF
;
4662 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4663 #ifdef CLASH_DETECTION
4666 if (!NILP (current_buffer
->file_truename
))
4667 unlock_file (current_buffer
->file_truename
);
4668 unlock_file (filename
);
4670 #endif /* CLASH_DETECTION */
4672 xsignal2 (Qfile_error
,
4673 build_string ("not a regular file"), orig_filename
);
4676 if (set_coding_system
)
4677 Vlast_coding_system_used
= coding_system
;
4679 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4681 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4683 if (! NILP (insval
))
4685 CHECK_NUMBER (insval
);
4686 inserted
= XFASTINT (insval
);
4690 /* Decode file format */
4693 /* Don't run point motion or modification hooks when decoding. */
4694 int count
= SPECPDL_INDEX ();
4695 specbind (Qinhibit_point_motion_hooks
, Qt
);
4696 specbind (Qinhibit_modification_hooks
, Qt
);
4698 /* Save old undo list and don't record undo for decoding. */
4699 old_undo
= current_buffer
->undo_list
;
4700 current_buffer
->undo_list
= Qt
;
4704 insval
= call3 (Qformat_decode
,
4705 Qnil
, make_number (inserted
), visit
);
4706 CHECK_NUMBER (insval
);
4707 inserted
= XFASTINT (insval
);
4711 /* If REPLACE is non-nil and we succeeded in not replacing the
4712 beginning or end of the buffer text with the file's contents,
4713 call format-decode with `point' positioned at the beginning of
4714 the buffer and `inserted' equalling the number of characters
4715 in the buffer. Otherwise, format-decode might fail to
4716 correctly analyze the beginning or end of the buffer. Hence
4717 we temporarily save `point' and `inserted' here and restore
4718 `point' iff format-decode did not insert or delete any text.
4719 Otherwise we leave `point' at point-min. */
4721 int opoint_byte
= PT_BYTE
;
4722 int oinserted
= ZV
- BEGV
;
4723 int ochars_modiff
= CHARS_MODIFF
;
4725 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4726 insval
= call3 (Qformat_decode
,
4727 Qnil
, make_number (oinserted
), visit
);
4728 CHECK_NUMBER (insval
);
4729 if (ochars_modiff
== CHARS_MODIFF
)
4730 /* format_decode didn't modify buffer's characters => move
4731 point back to position before inserted text and leave
4732 value of inserted alone. */
4733 SET_PT_BOTH (opoint
, opoint_byte
);
4735 /* format_decode modified buffer's characters => consider
4736 entire buffer changed and leave point at point-min. */
4737 inserted
= XFASTINT (insval
);
4740 /* For consistency with format-decode call these now iff inserted > 0
4741 (martin 2007-06-28) */
4742 p
= Vafter_insert_file_functions
;
4747 insval
= call1 (XCAR (p
), make_number (inserted
));
4750 CHECK_NUMBER (insval
);
4751 inserted
= XFASTINT (insval
);
4756 /* For the rationale of this see the comment on format-decode above. */
4758 int opoint_byte
= PT_BYTE
;
4759 int oinserted
= ZV
- BEGV
;
4760 int ochars_modiff
= CHARS_MODIFF
;
4762 TEMP_SET_PT_BOTH (BEGV
, BEGV_BYTE
);
4763 insval
= call1 (XCAR (p
), make_number (oinserted
));
4766 CHECK_NUMBER (insval
);
4767 if (ochars_modiff
== CHARS_MODIFF
)
4768 /* after_insert_file_functions didn't modify
4769 buffer's characters => move point back to
4770 position before inserted text and leave value of
4772 SET_PT_BOTH (opoint
, opoint_byte
);
4774 /* after_insert_file_functions did modify buffer's
4775 characters => consider entire buffer changed and
4776 leave point at point-min. */
4777 inserted
= XFASTINT (insval
);
4787 Lisp_Object lbeg
, lend
;
4789 XSETINT (lend
, PT
+ inserted
);
4790 if (CONSP (old_undo
))
4792 Lisp_Object tem
= XCAR (old_undo
);
4793 if (CONSP (tem
) && INTEGERP (XCAR (tem
)) &&
4794 INTEGERP (XCDR (tem
)) && EQ (XCAR (tem
), lbeg
))
4795 /* In the non-visiting case record only the final insertion. */
4796 current_buffer
->undo_list
=
4797 Fcons (Fcons (lbeg
, lend
), Fcdr (old_undo
));
4801 /* If undo_list was Qt before, keep it that way.
4802 Otherwise start with an empty undo_list. */
4803 current_buffer
->undo_list
= EQ (old_undo
, Qt
) ? Qt
: Qnil
;
4805 unbind_to (count
, Qnil
);
4808 /* Call after-change hooks for the inserted text, aside from the case
4809 of normal visiting (not with REPLACE), which is done in a new buffer
4810 "before" the buffer is changed. */
4811 if (inserted
> 0 && total
> 0
4812 && (NILP (visit
) || !NILP (replace
)))
4814 signal_after_change (PT
, 0, inserted
);
4815 update_compositions (PT
, PT
, CHECK_BORDER
);
4819 && current_buffer
->modtime
== -1)
4821 /* If visiting nonexistent file, return nil. */
4822 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4826 Fsignal (Qquit
, Qnil
);
4828 /* ??? Retval needs to be dealt with in all cases consistently. */
4830 val
= Fcons (orig_filename
,
4831 Fcons (make_number (inserted
),
4834 RETURN_UNGCPRO (unbind_to (count
, val
));
4837 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4839 /* If build_annotations switched buffers, switch back to BUF.
4840 Kill the temporary buffer that was selected in the meantime.
4842 Since this kill only the last temporary buffer, some buffers remain
4843 not killed if build_annotations switched buffers more than once.
4847 build_annotations_unwind (buf
)
4852 if (XBUFFER (buf
) == current_buffer
)
4854 tembuf
= Fcurrent_buffer ();
4856 Fkill_buffer (tembuf
);
4860 /* Decide the coding-system to encode the data with. */
4863 choose_write_coding_system (start
, end
, filename
,
4864 append
, visit
, lockname
, coding
)
4865 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4866 struct coding_system
*coding
;
4869 Lisp_Object eol_parent
= Qnil
;
4872 && NILP (Fstring_equal (current_buffer
->filename
,
4873 current_buffer
->auto_save_file_name
)))
4878 else if (!NILP (Vcoding_system_for_write
))
4880 val
= Vcoding_system_for_write
;
4881 if (coding_system_require_warning
4882 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4883 /* Confirm that VAL can surely encode the current region. */
4884 val
= call5 (Vselect_safe_coding_system_function
,
4885 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4890 /* If the variable `buffer-file-coding-system' is set locally,
4891 it means that the file was read with some kind of code
4892 conversion or the variable is explicitly set by users. We
4893 had better write it out with the same coding system even if
4894 `enable-multibyte-characters' is nil.
4896 If it is not set locally, we anyway have to convert EOL
4897 format if the default value of `buffer-file-coding-system'
4898 tells that it is not Unix-like (LF only) format. */
4899 int using_default_coding
= 0;
4900 int force_raw_text
= 0;
4902 val
= current_buffer
->buffer_file_coding_system
;
4904 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4907 if (NILP (current_buffer
->enable_multibyte_characters
))
4913 /* Check file-coding-system-alist. */
4914 Lisp_Object args
[7], coding_systems
;
4916 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4917 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4919 coding_systems
= Ffind_operation_coding_system (7, args
);
4920 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4921 val
= XCDR (coding_systems
);
4926 /* If we still have not decided a coding system, use the
4927 default value of buffer-file-coding-system. */
4928 val
= current_buffer
->buffer_file_coding_system
;
4929 using_default_coding
= 1;
4932 if (! NILP (val
) && ! force_raw_text
)
4934 Lisp_Object spec
, attrs
;
4936 CHECK_CODING_SYSTEM_GET_SPEC (val
, spec
);
4937 attrs
= AREF (spec
, 0);
4938 if (EQ (CODING_ATTR_TYPE (attrs
), Qraw_text
))
4943 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4944 /* Confirm that VAL can surely encode the current region. */
4945 val
= call5 (Vselect_safe_coding_system_function
,
4946 start
, end
, val
, Qnil
, filename
);
4948 /* If the decided coding-system doesn't specify end-of-line
4949 format, we use that of
4950 `default-buffer-file-coding-system'. */
4951 if (! using_default_coding
4952 && ! NILP (buffer_defaults
.buffer_file_coding_system
))
4953 val
= (coding_inherit_eol_type
4954 (val
, buffer_defaults
.buffer_file_coding_system
));
4956 /* If we decide not to encode text, use `raw-text' or one of its
4959 val
= raw_text_coding_system (val
);
4962 val
= coding_inherit_eol_type (val
, eol_parent
);
4963 setup_coding_system (val
, coding
);
4965 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4966 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4970 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4971 "r\nFWrite region to file: \ni\ni\ni\np",
4972 doc
: /* Write current region into specified file.
4973 When called from a program, requires three arguments:
4974 START, END and FILENAME. START and END are normally buffer positions
4975 specifying the part of the buffer to write.
4976 If START is nil, that means to use the entire buffer contents.
4977 If START is a string, then output that string to the file
4978 instead of any buffer contents; END is ignored.
4980 Optional fourth argument APPEND if non-nil means
4981 append to existing file contents (if any). If it is an integer,
4982 seek to that offset in the file before writing.
4983 Optional fifth argument VISIT, if t or a string, means
4984 set the last-save-file-modtime of buffer to this file's modtime
4985 and mark buffer not modified.
4986 If VISIT is a string, it is a second file name;
4987 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4988 VISIT is also the file name to lock and unlock for clash detection.
4989 If VISIT is neither t nor nil nor a string,
4990 that means do not display the \"Wrote file\" message.
4991 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4992 use for locking and unlocking, overriding FILENAME and VISIT.
4993 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4994 for an existing file with the same name. If MUSTBENEW is `excl',
4995 that means to get an error if the file already exists; never overwrite.
4996 If MUSTBENEW is neither nil nor `excl', that means ask for
4997 confirmation before overwriting, but do go ahead and overwrite the file
4998 if the user confirms.
5000 This does code conversion according to the value of
5001 `coding-system-for-write', `buffer-file-coding-system', or
5002 `file-coding-system-alist', and sets the variable
5003 `last-coding-system-used' to the coding system actually used. */)
5004 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
5005 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
5010 const unsigned char *fn
;
5012 int count
= SPECPDL_INDEX ();
5015 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
5017 Lisp_Object handler
;
5018 Lisp_Object visit_file
;
5019 Lisp_Object annotations
;
5020 Lisp_Object encoded_filename
;
5021 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
5022 int quietly
= !NILP (visit
);
5023 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5024 struct buffer
*given_buffer
;
5026 int buffer_file_type
= O_BINARY
;
5028 struct coding_system coding
;
5030 if (current_buffer
->base_buffer
&& visiting
)
5031 error ("Cannot do file visiting in an indirect buffer");
5033 if (!NILP (start
) && !STRINGP (start
))
5034 validate_region (&start
, &end
);
5037 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
5039 filename
= Fexpand_file_name (filename
, Qnil
);
5041 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
5042 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
5044 if (STRINGP (visit
))
5045 visit_file
= Fexpand_file_name (visit
, Qnil
);
5047 visit_file
= filename
;
5049 if (NILP (lockname
))
5050 lockname
= visit_file
;
5054 /* If the file name has special constructs in it,
5055 call the corresponding file handler. */
5056 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
5057 /* If FILENAME has no handler, see if VISIT has one. */
5058 if (NILP (handler
) && STRINGP (visit
))
5059 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
5061 if (!NILP (handler
))
5064 val
= call6 (handler
, Qwrite_region
, start
, end
,
5065 filename
, append
, visit
);
5069 SAVE_MODIFF
= MODIFF
;
5070 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5071 current_buffer
->filename
= visit_file
;
5077 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
5079 /* Special kludge to simplify auto-saving. */
5082 /* Do it later, so write-region-annotate-function can work differently
5083 if we save "the buffer" vs "a region".
5084 This is useful in tar-mode. --Stef
5085 XSETFASTINT (start, BEG);
5086 XSETFASTINT (end, Z); */
5090 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
5091 count1
= SPECPDL_INDEX ();
5093 given_buffer
= current_buffer
;
5095 if (!STRINGP (start
))
5097 annotations
= build_annotations (start
, end
);
5099 if (current_buffer
!= given_buffer
)
5101 XSETFASTINT (start
, BEGV
);
5102 XSETFASTINT (end
, ZV
);
5108 XSETFASTINT (start
, BEGV
);
5109 XSETFASTINT (end
, ZV
);
5114 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
5116 /* Decide the coding-system to encode the data with.
5117 We used to make this choice before calling build_annotations, but that
5118 leads to problems when a write-annotate-function takes care of
5119 unsavable chars (as was the case with X-Symbol). */
5120 Vlast_coding_system_used
5121 = choose_write_coding_system (start
, end
, filename
,
5122 append
, visit
, lockname
, &coding
);
5124 #ifdef CLASH_DETECTION
5127 #if 0 /* This causes trouble for GNUS. */
5128 /* If we've locked this file for some other buffer,
5129 query before proceeding. */
5130 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5131 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5134 lock_file (lockname
);
5136 #endif /* CLASH_DETECTION */
5138 encoded_filename
= ENCODE_FILE (filename
);
5140 fn
= SDATA (encoded_filename
);
5144 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5145 #else /* not DOS_NT */
5146 desc
= emacs_open (fn
, O_WRONLY
, 0);
5147 #endif /* not DOS_NT */
5149 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5151 if (auto_saving
) /* Overwrite any previous version of autosave file */
5153 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5154 desc
= emacs_open (fn
, O_RDWR
, 0);
5156 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5157 ? SDATA (current_buffer
->filename
) : 0,
5160 else /* Write to temporary name and rename if no errors */
5162 Lisp_Object temp_name
;
5163 temp_name
= Ffile_name_directory (filename
);
5165 if (!NILP (temp_name
))
5167 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5168 build_string ("$$SAVE$$")));
5169 fname
= SDATA (filename
);
5170 fn
= SDATA (temp_name
);
5171 desc
= creat_copy_attrs (fname
, fn
);
5174 /* If we can't open the temporary file, try creating a new
5175 version of the original file. VMS "creat" creates a
5176 new version rather than truncating an existing file. */
5179 desc
= creat (fn
, 0666);
5180 #if 0 /* This can clobber an existing file and fail to replace it,
5181 if the user runs out of space. */
5184 /* We can't make a new version;
5185 try to truncate and rewrite existing version if any. */
5187 desc
= emacs_open (fn
, O_RDWR
, 0);
5193 desc
= creat (fn
, 0666);
5197 desc
= emacs_open (fn
,
5198 O_WRONLY
| O_CREAT
| buffer_file_type
5199 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5200 S_IREAD
| S_IWRITE
);
5201 #else /* not DOS_NT */
5202 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5203 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5204 auto_saving
? auto_save_mode_bits
: 0666);
5205 #endif /* not DOS_NT */
5206 #endif /* not VMS */
5210 #ifdef CLASH_DETECTION
5212 if (!auto_saving
) unlock_file (lockname
);
5214 #endif /* CLASH_DETECTION */
5216 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5219 record_unwind_protect (close_file_unwind
, make_number (desc
));
5221 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5225 if (NUMBERP (append
))
5226 ret
= lseek (desc
, XINT (append
), 1);
5228 ret
= lseek (desc
, 0, 2);
5231 #ifdef CLASH_DETECTION
5232 if (!auto_saving
) unlock_file (lockname
);
5233 #endif /* CLASH_DETECTION */
5235 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5243 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5244 * if we do writes that don't end with a carriage return. Furthermore
5245 * it cannot handle writes of more then 16K. The modified
5246 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5247 * this EXCEPT for the last record (if it doesn't end with a carriage
5248 * return). This implies that if your buffer doesn't end with a carriage
5249 * return, you get one free... tough. However it also means that if
5250 * we make two calls to sys_write (a la the following code) you can
5251 * get one at the gap as well. The easiest way to fix this (honest)
5252 * is to move the gap to the next newline (or the end of the buffer).
5257 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5258 move_gap (find_next_newline (GPT
, 1));
5261 /* The new encoding routine doesn't require the following. */
5263 /* Whether VMS or not, we must move the gap to the next of newline
5264 when we must put designation sequences at beginning of line. */
5265 if (INTEGERP (start
)
5266 && coding
.type
== coding_type_iso2022
5267 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5268 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5270 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5271 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5272 move_gap_both (PT
, PT_BYTE
);
5273 SET_PT_BOTH (opoint
, opoint_byte
);
5281 if (STRINGP (start
))
5283 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5284 &annotations
, &coding
);
5287 else if (XINT (start
) != XINT (end
))
5289 failure
= 0 > a_write (desc
, Qnil
,
5290 XINT (start
), XINT (end
) - XINT (start
),
5291 &annotations
, &coding
);
5296 /* If file was empty, still need to write the annotations */
5297 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5298 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5302 if (CODING_REQUIRE_FLUSHING (&coding
)
5303 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5306 /* We have to flush out a data. */
5307 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5308 failure
= 0 > e_write (desc
, Qnil
, 1, 1, &coding
);
5315 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5316 Disk full in NFS may be reported here. */
5317 /* mib says that closing the file will try to write as fast as NFS can do
5318 it, and that means the fsync here is not crucial for autosave files. */
5319 if (!auto_saving
&& !write_region_inhibit_fsync
&& fsync (desc
) < 0)
5321 /* If fsync fails with EINTR, don't treat that as serious. Also
5322 ignore EINVAL which happens when fsync is not supported on this
5324 if (errno
!= EINTR
&& errno
!= EINVAL
)
5325 failure
= 1, save_errno
= errno
;
5329 /* Spurious "file has changed on disk" warnings have been
5330 observed on Suns as well.
5331 It seems that `close' can change the modtime, under nfs.
5333 (This has supposedly been fixed in Sunos 4,
5334 but who knows about all the other machines with NFS?) */
5337 /* On VMS, must do the stat after the close
5338 since closing changes the modtime. */
5340 /* Recall that #if defined does not work on VMS. */
5346 /* NFS can report a write failure now. */
5347 if (emacs_close (desc
) < 0)
5348 failure
= 1, save_errno
= errno
;
5351 /* If we wrote to a temporary name and had no errors, rename to real name. */
5355 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5363 /* Discard the unwind protect for close_file_unwind. */
5364 specpdl_ptr
= specpdl
+ count1
;
5365 /* Restore the original current buffer. */
5366 visit_file
= unbind_to (count
, visit_file
);
5368 #ifdef CLASH_DETECTION
5370 unlock_file (lockname
);
5371 #endif /* CLASH_DETECTION */
5373 /* Do this before reporting IO error
5374 to avoid a "file has changed on disk" warning on
5375 next attempt to save. */
5377 current_buffer
->modtime
= st
.st_mtime
;
5380 error ("IO error writing %s: %s", SDATA (filename
),
5381 emacs_strerror (save_errno
));
5385 SAVE_MODIFF
= MODIFF
;
5386 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5387 current_buffer
->filename
= visit_file
;
5388 update_mode_lines
++;
5393 && ! NILP (Fstring_equal (current_buffer
->filename
,
5394 current_buffer
->auto_save_file_name
)))
5395 SAVE_MODIFF
= MODIFF
;
5401 message_with_string ((INTEGERP (append
)
5411 Lisp_Object
merge ();
5413 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5414 doc
: /* Return t if (car A) is numerically less than (car B). */)
5418 return Flss (Fcar (a
), Fcar (b
));
5421 /* Build the complete list of annotations appropriate for writing out
5422 the text between START and END, by calling all the functions in
5423 write-region-annotate-functions and merging the lists they return.
5424 If one of these functions switches to a different buffer, we assume
5425 that buffer contains altered text. Therefore, the caller must
5426 make sure to restore the current buffer in all cases,
5427 as save-excursion would do. */
5430 build_annotations (start
, end
)
5431 Lisp_Object start
, end
;
5433 Lisp_Object annotations
;
5435 struct gcpro gcpro1
, gcpro2
;
5436 Lisp_Object original_buffer
;
5437 int i
, used_global
= 0;
5439 XSETBUFFER (original_buffer
, current_buffer
);
5442 p
= Vwrite_region_annotate_functions
;
5443 GCPRO2 (annotations
, p
);
5446 struct buffer
*given_buffer
= current_buffer
;
5447 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5448 { /* Use the global value of the hook. */
5451 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5453 p
= Fappend (2, arg
);
5456 Vwrite_region_annotations_so_far
= annotations
;
5457 res
= call2 (XCAR (p
), start
, end
);
5458 /* If the function makes a different buffer current,
5459 assume that means this buffer contains altered text to be output.
5460 Reset START and END from the buffer bounds
5461 and discard all previous annotations because they should have
5462 been dealt with by this function. */
5463 if (current_buffer
!= given_buffer
)
5465 XSETFASTINT (start
, BEGV
);
5466 XSETFASTINT (end
, ZV
);
5469 Flength (res
); /* Check basic validity of return value */
5470 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5474 /* Now do the same for annotation functions implied by the file-format */
5475 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
5476 p
= current_buffer
->auto_save_file_format
;
5478 p
= current_buffer
->file_format
;
5479 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5481 struct buffer
*given_buffer
= current_buffer
;
5483 Vwrite_region_annotations_so_far
= annotations
;
5485 /* Value is either a list of annotations or nil if the function
5486 has written annotations to a temporary buffer, which is now
5488 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5489 original_buffer
, make_number (i
));
5490 if (current_buffer
!= given_buffer
)
5492 XSETFASTINT (start
, BEGV
);
5493 XSETFASTINT (end
, ZV
);
5498 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5506 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5507 If STRING is nil, POS is the character position in the current buffer.
5508 Intersperse with them the annotations from *ANNOT
5509 which fall within the range of POS to POS + NCHARS,
5510 each at its appropriate position.
5512 We modify *ANNOT by discarding elements as we use them up.
5514 The return value is negative in case of system call failure. */
5517 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5520 register int nchars
;
5523 struct coding_system
*coding
;
5527 int lastpos
= pos
+ nchars
;
5529 while (NILP (*annot
) || CONSP (*annot
))
5531 tem
= Fcar_safe (Fcar (*annot
));
5534 nextpos
= XFASTINT (tem
);
5536 /* If there are no more annotations in this range,
5537 output the rest of the range all at once. */
5538 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5539 return e_write (desc
, string
, pos
, lastpos
, coding
);
5541 /* Output buffer text up to the next annotation's position. */
5544 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5548 /* Output the annotation. */
5549 tem
= Fcdr (Fcar (*annot
));
5552 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5555 *annot
= Fcdr (*annot
);
5561 /* Write text in the range START and END into descriptor DESC,
5562 encoding them with coding system CODING. If STRING is nil, START
5563 and END are character positions of the current buffer, else they
5564 are indexes to the string STRING. */
5567 e_write (desc
, string
, start
, end
, coding
)
5571 struct coding_system
*coding
;
5573 if (STRINGP (string
))
5576 end
= SCHARS (string
);
5579 /* We used to have a code for handling selective display here. But,
5580 now it is handled within encode_coding. */
5584 if (STRINGP (string
))
5586 coding
->src_multibyte
= SCHARS (string
) < SBYTES (string
);
5587 if (CODING_REQUIRE_ENCODING (coding
))
5589 encode_coding_object (coding
, string
,
5590 start
, string_char_to_byte (string
, start
),
5591 end
, string_char_to_byte (string
, end
), Qt
);
5595 coding
->dst_object
= string
;
5596 coding
->consumed_char
= SCHARS (string
);
5597 coding
->produced
= SBYTES (string
);
5602 int start_byte
= CHAR_TO_BYTE (start
);
5603 int end_byte
= CHAR_TO_BYTE (end
);
5605 coding
->src_multibyte
= (end
- start
) < (end_byte
- start_byte
);
5606 if (CODING_REQUIRE_ENCODING (coding
))
5608 encode_coding_object (coding
, Fcurrent_buffer (),
5609 start
, start_byte
, end
, end_byte
, Qt
);
5613 coding
->dst_object
= Qnil
;
5614 coding
->dst_pos_byte
= start_byte
;
5615 if (start
>= GPT
|| end
<= GPT
)
5617 coding
->consumed_char
= end
- start
;
5618 coding
->produced
= end_byte
- start_byte
;
5622 coding
->consumed_char
= GPT
- start
;
5623 coding
->produced
= GPT_BYTE
- start_byte
;
5628 if (coding
->produced
> 0)
5632 STRINGP (coding
->dst_object
)
5633 ? SDATA (coding
->dst_object
)
5634 : BYTE_POS_ADDR (coding
->dst_pos_byte
),
5637 if (coding
->produced
)
5640 start
+= coding
->consumed_char
;
5646 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5647 Sverify_visited_file_modtime
, 1, 1, 0,
5648 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5649 This means that the file has not been changed since it was visited or saved.
5650 See Info node `(elisp)Modification Time' for more details. */)
5656 Lisp_Object handler
;
5657 Lisp_Object filename
;
5662 if (!STRINGP (b
->filename
)) return Qt
;
5663 if (b
->modtime
== 0) return Qt
;
5665 /* If the file name has special constructs in it,
5666 call the corresponding file handler. */
5667 handler
= Ffind_file_name_handler (b
->filename
,
5668 Qverify_visited_file_modtime
);
5669 if (!NILP (handler
))
5670 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5672 filename
= ENCODE_FILE (b
->filename
);
5674 if (stat (SDATA (filename
), &st
) < 0)
5676 /* If the file doesn't exist now and didn't exist before,
5677 we say that it isn't modified, provided the error is a tame one. */
5678 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5683 if (st
.st_mtime
== b
->modtime
5684 /* If both are positive, accept them if they are off by one second. */
5685 || (st
.st_mtime
> 0 && b
->modtime
> 0
5686 && (st
.st_mtime
== b
->modtime
+ 1
5687 || st
.st_mtime
== b
->modtime
- 1)))
5692 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5693 Sclear_visited_file_modtime
, 0, 0, 0,
5694 doc
: /* Clear out records of last mod time of visited file.
5695 Next attempt to save will certainly not complain of a discrepancy. */)
5698 current_buffer
->modtime
= 0;
5702 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5703 Svisited_file_modtime
, 0, 0, 0,
5704 doc
: /* Return the current buffer's recorded visited file modification time.
5705 The value is a list of the form (HIGH LOW), like the time values
5706 that `file-attributes' returns. If the current buffer has no recorded
5707 file modification time, this function returns 0.
5708 See Info node `(elisp)Modification Time' for more details. */)
5711 if (! current_buffer
->modtime
)
5712 return make_number (0);
5713 return make_time ((time_t) current_buffer
->modtime
);
5716 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5717 Sset_visited_file_modtime
, 0, 1, 0,
5718 doc
: /* Update buffer's recorded modification time from the visited file's time.
5719 Useful if the buffer was not read from the file normally
5720 or if the file itself has been changed for some known benign reason.
5721 An argument specifies the modification time value to use
5722 \(instead of that of the visited file), in the form of a list
5723 \(HIGH . LOW) or (HIGH LOW). */)
5725 Lisp_Object time_list
;
5727 if (!NILP (time_list
))
5728 current_buffer
->modtime
= cons_to_long (time_list
);
5731 register Lisp_Object filename
;
5733 Lisp_Object handler
;
5735 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5737 /* If the file name has special constructs in it,
5738 call the corresponding file handler. */
5739 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5740 if (!NILP (handler
))
5741 /* The handler can find the file name the same way we did. */
5742 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5744 filename
= ENCODE_FILE (filename
);
5746 if (stat (SDATA (filename
), &st
) >= 0)
5747 current_buffer
->modtime
= st
.st_mtime
;
5754 auto_save_error (error
)
5757 Lisp_Object args
[3], msg
;
5759 struct gcpro gcpro1
;
5763 auto_save_error_occurred
= 1;
5765 ring_bell (XFRAME (selected_frame
));
5767 args
[0] = build_string ("Auto-saving %s: %s");
5768 args
[1] = current_buffer
->name
;
5769 args
[2] = Ferror_message_string (error
);
5770 msg
= Fformat (3, args
);
5772 nbytes
= SBYTES (msg
);
5773 SAFE_ALLOCA (msgbuf
, char *, nbytes
);
5774 bcopy (SDATA (msg
), msgbuf
, nbytes
);
5776 for (i
= 0; i
< 3; ++i
)
5779 message2 (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5781 message2_nolog (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5782 Fsleep_for (make_number (1), Qnil
);
5796 auto_save_mode_bits
= 0666;
5798 /* Get visited file's mode to become the auto save file's mode. */
5799 if (! NILP (current_buffer
->filename
))
5801 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5802 /* But make sure we can overwrite it later! */
5803 auto_save_mode_bits
= st
.st_mode
| 0600;
5804 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5806 /* Remote files don't cooperate with stat. */
5807 auto_save_mode_bits
= XINT (modes
) | 0600;
5811 Fwrite_region (Qnil
, Qnil
,
5812 current_buffer
->auto_save_file_name
,
5813 Qnil
, Qlambda
, Qnil
, Qnil
);
5817 do_auto_save_unwind (arg
) /* used as unwind-protect function */
5820 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
5832 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5835 minibuffer_auto_raise
= XINT (value
);
5840 do_auto_save_make_dir (dir
)
5845 call2 (Qmake_directory
, dir
, Qt
);
5846 XSETFASTINT (mode
, 0700);
5847 return Fset_file_modes (dir
, mode
);
5851 do_auto_save_eh (ignore
)
5857 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5858 doc
: /* Auto-save all buffers that need it.
5859 This is all buffers that have auto-saving enabled
5860 and are changed since last auto-saved.
5861 Auto-saving writes the buffer into a file
5862 so that your editing is not lost if the system crashes.
5863 This file is not the file you visited; that changes only when you save.
5864 Normally we run the normal hook `auto-save-hook' before saving.
5866 A non-nil NO-MESSAGE argument means do not print any message if successful.
5867 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5868 (no_message
, current_only
)
5869 Lisp_Object no_message
, current_only
;
5871 struct buffer
*old
= current_buffer
, *b
;
5872 Lisp_Object tail
, buf
;
5874 int do_handled_files
;
5876 FILE *stream
= NULL
;
5877 int count
= SPECPDL_INDEX ();
5878 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5879 int old_message_p
= 0;
5880 struct gcpro gcpro1
, gcpro2
;
5882 if (max_specpdl_size
< specpdl_size
+ 40)
5883 max_specpdl_size
= specpdl_size
+ 40;
5888 if (NILP (no_message
))
5890 old_message_p
= push_message ();
5891 record_unwind_protect (pop_message_unwind
, Qnil
);
5894 /* Ordinarily don't quit within this function,
5895 but don't make it impossible to quit (in case we get hung in I/O). */
5899 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5900 point to non-strings reached from Vbuffer_alist. */
5902 if (!NILP (Vrun_hooks
))
5903 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5905 if (STRINGP (Vauto_save_list_file_name
))
5907 Lisp_Object listfile
;
5909 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5911 /* Don't try to create the directory when shutting down Emacs,
5912 because creating the directory might signal an error, and
5913 that would leave Emacs in a strange state. */
5914 if (!NILP (Vrun_hooks
))
5918 GCPRO2 (dir
, listfile
);
5919 dir
= Ffile_name_directory (listfile
);
5920 if (NILP (Ffile_directory_p (dir
)))
5921 internal_condition_case_1 (do_auto_save_make_dir
,
5922 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5927 stream
= fopen (SDATA (listfile
), "w");
5930 record_unwind_protect (do_auto_save_unwind
,
5931 make_save_value (stream
, 0));
5932 record_unwind_protect (do_auto_save_unwind_1
,
5933 make_number (minibuffer_auto_raise
));
5934 minibuffer_auto_raise
= 0;
5936 auto_save_error_occurred
= 0;
5938 /* On first pass, save all files that don't have handlers.
5939 On second pass, save all files that do have handlers.
5941 If Emacs is crashing, the handlers may tweak what is causing
5942 Emacs to crash in the first place, and it would be a shame if
5943 Emacs failed to autosave perfectly ordinary files because it
5944 couldn't handle some ange-ftp'd file. */
5946 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5947 for (tail
= Vbuffer_alist
; CONSP (tail
); tail
= XCDR (tail
))
5949 buf
= XCDR (XCAR (tail
));
5952 /* Record all the buffers that have auto save mode
5953 in the special file that lists them. For each of these buffers,
5954 Record visited name (if any) and auto save name. */
5955 if (STRINGP (b
->auto_save_file_name
)
5956 && stream
!= NULL
&& do_handled_files
== 0)
5959 if (!NILP (b
->filename
))
5961 fwrite (SDATA (b
->filename
), 1,
5962 SBYTES (b
->filename
), stream
);
5964 putc ('\n', stream
);
5965 fwrite (SDATA (b
->auto_save_file_name
), 1,
5966 SBYTES (b
->auto_save_file_name
), stream
);
5967 putc ('\n', stream
);
5971 if (!NILP (current_only
)
5972 && b
!= current_buffer
)
5975 /* Don't auto-save indirect buffers.
5976 The base buffer takes care of it. */
5980 /* Check for auto save enabled
5981 and file changed since last auto save
5982 and file changed since last real save. */
5983 if (STRINGP (b
->auto_save_file_name
)
5984 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5985 && b
->auto_save_modified
< BUF_MODIFF (b
)
5986 /* -1 means we've turned off autosaving for a while--see below. */
5987 && XINT (b
->save_length
) >= 0
5988 && (do_handled_files
5989 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5992 EMACS_TIME before_time
, after_time
;
5994 EMACS_GET_TIME (before_time
);
5996 /* If we had a failure, don't try again for 20 minutes. */
5997 if (b
->auto_save_failure_time
>= 0
5998 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
6001 if ((XFASTINT (b
->save_length
) * 10
6002 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
6003 /* A short file is likely to change a large fraction;
6004 spare the user annoying messages. */
6005 && XFASTINT (b
->save_length
) > 5000
6006 /* These messages are frequent and annoying for `*mail*'. */
6007 && !EQ (b
->filename
, Qnil
)
6008 && NILP (no_message
))
6010 /* It has shrunk too much; turn off auto-saving here. */
6011 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
6012 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
6014 minibuffer_auto_raise
= 0;
6015 /* Turn off auto-saving until there's a real save,
6016 and prevent any more warnings. */
6017 XSETINT (b
->save_length
, -1);
6018 Fsleep_for (make_number (1), Qnil
);
6021 set_buffer_internal (b
);
6022 if (!auto_saved
&& NILP (no_message
))
6023 message1 ("Auto-saving...");
6024 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
6026 b
->auto_save_modified
= BUF_MODIFF (b
);
6027 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6028 set_buffer_internal (old
);
6030 EMACS_GET_TIME (after_time
);
6032 /* If auto-save took more than 60 seconds,
6033 assume it was an NFS failure that got a timeout. */
6034 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
6035 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
6039 /* Prevent another auto save till enough input events come in. */
6040 record_auto_save ();
6042 if (auto_saved
&& NILP (no_message
))
6046 /* If we are going to restore an old message,
6047 give time to read ours. */
6048 sit_for (make_number (1), 0, 0);
6051 else if (!auto_save_error_occurred
)
6052 /* Don't overwrite the error message if an error occurred.
6053 If we displayed a message and then restored a state
6054 with no message, leave a "done" message on the screen. */
6055 message1 ("Auto-saving...done");
6060 /* This restores the message-stack status. */
6061 unbind_to (count
, Qnil
);
6065 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
6066 Sset_buffer_auto_saved
, 0, 0, 0,
6067 doc
: /* Mark current buffer as auto-saved with its current text.
6068 No auto-save file will be written until the buffer changes again. */)
6071 current_buffer
->auto_save_modified
= MODIFF
;
6072 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6073 current_buffer
->auto_save_failure_time
= -1;
6077 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
6078 Sclear_buffer_auto_save_failure
, 0, 0, 0,
6079 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
6082 current_buffer
->auto_save_failure_time
= -1;
6086 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6088 doc
: /* Return t if current buffer has been auto-saved recently.
6089 More precisely, if it has been auto-saved since last read from or saved
6090 in the visited file. If the buffer has no visited file,
6091 then any auto-save counts as "recent". */)
6094 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6097 /* Reading and completing file names */
6099 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
6100 Snext_read_file_uses_dialog_p
, 0, 0, 0,
6101 doc
: /* Return t if a call to `read-file-name' will use a dialog.
6102 The return value is only relevant for a call to `read-file-name' that happens
6103 before any other event (mouse or keypress) is handeled. */)
6106 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6107 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6117 Fread_file_name (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6118 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6120 struct gcpro gcpro1
, gcpro2
;
6121 Lisp_Object args
[7];
6123 GCPRO1 (default_filename
);
6124 args
[0] = intern ("read-file-name");
6127 args
[3] = default_filename
;
6128 args
[4] = mustmatch
;
6130 args
[6] = predicate
;
6131 RETURN_UNGCPRO (Ffuncall (7, args
));
6138 /* Must be set before any path manipulation is performed. */
6139 XSETFASTINT (Vdirectory_sep_char
, '/');
6146 Qoperations
= intern ("operations");
6147 Qexpand_file_name
= intern ("expand-file-name");
6148 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6149 Qdirectory_file_name
= intern ("directory-file-name");
6150 Qfile_name_directory
= intern ("file-name-directory");
6151 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6152 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6153 Qfile_name_as_directory
= intern ("file-name-as-directory");
6154 Qcopy_file
= intern ("copy-file");
6155 Qmake_directory_internal
= intern ("make-directory-internal");
6156 Qmake_directory
= intern ("make-directory");
6157 Qdelete_directory
= intern ("delete-directory");
6158 Qdelete_file
= intern ("delete-file");
6159 Qrename_file
= intern ("rename-file");
6160 Qadd_name_to_file
= intern ("add-name-to-file");
6161 Qmake_symbolic_link
= intern ("make-symbolic-link");
6162 Qfile_exists_p
= intern ("file-exists-p");
6163 Qfile_executable_p
= intern ("file-executable-p");
6164 Qfile_readable_p
= intern ("file-readable-p");
6165 Qfile_writable_p
= intern ("file-writable-p");
6166 Qfile_symlink_p
= intern ("file-symlink-p");
6167 Qaccess_file
= intern ("access-file");
6168 Qfile_directory_p
= intern ("file-directory-p");
6169 Qfile_regular_p
= intern ("file-regular-p");
6170 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6171 Qfile_modes
= intern ("file-modes");
6172 Qset_file_modes
= intern ("set-file-modes");
6173 Qset_file_times
= intern ("set-file-times");
6174 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6175 Qinsert_file_contents
= intern ("insert-file-contents");
6176 Qwrite_region
= intern ("write-region");
6177 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6178 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6179 Qauto_save_coding
= intern ("auto-save-coding");
6181 staticpro (&Qoperations
);
6182 staticpro (&Qexpand_file_name
);
6183 staticpro (&Qsubstitute_in_file_name
);
6184 staticpro (&Qdirectory_file_name
);
6185 staticpro (&Qfile_name_directory
);
6186 staticpro (&Qfile_name_nondirectory
);
6187 staticpro (&Qunhandled_file_name_directory
);
6188 staticpro (&Qfile_name_as_directory
);
6189 staticpro (&Qcopy_file
);
6190 staticpro (&Qmake_directory_internal
);
6191 staticpro (&Qmake_directory
);
6192 staticpro (&Qdelete_directory
);
6193 staticpro (&Qdelete_file
);
6194 staticpro (&Qrename_file
);
6195 staticpro (&Qadd_name_to_file
);
6196 staticpro (&Qmake_symbolic_link
);
6197 staticpro (&Qfile_exists_p
);
6198 staticpro (&Qfile_executable_p
);
6199 staticpro (&Qfile_readable_p
);
6200 staticpro (&Qfile_writable_p
);
6201 staticpro (&Qaccess_file
);
6202 staticpro (&Qfile_symlink_p
);
6203 staticpro (&Qfile_directory_p
);
6204 staticpro (&Qfile_regular_p
);
6205 staticpro (&Qfile_accessible_directory_p
);
6206 staticpro (&Qfile_modes
);
6207 staticpro (&Qset_file_modes
);
6208 staticpro (&Qset_file_times
);
6209 staticpro (&Qfile_newer_than_file_p
);
6210 staticpro (&Qinsert_file_contents
);
6211 staticpro (&Qwrite_region
);
6212 staticpro (&Qverify_visited_file_modtime
);
6213 staticpro (&Qset_visited_file_modtime
);
6214 staticpro (&Qauto_save_coding
);
6216 Qfile_name_history
= intern ("file-name-history");
6217 Fset (Qfile_name_history
, Qnil
);
6218 staticpro (&Qfile_name_history
);
6220 Qfile_error
= intern ("file-error");
6221 staticpro (&Qfile_error
);
6222 Qfile_already_exists
= intern ("file-already-exists");
6223 staticpro (&Qfile_already_exists
);
6224 Qfile_date_error
= intern ("file-date-error");
6225 staticpro (&Qfile_date_error
);
6226 Qexcl
= intern ("excl");
6230 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6231 staticpro (&Qfind_buffer_file_type
);
6234 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6235 doc
: /* *Coding system for encoding file names.
6236 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6237 Vfile_name_coding_system
= Qnil
;
6239 DEFVAR_LISP ("default-file-name-coding-system",
6240 &Vdefault_file_name_coding_system
,
6241 doc
: /* Default coding system for encoding file names.
6242 This variable is used only when `file-name-coding-system' is nil.
6244 This variable is set/changed by the command `set-language-environment'.
6245 User should not set this variable manually,
6246 instead use `file-name-coding-system' to get a constant encoding
6247 of file names regardless of the current language environment. */);
6248 Vdefault_file_name_coding_system
= Qnil
;
6250 Qformat_decode
= intern ("format-decode");
6251 staticpro (&Qformat_decode
);
6252 Qformat_annotate_function
= intern ("format-annotate-function");
6253 staticpro (&Qformat_annotate_function
);
6254 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6255 staticpro (&Qafter_insert_file_set_coding
);
6257 Qcar_less_than_car
= intern ("car-less-than-car");
6258 staticpro (&Qcar_less_than_car
);
6260 Fput (Qfile_error
, Qerror_conditions
,
6261 list2 (Qfile_error
, Qerror
));
6262 Fput (Qfile_error
, Qerror_message
,
6263 build_string ("File error"));
6265 Fput (Qfile_already_exists
, Qerror_conditions
,
6266 list3 (Qfile_already_exists
, Qfile_error
, Qerror
));
6267 Fput (Qfile_already_exists
, Qerror_message
,
6268 build_string ("File already exists"));
6270 Fput (Qfile_date_error
, Qerror_conditions
,
6271 list3 (Qfile_date_error
, Qfile_error
, Qerror
));
6272 Fput (Qfile_date_error
, Qerror_message
,
6273 build_string ("Cannot set file date"));
6275 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6276 doc
: /* *Non-nil means write new files with record format `stmlf'.
6277 nil means use format `var'. This variable is meaningful only on VMS. */);
6278 vms_stmlf_recfm
= 0;
6280 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6281 doc
: /* Directory separator character for built-in functions that return file names.
6282 The value is always ?/. Don't use this variable, just use `/'. */);
6284 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6285 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6286 If a file name matches REGEXP, then all I/O on that file is done by calling
6289 The first argument given to HANDLER is the name of the I/O primitive
6290 to be handled; the remaining arguments are the arguments that were
6291 passed to that primitive. For example, if you do
6292 (file-exists-p FILENAME)
6293 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6294 (funcall HANDLER 'file-exists-p FILENAME)
6295 The function `find-file-name-handler' checks this list for a handler
6296 for its argument. */);
6297 Vfile_name_handler_alist
= Qnil
;
6299 DEFVAR_LISP ("set-auto-coding-function",
6300 &Vset_auto_coding_function
,
6301 doc
: /* If non-nil, a function to call to decide a coding system of file.
6302 Two arguments are passed to this function: the file name
6303 and the length of a file contents following the point.
6304 This function should return a coding system to decode the file contents.
6305 It should check the file name against `auto-coding-alist'.
6306 If no coding system is decided, it should check a coding system
6307 specified in the heading lines with the format:
6308 -*- ... coding: CODING-SYSTEM; ... -*-
6309 or local variable spec of the tailing lines with `coding:' tag. */);
6310 Vset_auto_coding_function
= Qnil
;
6312 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6313 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6314 Each is passed one argument, the number of characters inserted,
6315 with point at the start of the inserted text. Each function
6316 should leave point the same, and return the new character count.
6317 If `insert-file-contents' is intercepted by a handler from
6318 `file-name-handler-alist', that handler is responsible for calling the
6319 functions in `after-insert-file-functions' if appropriate. */);
6320 Vafter_insert_file_functions
= Qnil
;
6322 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6323 doc
: /* A list of functions to be called at the start of `write-region'.
6324 Each is passed two arguments, START and END as for `write-region'.
6325 These are usually two numbers but not always; see the documentation
6326 for `write-region'. The function should return a list of pairs
6327 of the form (POSITION . STRING), consisting of strings to be effectively
6328 inserted at the specified positions of the file being written (1 means to
6329 insert before the first byte written). The POSITIONs must be sorted into
6330 increasing order. If there are several functions in the list, the several
6331 lists are merged destructively. Alternatively, the function can return
6332 with a different buffer current; in that case it should pay attention
6333 to the annotations returned by previous functions and listed in
6334 `write-region-annotations-so-far'.*/);
6335 Vwrite_region_annotate_functions
= Qnil
;
6336 staticpro (&Qwrite_region_annotate_functions
);
6337 Qwrite_region_annotate_functions
6338 = intern ("write-region-annotate-functions");
6340 DEFVAR_LISP ("write-region-annotations-so-far",
6341 &Vwrite_region_annotations_so_far
,
6342 doc
: /* When an annotation function is called, this holds the previous annotations.
6343 These are the annotations made by other annotation functions
6344 that were already called. See also `write-region-annotate-functions'. */);
6345 Vwrite_region_annotations_so_far
= Qnil
;
6347 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6348 doc
: /* A list of file name handlers that temporarily should not be used.
6349 This applies only to the operation `inhibit-file-name-operation'. */);
6350 Vinhibit_file_name_handlers
= Qnil
;
6352 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6353 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6354 Vinhibit_file_name_operation
= Qnil
;
6356 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6357 doc
: /* File name in which we write a list of all auto save file names.
6358 This variable is initialized automatically from `auto-save-list-file-prefix'
6359 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6360 a non-nil value. */);
6361 Vauto_save_list_file_name
= Qnil
;
6364 DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync
,
6365 doc
: /* *Non-nil means don't call fsync in `write-region'.
6366 This variable affects calls to `write-region' as well as save commands.
6367 A non-nil value may result in data loss! */);
6368 write_region_inhibit_fsync
= 0;
6371 defsubr (&Sfind_file_name_handler
);
6372 defsubr (&Sfile_name_directory
);
6373 defsubr (&Sfile_name_nondirectory
);
6374 defsubr (&Sunhandled_file_name_directory
);
6375 defsubr (&Sfile_name_as_directory
);
6376 defsubr (&Sdirectory_file_name
);
6377 defsubr (&Smake_temp_name
);
6378 defsubr (&Sexpand_file_name
);
6379 defsubr (&Ssubstitute_in_file_name
);
6380 defsubr (&Scopy_file
);
6381 defsubr (&Smake_directory_internal
);
6382 defsubr (&Sdelete_directory
);
6383 defsubr (&Sdelete_file
);
6384 defsubr (&Srename_file
);
6385 defsubr (&Sadd_name_to_file
);
6386 defsubr (&Smake_symbolic_link
);
6388 defsubr (&Sdefine_logical_name
);
6391 defsubr (&Ssysnetunam
);
6392 #endif /* HPUX_NET */
6393 defsubr (&Sfile_name_absolute_p
);
6394 defsubr (&Sfile_exists_p
);
6395 defsubr (&Sfile_executable_p
);
6396 defsubr (&Sfile_readable_p
);
6397 defsubr (&Sfile_writable_p
);
6398 defsubr (&Saccess_file
);
6399 defsubr (&Sfile_symlink_p
);
6400 defsubr (&Sfile_directory_p
);
6401 defsubr (&Sfile_accessible_directory_p
);
6402 defsubr (&Sfile_regular_p
);
6403 defsubr (&Sfile_modes
);
6404 defsubr (&Sset_file_modes
);
6405 defsubr (&Sset_file_times
);
6406 defsubr (&Sset_default_file_modes
);
6407 defsubr (&Sdefault_file_modes
);
6408 defsubr (&Sfile_newer_than_file_p
);
6409 defsubr (&Sinsert_file_contents
);
6410 defsubr (&Swrite_region
);
6411 defsubr (&Scar_less_than_car
);
6412 defsubr (&Sverify_visited_file_modtime
);
6413 defsubr (&Sclear_visited_file_modtime
);
6414 defsubr (&Svisited_file_modtime
);
6415 defsubr (&Sset_visited_file_modtime
);
6416 defsubr (&Sdo_auto_save
);
6417 defsubr (&Sset_buffer_auto_saved
);
6418 defsubr (&Sclear_buffer_auto_save_failure
);
6419 defsubr (&Srecent_auto_save_p
);
6421 defsubr (&Snext_read_file_uses_dialog_p
);
6424 defsubr (&Sunix_sync
);
6428 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6429 (do not change this comment) */