1 /* File IO for GNU Emacs.
2 Copyright (C) 1985,86,87,88,93,94,95,96,97,98,99,2000,01,2003
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
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)
76 #include "intervals.h"
78 #include "character.h"
87 #endif /* not WINDOWSNT */
91 #include <sys/param.h>
99 #define CORRECT_DIR_SEPS(s) \
100 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
101 else unixtodos_filename (s); \
103 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
104 redirector allows the six letters between 'Z' and 'a' as well. */
106 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
109 #define IS_DRIVE(x) isalpha (x)
111 /* Need to lower-case the drive letter, or else expanded
112 filenames will sometimes compare inequal, because
113 `expand-file-name' doesn't always down-case the drive letter. */
114 #define DRIVE_LETTER(x) (tolower (x))
135 #include "commands.h"
136 extern int use_dialog_box
;
150 /* Nonzero during writing of auto-save files */
153 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
154 a new file with the same mode as the original */
155 int auto_save_mode_bits
;
157 /* The symbol bound to coding-system-for-read when
158 insert-file-contents is called for recovering a file. This is not
159 an actual coding system name, but just an indicator to tell
160 insert-file-contents to use `emacs-mule' with a special flag for
161 auto saving and recovering a file. */
162 Lisp_Object Qauto_save_coding
;
164 /* Coding system for file names, or nil if none. */
165 Lisp_Object Vfile_name_coding_system
;
167 /* Coding system for file names used only when
168 Vfile_name_coding_system is nil. */
169 Lisp_Object Vdefault_file_name_coding_system
;
171 /* Alist of elements (REGEXP . HANDLER) for file names
172 whose I/O is done with a special handler. */
173 Lisp_Object Vfile_name_handler_alist
;
175 /* Format for auto-save files */
176 Lisp_Object Vauto_save_file_format
;
178 /* Lisp functions for translating file formats */
179 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
181 /* Function to be called to decide a coding system of a reading file. */
182 Lisp_Object Vset_auto_coding_function
;
184 /* Functions to be called to process text properties in inserted file. */
185 Lisp_Object Vafter_insert_file_functions
;
187 /* Lisp function for setting buffer-file-coding-system and the
188 multibyteness of the current buffer after inserting a file. */
189 Lisp_Object Qafter_insert_file_set_coding
;
191 /* Functions to be called to create text property annotations for file. */
192 Lisp_Object Vwrite_region_annotate_functions
;
193 Lisp_Object Qwrite_region_annotate_functions
;
195 /* During build_annotations, each time an annotation function is called,
196 this holds the annotations made by the previous functions. */
197 Lisp_Object Vwrite_region_annotations_so_far
;
199 /* File name in which we write a list of all our auto save files. */
200 Lisp_Object Vauto_save_list_file_name
;
202 /* Function to call to read a file name. */
203 Lisp_Object Vread_file_name_function
;
205 /* Current predicate used by read_file_name_internal. */
206 Lisp_Object Vread_file_name_predicate
;
208 /* Nonzero means, when reading a filename in the minibuffer,
209 start out by inserting the default directory into the minibuffer. */
210 int insert_default_directory
;
212 /* On VMS, nonzero means write new files with record format stmlf.
213 Zero means use var format. */
216 /* On NT, specifies the directory separator character, used (eg.) when
217 expanding file names. This can be bound to / or \. */
218 Lisp_Object Vdirectory_sep_char
;
220 extern Lisp_Object Vuser_login_name
;
223 extern Lisp_Object Vw32_get_true_file_attributes
;
226 extern int minibuf_level
;
228 extern int minibuffer_auto_raise
;
230 /* These variables describe handlers that have "already" had a chance
231 to handle the current operation.
233 Vinhibit_file_name_handlers is a list of file name handlers.
234 Vinhibit_file_name_operation is the operation being handled.
235 If we try to handle that operation, we ignore those handlers. */
237 static Lisp_Object Vinhibit_file_name_handlers
;
238 static Lisp_Object Vinhibit_file_name_operation
;
240 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
242 Lisp_Object Qfile_name_history
;
244 Lisp_Object Qcar_less_than_car
;
246 static int a_write
P_ ((int, Lisp_Object
, int, int,
247 Lisp_Object
*, struct coding_system
*));
248 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
252 report_file_error (string
, data
)
256 Lisp_Object errstring
;
259 synchronize_system_messages_locale ();
260 errstring
= code_convert_string_norecord (build_string (strerror (errorno
)),
261 Vlocale_coding_system
, 0);
267 Fsignal (Qfile_already_exists
, Fcons (errstring
, data
));
270 /* System error messages are capitalized. Downcase the initial
271 unless it is followed by a slash. */
272 if (SREF (errstring
, 1) != '/')
273 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
275 Fsignal (Qfile_error
,
276 Fcons (build_string (string
), Fcons (errstring
, data
)));
281 close_file_unwind (fd
)
284 emacs_close (XFASTINT (fd
));
288 /* Restore point, having saved it as a marker. */
291 restore_point_unwind (location
)
292 Lisp_Object location
;
294 Fgoto_char (location
);
295 Fset_marker (location
, Qnil
, Qnil
);
300 Lisp_Object Qexpand_file_name
;
301 Lisp_Object Qsubstitute_in_file_name
;
302 Lisp_Object Qdirectory_file_name
;
303 Lisp_Object Qfile_name_directory
;
304 Lisp_Object Qfile_name_nondirectory
;
305 Lisp_Object Qunhandled_file_name_directory
;
306 Lisp_Object Qfile_name_as_directory
;
307 Lisp_Object Qcopy_file
;
308 Lisp_Object Qmake_directory_internal
;
309 Lisp_Object Qmake_directory
;
310 Lisp_Object Qdelete_directory
;
311 Lisp_Object Qdelete_file
;
312 Lisp_Object Qrename_file
;
313 Lisp_Object Qadd_name_to_file
;
314 Lisp_Object Qmake_symbolic_link
;
315 Lisp_Object Qfile_exists_p
;
316 Lisp_Object Qfile_executable_p
;
317 Lisp_Object Qfile_readable_p
;
318 Lisp_Object Qfile_writable_p
;
319 Lisp_Object Qfile_symlink_p
;
320 Lisp_Object Qaccess_file
;
321 Lisp_Object Qfile_directory_p
;
322 Lisp_Object Qfile_regular_p
;
323 Lisp_Object Qfile_accessible_directory_p
;
324 Lisp_Object Qfile_modes
;
325 Lisp_Object Qset_file_modes
;
326 Lisp_Object Qfile_newer_than_file_p
;
327 Lisp_Object Qinsert_file_contents
;
328 Lisp_Object Qwrite_region
;
329 Lisp_Object Qverify_visited_file_modtime
;
330 Lisp_Object Qset_visited_file_modtime
;
332 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
333 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
334 Otherwise, return nil.
335 A file name is handled if one of the regular expressions in
336 `file-name-handler-alist' matches it.
338 If OPERATION equals `inhibit-file-name-operation', then we ignore
339 any handlers that are members of `inhibit-file-name-handlers',
340 but we still do run any other handlers. This lets handlers
341 use the standard functions without calling themselves recursively. */)
342 (filename
, operation
)
343 Lisp_Object filename
, operation
;
345 /* This function must not munge the match data. */
346 Lisp_Object chain
, inhibited_handlers
, result
;
350 CHECK_STRING (filename
);
352 if (EQ (operation
, Vinhibit_file_name_operation
))
353 inhibited_handlers
= Vinhibit_file_name_handlers
;
355 inhibited_handlers
= Qnil
;
357 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
358 chain
= XCDR (chain
))
368 && (match_pos
= fast_string_match (string
, filename
)) > pos
)
370 Lisp_Object handler
, tem
;
372 handler
= XCDR (elt
);
373 tem
= Fmemq (handler
, inhibited_handlers
);
387 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
389 doc
: /* Return the directory component in file name FILENAME.
390 Return nil if FILENAME does not include a directory.
391 Otherwise return a directory spec.
392 Given a Unix syntax file name, returns a string ending in slash;
393 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
395 Lisp_Object filename
;
398 register const unsigned char *beg
;
400 register unsigned char *beg
;
402 register const unsigned char *p
;
405 CHECK_STRING (filename
);
407 /* If the file name has special constructs in it,
408 call the corresponding file handler. */
409 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
411 return call2 (handler
, Qfile_name_directory
, filename
);
413 #ifdef FILE_SYSTEM_CASE
414 filename
= FILE_SYSTEM_CASE (filename
);
416 beg
= SDATA (filename
);
418 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
420 p
= beg
+ SBYTES (filename
);
422 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
424 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
427 /* only recognise drive specifier at the beginning */
429 /* handle the "/:d:foo" and "/:foo" cases correctly */
430 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
431 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
438 /* Expansion of "c:" to drive and default directory. */
441 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
442 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
443 unsigned char *r
= res
;
445 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
447 strncpy (res
, beg
, 2);
452 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
454 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
457 p
= beg
+ strlen (beg
);
460 CORRECT_DIR_SEPS (beg
);
463 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
466 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
467 Sfile_name_nondirectory
, 1, 1, 0,
468 doc
: /* Return file name FILENAME sans its directory.
469 For example, in a Unix-syntax file name,
470 this is everything after the last slash,
471 or the entire name if it contains no slash. */)
473 Lisp_Object filename
;
475 register const unsigned char *beg
, *p
, *end
;
478 CHECK_STRING (filename
);
480 /* If the file name has special constructs in it,
481 call the corresponding file handler. */
482 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
484 return call2 (handler
, Qfile_name_nondirectory
, filename
);
486 beg
= SDATA (filename
);
487 end
= p
= beg
+ SBYTES (filename
);
489 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
491 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
494 /* only recognise drive specifier at beginning */
496 /* handle the "/:d:foo" case correctly */
497 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
502 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
505 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
506 Sunhandled_file_name_directory
, 1, 1, 0,
507 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
508 A `directly usable' directory name is one that may be used without the
509 intervention of any file handler.
510 If FILENAME is a directly usable file itself, return
511 \(file-name-directory FILENAME).
512 The `call-process' and `start-process' functions use this function to
513 get a current directory to run processes in. */)
515 Lisp_Object filename
;
519 /* If the file name has special constructs in it,
520 call the corresponding file handler. */
521 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
523 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
525 return Ffile_name_directory (filename
);
530 file_name_as_directory (out
, in
)
533 int size
= strlen (in
) - 1;
546 /* Is it already a directory string? */
547 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
549 /* Is it a VMS directory file name? If so, hack VMS syntax. */
550 else if (! index (in
, '/')
551 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
552 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
553 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
554 || ! strncmp (&in
[size
- 5], ".dir", 4))
555 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
556 && in
[size
] == '1')))
558 register char *p
, *dot
;
562 dir:x.dir --> dir:[x]
563 dir:[x]y.dir --> dir:[x.y] */
565 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
568 strncpy (out
, in
, p
- in
);
587 dot
= index (p
, '.');
590 /* blindly remove any extension */
591 size
= strlen (out
) + (dot
- p
);
592 strncat (out
, p
, dot
- p
);
603 /* For Unix syntax, Append a slash if necessary */
604 if (!IS_DIRECTORY_SEP (out
[size
]))
606 /* Cannot use DIRECTORY_SEP, which could have any value */
608 out
[size
+ 2] = '\0';
611 CORRECT_DIR_SEPS (out
);
617 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
618 Sfile_name_as_directory
, 1, 1, 0,
619 doc
: /* Return a string representing the file name FILE interpreted as a directory.
620 This operation exists because a directory is also a file, but its name as
621 a directory is different from its name as a file.
622 The result can be used as the value of `default-directory'
623 or passed as second argument to `expand-file-name'.
624 For a Unix-syntax file name, just appends a slash.
625 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
636 /* If the file name has special constructs in it,
637 call the corresponding file handler. */
638 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
640 return call2 (handler
, Qfile_name_as_directory
, file
);
642 buf
= (char *) alloca (SBYTES (file
) + 10);
643 file_name_as_directory (buf
, SDATA (file
));
644 return make_specified_string (buf
, -1, strlen (buf
),
645 STRING_MULTIBYTE (file
));
649 * Convert from directory name to filename.
651 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
652 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
653 * On UNIX, it's simple: just make sure there isn't a terminating /
655 * Value is nonzero if the string output is different from the input.
659 directory_file_name (src
, dst
)
667 struct FAB fab
= cc$rms_fab
;
668 struct NAM nam
= cc$rms_nam
;
669 char esa
[NAM$C_MAXRSS
];
674 if (! index (src
, '/')
675 && (src
[slen
- 1] == ']'
676 || src
[slen
- 1] == ':'
677 || src
[slen
- 1] == '>'))
679 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
681 fab
.fab$b_fns
= slen
;
682 fab
.fab$l_nam
= &nam
;
683 fab
.fab$l_fop
= FAB$M_NAM
;
686 nam
.nam$b_ess
= sizeof esa
;
687 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
689 /* We call SYS$PARSE to handle such things as [--] for us. */
690 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
692 slen
= nam
.nam$b_esl
;
693 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
698 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
700 /* what about when we have logical_name:???? */
701 if (src
[slen
- 1] == ':')
702 { /* Xlate logical name and see what we get */
703 ptr
= strcpy (dst
, src
); /* upper case for getenv */
706 if ('a' <= *ptr
&& *ptr
<= 'z')
710 dst
[slen
- 1] = 0; /* remove colon */
711 if (!(src
= egetenv (dst
)))
713 /* should we jump to the beginning of this procedure?
714 Good points: allows us to use logical names that xlate
716 Bad points: can be a problem if we just translated to a device
718 For now, I'll punt and always expect VMS names, and hope for
721 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
722 { /* no recursion here! */
728 { /* not a directory spec */
733 bracket
= src
[slen
- 1];
735 /* If bracket is ']' or '>', bracket - 2 is the corresponding
737 ptr
= index (src
, bracket
- 2);
739 { /* no opening bracket */
743 if (!(rptr
= rindex (src
, '.')))
746 strncpy (dst
, src
, slen
);
750 dst
[slen
++] = bracket
;
755 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
756 then translate the device and recurse. */
757 if (dst
[slen
- 1] == ':'
758 && dst
[slen
- 2] != ':' /* skip decnet nodes */
759 && strcmp (src
+ slen
, "[000000]") == 0)
761 dst
[slen
- 1] = '\0';
762 if ((ptr
= egetenv (dst
))
763 && (rlen
= strlen (ptr
) - 1) > 0
764 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
765 && ptr
[rlen
- 1] == '.')
767 char * buf
= (char *) alloca (strlen (ptr
) + 1);
771 return directory_file_name (buf
, dst
);
776 strcat (dst
, "[000000]");
780 rlen
= strlen (rptr
) - 1;
781 strncat (dst
, rptr
, rlen
);
782 dst
[slen
+ rlen
] = '\0';
783 strcat (dst
, ".DIR.1");
787 /* Process as Unix format: just remove any final slash.
788 But leave "/" unchanged; do not change it to "". */
791 /* Handle // as root for apollo's. */
792 if ((slen
> 2 && dst
[slen
- 1] == '/')
793 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
797 && IS_DIRECTORY_SEP (dst
[slen
- 1])
799 && !IS_ANY_SEP (dst
[slen
- 2])
805 CORRECT_DIR_SEPS (dst
);
810 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
812 doc
: /* Returns the file name of the directory named DIRECTORY.
813 This is the name of the file that holds the data for the directory DIRECTORY.
814 This operation exists because a directory is also a file, but its name as
815 a directory is different from its name as a file.
816 In Unix-syntax, this function just removes the final slash.
817 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
818 it returns a file name such as \"[X]Y.DIR.1\". */)
820 Lisp_Object directory
;
825 CHECK_STRING (directory
);
827 if (NILP (directory
))
830 /* If the file name has special constructs in it,
831 call the corresponding file handler. */
832 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
834 return call2 (handler
, Qdirectory_file_name
, directory
);
837 /* 20 extra chars is insufficient for VMS, since we might perform a
838 logical name translation. an equivalence string can be up to 255
839 chars long, so grab that much extra space... - sss */
840 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
842 buf
= (char *) alloca (SBYTES (directory
) + 20);
844 directory_file_name (SDATA (directory
), buf
);
845 return make_specified_string (buf
, -1, strlen (buf
),
846 STRING_MULTIBYTE (directory
));
849 static char make_temp_name_tbl
[64] =
851 'A','B','C','D','E','F','G','H',
852 'I','J','K','L','M','N','O','P',
853 'Q','R','S','T','U','V','W','X',
854 'Y','Z','a','b','c','d','e','f',
855 'g','h','i','j','k','l','m','n',
856 'o','p','q','r','s','t','u','v',
857 'w','x','y','z','0','1','2','3',
858 '4','5','6','7','8','9','-','_'
861 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
863 /* Value is a temporary file name starting with PREFIX, a string.
865 The Emacs process number forms part of the result, so there is
866 no danger of generating a name being used by another process.
867 In addition, this function makes an attempt to choose a name
868 which has no existing file. To make this work, PREFIX should be
869 an absolute file name.
871 BASE64_P non-zero means add the pid as 3 characters in base64
872 encoding. In this case, 6 characters will be added to PREFIX to
873 form the file name. Otherwise, if Emacs is running on a system
874 with long file names, add the pid as a decimal number.
876 This function signals an error if no unique file name could be
880 make_temp_name (prefix
, base64_p
)
887 unsigned char *p
, *data
;
891 CHECK_STRING (prefix
);
893 /* VAL is created by adding 6 characters to PREFIX. The first
894 three are the PID of this process, in base 64, and the second
895 three are incremented if the file already exists. This ensures
896 262144 unique file names per PID per PREFIX. */
898 pid
= (int) getpid ();
902 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
903 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
904 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
909 #ifdef HAVE_LONG_FILE_NAMES
910 sprintf (pidbuf
, "%d", pid
);
911 pidlen
= strlen (pidbuf
);
913 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
914 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
915 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
920 len
= SCHARS (prefix
);
921 val
= make_uninit_string (len
+ 3 + pidlen
);
923 bcopy(SDATA (prefix
), data
, len
);
926 bcopy (pidbuf
, p
, pidlen
);
929 /* Here we try to minimize useless stat'ing when this function is
930 invoked many times successively with the same PREFIX. We achieve
931 this by initializing count to a random value, and incrementing it
934 We don't want make-temp-name to be called while dumping,
935 because then make_temp_name_count_initialized_p would get set
936 and then make_temp_name_count would not be set when Emacs starts. */
938 if (!make_temp_name_count_initialized_p
)
940 make_temp_name_count
= (unsigned) time (NULL
);
941 make_temp_name_count_initialized_p
= 1;
947 unsigned num
= make_temp_name_count
;
949 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
950 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
951 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
953 /* Poor man's congruential RN generator. Replace with
954 ++make_temp_name_count for debugging. */
955 make_temp_name_count
+= 25229;
956 make_temp_name_count
%= 225307;
958 if (stat (data
, &ignored
) < 0)
960 /* We want to return only if errno is ENOENT. */
964 /* The error here is dubious, but there is little else we
965 can do. The alternatives are to return nil, which is
966 as bad as (and in many cases worse than) throwing the
967 error, or to ignore the error, which will likely result
968 in looping through 225307 stat's, which is not only
969 dog-slow, but also useless since it will fallback to
970 the errow below, anyway. */
971 report_file_error ("Cannot create temporary name for prefix",
972 Fcons (prefix
, Qnil
));
977 error ("Cannot create temporary name for prefix `%s'",
983 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
984 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
985 The Emacs process number forms part of the result,
986 so there is no danger of generating a name being used by another process.
988 In addition, this function makes an attempt to choose a name
989 which has no existing file. To make this work,
990 PREFIX should be an absolute file name.
992 There is a race condition between calling `make-temp-name' and creating the
993 file which opens all kinds of security holes. For that reason, you should
994 probably use `make-temp-file' instead, except in three circumstances:
996 * If you are creating the file in the user's home directory.
997 * If you are creating a directory rather than an ordinary file.
998 * If you are taking special precautions as `make-temp-file' does. */)
1002 return make_temp_name (prefix
, 0);
1007 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1008 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1009 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1010 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
1011 the current buffer's value of default-directory is used.
1012 File name components that are `.' are removed, and
1013 so are file name components followed by `..', along with the `..' itself;
1014 note that these simplifications are done without checking the resulting
1015 file names in the file system.
1016 An initial `~/' expands to your home directory.
1017 An initial `~USER/' expands to USER's home directory.
1018 See also the function `substitute-in-file-name'. */)
1019 (name
, default_directory
)
1020 Lisp_Object name
, default_directory
;
1024 register unsigned char *newdir
, *p
, *o
;
1026 unsigned char *target
;
1029 unsigned char * colon
= 0;
1030 unsigned char * close
= 0;
1031 unsigned char * slash
= 0;
1032 unsigned char * brack
= 0;
1033 int lbrack
= 0, rbrack
= 0;
1038 int collapse_newdir
= 1;
1042 Lisp_Object handler
, result
;
1044 CHECK_STRING (name
);
1046 /* If the file name has special constructs in it,
1047 call the corresponding file handler. */
1048 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1049 if (!NILP (handler
))
1050 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1052 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1053 if (NILP (default_directory
))
1054 default_directory
= current_buffer
->directory
;
1055 if (! STRINGP (default_directory
))
1058 /* "/" is not considered a root directory on DOS_NT, so using "/"
1059 here causes an infinite recursion in, e.g., the following:
1061 (let (default-directory)
1062 (expand-file-name "a"))
1064 To avoid this, we set default_directory to the root of the
1066 extern char *emacs_root_dir (void);
1068 default_directory
= build_string (emacs_root_dir ());
1070 default_directory
= build_string ("/");
1074 if (!NILP (default_directory
))
1076 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1077 if (!NILP (handler
))
1078 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1081 o
= SDATA (default_directory
);
1083 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1084 It would be better to do this down below where we actually use
1085 default_directory. Unfortunately, calling Fexpand_file_name recursively
1086 could invoke GC, and the strings might be relocated. This would
1087 be annoying because we have pointers into strings lying around
1088 that would need adjusting, and people would add new pointers to
1089 the code and forget to adjust them, resulting in intermittent bugs.
1090 Putting this call here avoids all that crud.
1092 The EQ test avoids infinite recursion. */
1093 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1094 /* Save time in some common cases - as long as default_directory
1095 is not relative, it can be canonicalized with name below (if it
1096 is needed at all) without requiring it to be expanded now. */
1098 /* Detect MSDOS file names with drive specifiers. */
1099 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1101 /* Detect Windows file names in UNC format. */
1102 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1104 #else /* not DOS_NT */
1105 /* Detect Unix absolute file names (/... alone is not absolute on
1107 && ! (IS_DIRECTORY_SEP (o
[0]))
1108 #endif /* not DOS_NT */
1111 struct gcpro gcpro1
;
1114 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1119 /* Filenames on VMS are always upper case. */
1120 name
= Fupcase (name
);
1122 #ifdef FILE_SYSTEM_CASE
1123 name
= FILE_SYSTEM_CASE (name
);
1129 /* We will force directory separators to be either all \ or /, so make
1130 a local copy to modify, even if there ends up being no change. */
1131 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1133 /* Note if special escape prefix is present, but remove for now. */
1134 if (nm
[0] == '/' && nm
[1] == ':')
1140 /* Find and remove drive specifier if present; this makes nm absolute
1141 even if the rest of the name appears to be relative. Only look for
1142 drive specifier at the beginning. */
1143 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1150 /* If we see "c://somedir", we want to strip the first slash after the
1151 colon when stripping the drive letter. Otherwise, this expands to
1153 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1155 #endif /* WINDOWSNT */
1159 /* Discard any previous drive specifier if nm is now in UNC format. */
1160 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1166 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1167 none are found, we can probably return right away. We will avoid
1168 allocating a new string if name is already fully expanded. */
1170 IS_DIRECTORY_SEP (nm
[0])
1172 && drive
&& !is_escaped
1175 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1182 /* If it turns out that the filename we want to return is just a
1183 suffix of FILENAME, we don't need to go through and edit
1184 things; we just need to construct a new string using data
1185 starting at the middle of FILENAME. If we set lose to a
1186 non-zero value, that means we've discovered that we can't do
1193 /* Since we know the name is absolute, we can assume that each
1194 element starts with a "/". */
1196 /* "." and ".." are hairy. */
1197 if (IS_DIRECTORY_SEP (p
[0])
1199 && (IS_DIRECTORY_SEP (p
[2])
1201 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1204 /* We want to replace multiple `/' in a row with a single
1207 && IS_DIRECTORY_SEP (p
[0])
1208 && IS_DIRECTORY_SEP (p
[1]))
1215 /* if dev:[dir]/, move nm to / */
1216 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1217 nm
= (brack
? brack
+ 1 : colon
+ 1);
1218 lbrack
= rbrack
= 0;
1226 /* VMS pre V4.4,convert '-'s in filenames. */
1227 if (lbrack
== rbrack
)
1229 if (dots
< 2) /* this is to allow negative version numbers */
1234 if (lbrack
> rbrack
&&
1235 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1236 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1242 /* count open brackets, reset close bracket pointer */
1243 if (p
[0] == '[' || p
[0] == '<')
1244 lbrack
++, brack
= 0;
1245 /* count close brackets, set close bracket pointer */
1246 if (p
[0] == ']' || p
[0] == '>')
1247 rbrack
++, brack
= p
;
1248 /* detect ][ or >< */
1249 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1251 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1252 nm
= p
+ 1, lose
= 1;
1253 if (p
[0] == ':' && (colon
|| slash
))
1254 /* if dev1:[dir]dev2:, move nm to dev2: */
1260 /* if /name/dev:, move nm to dev: */
1263 /* if node::dev:, move colon following dev */
1264 else if (colon
&& colon
[-1] == ':')
1266 /* if dev1:dev2:, move nm to dev2: */
1267 else if (colon
&& colon
[-1] != ':')
1272 if (p
[0] == ':' && !colon
)
1278 if (lbrack
== rbrack
)
1281 else if (p
[0] == '.')
1289 if (index (nm
, '/'))
1291 nm
= sys_translate_unix (nm
);
1292 return make_specified_string (nm
, -1, strlen (nm
),
1293 STRING_MULTIBYTE (name
));
1297 /* Make sure directories are all separated with / or \ as
1298 desired, but avoid allocation of a new string when not
1300 CORRECT_DIR_SEPS (nm
);
1302 if (IS_DIRECTORY_SEP (nm
[1]))
1304 if (strcmp (nm
, SDATA (name
)) != 0)
1305 name
= make_specified_string (nm
, -1, strlen (nm
),
1306 STRING_MULTIBYTE (name
));
1310 /* drive must be set, so this is okay */
1311 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1315 name
= make_specified_string (nm
, -1, p
- nm
,
1316 STRING_MULTIBYTE (name
));
1317 temp
[0] = DRIVE_LETTER (drive
);
1318 name
= concat2 (build_string (temp
), name
);
1321 #else /* not DOS_NT */
1322 if (nm
== SDATA (name
))
1324 return make_specified_string (nm
, -1, strlen (nm
),
1325 STRING_MULTIBYTE (name
));
1326 #endif /* not DOS_NT */
1330 /* At this point, nm might or might not be an absolute file name. We
1331 need to expand ~ or ~user if present, otherwise prefix nm with
1332 default_directory if nm is not absolute, and finally collapse /./
1333 and /foo/../ sequences.
1335 We set newdir to be the appropriate prefix if one is needed:
1336 - the relevant user directory if nm starts with ~ or ~user
1337 - the specified drive's working dir (DOS/NT only) if nm does not
1339 - the value of default_directory.
1341 Note that these prefixes are not guaranteed to be absolute (except
1342 for the working dir of a drive). Therefore, to ensure we always
1343 return an absolute name, if the final prefix is not absolute we
1344 append it to the current working directory. */
1348 if (nm
[0] == '~') /* prefix ~ */
1350 if (IS_DIRECTORY_SEP (nm
[1])
1354 || nm
[1] == 0) /* ~ by itself */
1356 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1357 newdir
= (unsigned char *) "";
1360 collapse_newdir
= 0;
1363 nm
++; /* Don't leave the slash in nm. */
1366 else /* ~user/filename */
1368 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1373 o
= (unsigned char *) alloca (p
- nm
+ 1);
1374 bcopy ((char *) nm
, o
, p
- nm
);
1377 pw
= (struct passwd
*) getpwnam (o
+ 1);
1380 newdir
= (unsigned char *) pw
-> pw_dir
;
1382 nm
= p
+ 1; /* skip the terminator */
1386 collapse_newdir
= 0;
1391 /* If we don't find a user of that name, leave the name
1392 unchanged; don't move nm forward to p. */
1397 /* On DOS and Windows, nm is absolute if a drive name was specified;
1398 use the drive's current directory as the prefix if needed. */
1399 if (!newdir
&& drive
)
1401 /* Get default directory if needed to make nm absolute. */
1402 if (!IS_DIRECTORY_SEP (nm
[0]))
1404 newdir
= alloca (MAXPATHLEN
+ 1);
1405 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1410 /* Either nm starts with /, or drive isn't mounted. */
1411 newdir
= alloca (4);
1412 newdir
[0] = DRIVE_LETTER (drive
);
1420 /* Finally, if no prefix has been specified and nm is not absolute,
1421 then it must be expanded relative to default_directory. */
1425 /* /... alone is not absolute on DOS and Windows. */
1426 && !IS_DIRECTORY_SEP (nm
[0])
1429 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1436 newdir
= SDATA (default_directory
);
1438 /* Note if special escape prefix is present, but remove for now. */
1439 if (newdir
[0] == '/' && newdir
[1] == ':')
1450 /* First ensure newdir is an absolute name. */
1452 /* Detect MSDOS file names with drive specifiers. */
1453 ! (IS_DRIVE (newdir
[0])
1454 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1456 /* Detect Windows file names in UNC format. */
1457 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1461 /* Effectively, let newdir be (expand-file-name newdir cwd).
1462 Because of the admonition against calling expand-file-name
1463 when we have pointers into lisp strings, we accomplish this
1464 indirectly by prepending newdir to nm if necessary, and using
1465 cwd (or the wd of newdir's drive) as the new newdir. */
1467 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1472 if (!IS_DIRECTORY_SEP (nm
[0]))
1474 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1475 file_name_as_directory (tmp
, newdir
);
1479 newdir
= alloca (MAXPATHLEN
+ 1);
1482 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1489 /* Strip off drive name from prefix, if present. */
1490 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1496 /* Keep only a prefix from newdir if nm starts with slash
1497 (//server/share for UNC, nothing otherwise). */
1498 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1501 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1503 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1505 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1507 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1519 /* Get rid of any slash at the end of newdir, unless newdir is
1520 just / or // (an incomplete UNC name). */
1521 length
= strlen (newdir
);
1522 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1524 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1528 unsigned char *temp
= (unsigned char *) alloca (length
);
1529 bcopy (newdir
, temp
, length
- 1);
1530 temp
[length
- 1] = 0;
1538 /* Now concatenate the directory and name to new space in the stack frame */
1539 tlen
+= strlen (nm
) + 1;
1541 /* Reserve space for drive specifier and escape prefix, since either
1542 or both may need to be inserted. (The Microsoft x86 compiler
1543 produces incorrect code if the following two lines are combined.) */
1544 target
= (unsigned char *) alloca (tlen
+ 4);
1546 #else /* not DOS_NT */
1547 target
= (unsigned char *) alloca (tlen
);
1548 #endif /* not DOS_NT */
1554 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1557 /* If newdir is effectively "C:/", then the drive letter will have
1558 been stripped and newdir will be "/". Concatenating with an
1559 absolute directory in nm produces "//", which will then be
1560 incorrectly treated as a network share. Ignore newdir in
1561 this case (keeping the drive letter). */
1562 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1563 && newdir
[1] == '\0'))
1565 strcpy (target
, newdir
);
1569 file_name_as_directory (target
, newdir
);
1572 strcat (target
, nm
);
1574 if (index (target
, '/'))
1575 strcpy (target
, sys_translate_unix (target
));
1578 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1580 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1589 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1595 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1596 /* brackets are offset from each other by 2 */
1599 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1600 /* convert [foo][bar] to [bar] */
1601 while (o
[-1] != '[' && o
[-1] != '<')
1603 else if (*p
== '-' && *o
!= '.')
1606 else if (p
[0] == '-' && o
[-1] == '.' &&
1607 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1608 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1612 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1613 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1615 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1617 /* else [foo.-] ==> [-] */
1623 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1624 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1630 if (!IS_DIRECTORY_SEP (*p
))
1634 else if (IS_DIRECTORY_SEP (p
[0])
1636 && (IS_DIRECTORY_SEP (p
[2])
1639 /* If "/." is the entire filename, keep the "/". Otherwise,
1640 just delete the whole "/.". */
1641 if (o
== target
&& p
[2] == '\0')
1645 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1646 /* `/../' is the "superroot" on certain file systems. */
1648 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1650 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1652 /* Keep initial / only if this is the whole name. */
1653 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1658 && IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1]))
1660 /* Collapse multiple `/' in a row. */
1662 while (IS_DIRECTORY_SEP (*p
))
1669 #endif /* not VMS */
1673 /* At last, set drive name. */
1675 /* Except for network file name. */
1676 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1677 #endif /* WINDOWSNT */
1679 if (!drive
) abort ();
1681 target
[0] = DRIVE_LETTER (drive
);
1684 /* Reinsert the escape prefix if required. */
1691 CORRECT_DIR_SEPS (target
);
1694 result
= make_specified_string (target
, -1, o
- target
,
1695 STRING_MULTIBYTE (name
));
1697 /* Again look to see if the file name has special constructs in it
1698 and perhaps call the corresponding file handler. This is needed
1699 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1700 the ".." component gives us "/user@host:/bar/../baz" which needs
1701 to be expanded again. */
1702 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1703 if (!NILP (handler
))
1704 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1710 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1711 This is the old version of expand-file-name, before it was thoroughly
1712 rewritten for Emacs 10.31. We leave this version here commented-out,
1713 because the code is very complex and likely to have subtle bugs. If
1714 bugs _are_ found, it might be of interest to look at the old code and
1715 see what did it do in the relevant situation.
1717 Don't remove this code: it's true that it will be accessible via CVS,
1718 but a few years from deletion, people will forget it is there. */
1720 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1721 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1722 "Convert FILENAME to absolute, and canonicalize it.\n\
1723 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1724 (does not start with slash); if DEFAULT is nil or missing,\n\
1725 the current buffer's value of default-directory is used.\n\
1726 Filenames containing `.' or `..' as components are simplified;\n\
1727 initial `~/' expands to your home directory.\n\
1728 See also the function `substitute-in-file-name'.")
1730 Lisp_Object name
, defalt
;
1734 register unsigned char *newdir
, *p
, *o
;
1736 unsigned char *target
;
1740 unsigned char * colon
= 0;
1741 unsigned char * close
= 0;
1742 unsigned char * slash
= 0;
1743 unsigned char * brack
= 0;
1744 int lbrack
= 0, rbrack
= 0;
1748 CHECK_STRING (name
);
1751 /* Filenames on VMS are always upper case. */
1752 name
= Fupcase (name
);
1757 /* If nm is absolute, flush ...// and detect /./ and /../.
1758 If no /./ or /../ we can return right away. */
1770 if (p
[0] == '/' && p
[1] == '/'
1772 /* // at start of filename is meaningful on Apollo system. */
1777 if (p
[0] == '/' && p
[1] == '~')
1778 nm
= p
+ 1, lose
= 1;
1779 if (p
[0] == '/' && p
[1] == '.'
1780 && (p
[2] == '/' || p
[2] == 0
1781 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1787 /* if dev:[dir]/, move nm to / */
1788 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1789 nm
= (brack
? brack
+ 1 : colon
+ 1);
1790 lbrack
= rbrack
= 0;
1798 /* VMS pre V4.4,convert '-'s in filenames. */
1799 if (lbrack
== rbrack
)
1801 if (dots
< 2) /* this is to allow negative version numbers */
1806 if (lbrack
> rbrack
&&
1807 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1808 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1814 /* count open brackets, reset close bracket pointer */
1815 if (p
[0] == '[' || p
[0] == '<')
1816 lbrack
++, brack
= 0;
1817 /* count close brackets, set close bracket pointer */
1818 if (p
[0] == ']' || p
[0] == '>')
1819 rbrack
++, brack
= p
;
1820 /* detect ][ or >< */
1821 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1823 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1824 nm
= p
+ 1, lose
= 1;
1825 if (p
[0] == ':' && (colon
|| slash
))
1826 /* if dev1:[dir]dev2:, move nm to dev2: */
1832 /* If /name/dev:, move nm to dev: */
1835 /* If node::dev:, move colon following dev */
1836 else if (colon
&& colon
[-1] == ':')
1838 /* If dev1:dev2:, move nm to dev2: */
1839 else if (colon
&& colon
[-1] != ':')
1844 if (p
[0] == ':' && !colon
)
1850 if (lbrack
== rbrack
)
1853 else if (p
[0] == '.')
1861 if (index (nm
, '/'))
1862 return build_string (sys_translate_unix (nm
));
1864 if (nm
== SDATA (name
))
1866 return build_string (nm
);
1870 /* Now determine directory to start with and put it in NEWDIR */
1874 if (nm
[0] == '~') /* prefix ~ */
1879 || nm
[1] == 0)/* ~/filename */
1881 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1882 newdir
= (unsigned char *) "";
1885 nm
++; /* Don't leave the slash in nm. */
1888 else /* ~user/filename */
1890 /* Get past ~ to user */
1891 unsigned char *user
= nm
+ 1;
1892 /* Find end of name. */
1893 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1894 int len
= ptr
? ptr
- user
: strlen (user
);
1896 unsigned char *ptr1
= index (user
, ':');
1897 if (ptr1
!= 0 && ptr1
- user
< len
)
1900 /* Copy the user name into temp storage. */
1901 o
= (unsigned char *) alloca (len
+ 1);
1902 bcopy ((char *) user
, o
, len
);
1905 /* Look up the user name. */
1906 pw
= (struct passwd
*) getpwnam (o
+ 1);
1908 error ("\"%s\" isn't a registered user", o
+ 1);
1910 newdir
= (unsigned char *) pw
->pw_dir
;
1912 /* Discard the user name from NM. */
1919 #endif /* not VMS */
1923 defalt
= current_buffer
->directory
;
1924 CHECK_STRING (defalt
);
1925 newdir
= SDATA (defalt
);
1928 /* Now concatenate the directory and name to new space in the stack frame */
1930 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1931 target
= (unsigned char *) alloca (tlen
);
1937 if (nm
[0] == 0 || nm
[0] == '/')
1938 strcpy (target
, newdir
);
1941 file_name_as_directory (target
, newdir
);
1944 strcat (target
, nm
);
1946 if (index (target
, '/'))
1947 strcpy (target
, sys_translate_unix (target
));
1950 /* Now canonicalize by removing /. and /foo/.. if they appear */
1958 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1964 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1965 /* brackets are offset from each other by 2 */
1968 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1969 /* convert [foo][bar] to [bar] */
1970 while (o
[-1] != '[' && o
[-1] != '<')
1972 else if (*p
== '-' && *o
!= '.')
1975 else if (p
[0] == '-' && o
[-1] == '.' &&
1976 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1977 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1981 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1982 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1984 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1986 /* else [foo.-] ==> [-] */
1992 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1993 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2003 else if (!strncmp (p
, "//", 2)
2005 /* // at start of filename is meaningful in Apollo system. */
2013 else if (p
[0] == '/' && p
[1] == '.' &&
2014 (p
[2] == '/' || p
[2] == 0))
2016 else if (!strncmp (p
, "/..", 3)
2017 /* `/../' is the "superroot" on certain file systems. */
2019 && (p
[3] == '/' || p
[3] == 0))
2021 while (o
!= target
&& *--o
!= '/')
2024 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2028 if (o
== target
&& *o
== '/')
2036 #endif /* not VMS */
2039 return make_string (target
, o
- target
);
2043 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2044 Ssubstitute_in_file_name
, 1, 1, 0,
2045 doc
: /* Substitute environment variables referred to in FILENAME.
2046 `$FOO' where FOO is an environment variable name means to substitute
2047 the value of that variable. The variable name should be terminated
2048 with a character not a letter, digit or underscore; otherwise, enclose
2049 the entire variable name in braces.
2050 If `/~' appears, all of FILENAME through that `/' is discarded.
2052 On VMS, `$' substitution is not done; this function does little and only
2053 duplicates what `expand-file-name' does. */)
2055 Lisp_Object filename
;
2059 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2060 unsigned char *target
= NULL
;
2062 int substituted
= 0;
2065 Lisp_Object handler
;
2067 CHECK_STRING (filename
);
2069 /* If the file name has special constructs in it,
2070 call the corresponding file handler. */
2071 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2072 if (!NILP (handler
))
2073 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2075 nm
= SDATA (filename
);
2077 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2078 CORRECT_DIR_SEPS (nm
);
2079 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2081 endp
= nm
+ SBYTES (filename
);
2083 /* If /~ or // appears, discard everything through first slash. */
2085 for (p
= nm
; p
!= endp
; p
++)
2088 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2089 /* // at start of file name is meaningful in Apollo,
2090 WindowsNT and Cygwin systems. */
2091 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
2092 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2093 || IS_DIRECTORY_SEP (p
[0])
2094 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2099 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2101 || IS_DIRECTORY_SEP (p
[-1])))
2103 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2108 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2110 o
= (unsigned char *) alloca (s
- p
+ 1);
2111 bcopy ((char *) p
, o
, s
- p
);
2114 pw
= (struct passwd
*) getpwnam (o
+ 1);
2116 /* If we have ~/ or ~user and `user' exists, discard
2117 everything up to ~. But if `user' does not exist, leave
2118 ~user alone, it might be a literal file name. */
2119 if (IS_DIRECTORY_SEP (p
[0]) || s
== p
+ 1 || pw
)
2126 /* see comment in expand-file-name about drive specifiers */
2127 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2128 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
2137 return make_specified_string (nm
, -1, strlen (nm
),
2138 STRING_MULTIBYTE (filename
));
2141 /* See if any variables are substituted into the string
2142 and find the total length of their values in `total' */
2144 for (p
= nm
; p
!= endp
;)
2154 /* "$$" means a single "$" */
2163 while (p
!= endp
&& *p
!= '}') p
++;
2164 if (*p
!= '}') goto missingclose
;
2170 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2174 /* Copy out the variable name */
2175 target
= (unsigned char *) alloca (s
- o
+ 1);
2176 strncpy (target
, o
, s
- o
);
2179 strupr (target
); /* $home == $HOME etc. */
2182 /* Get variable value */
2183 o
= (unsigned char *) egetenv (target
);
2186 total
+= strlen (o
);
2196 /* If substitution required, recopy the string and do it */
2197 /* Make space in stack frame for the new copy */
2198 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2201 /* Copy the rest of the name through, replacing $ constructs with values */
2218 while (p
!= endp
&& *p
!= '}') p
++;
2219 if (*p
!= '}') goto missingclose
;
2225 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2229 /* Copy out the variable name */
2230 target
= (unsigned char *) alloca (s
- o
+ 1);
2231 strncpy (target
, o
, s
- o
);
2234 strupr (target
); /* $home == $HOME etc. */
2237 /* Get variable value */
2238 o
= (unsigned char *) egetenv (target
);
2242 strcpy (x
, target
); x
+= strlen (target
);
2244 else if (STRING_MULTIBYTE (filename
))
2246 /* If the original string is multibyte,
2247 convert what we substitute into multibyte. */
2250 int c
= unibyte_char_to_multibyte (*o
++);
2251 x
+= CHAR_STRING (c
, x
);
2263 /* If /~ or // appears, discard everything through first slash. */
2265 for (p
= xnm
; p
!= x
; p
++)
2267 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2268 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2269 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2270 || IS_DIRECTORY_SEP (p
[0])
2271 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2273 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2276 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2277 && p
> xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2281 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2284 error ("Bad format environment-variable substitution");
2286 error ("Missing \"}\" in environment-variable substitution");
2288 error ("Substituting nonexistent environment variable \"%s\"", target
);
2291 #endif /* not VMS */
2295 /* A slightly faster and more convenient way to get
2296 (directory-file-name (expand-file-name FOO)). */
2299 expand_and_dir_to_file (filename
, defdir
)
2300 Lisp_Object filename
, defdir
;
2302 register Lisp_Object absname
;
2304 absname
= Fexpand_file_name (filename
, defdir
);
2307 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2308 if (c
== ':' || c
== ']' || c
== '>')
2309 absname
= Fdirectory_file_name (absname
);
2312 /* Remove final slash, if any (unless this is the root dir).
2313 stat behaves differently depending! */
2314 if (SCHARS (absname
) > 1
2315 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2316 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2317 /* We cannot take shortcuts; they might be wrong for magic file names. */
2318 absname
= Fdirectory_file_name (absname
);
2323 /* Signal an error if the file ABSNAME already exists.
2324 If INTERACTIVE is nonzero, ask the user whether to proceed,
2325 and bypass the error if the user says to go ahead.
2326 QUERYSTRING is a name for the action that is being considered
2329 *STATPTR is used to store the stat information if the file exists.
2330 If the file does not exist, STATPTR->st_mode is set to 0.
2331 If STATPTR is null, we don't store into it.
2333 If QUICK is nonzero, we ask for y or n, not yes or no. */
2336 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2337 Lisp_Object absname
;
2338 unsigned char *querystring
;
2340 struct stat
*statptr
;
2343 register Lisp_Object tem
, encoded_filename
;
2344 struct stat statbuf
;
2345 struct gcpro gcpro1
;
2347 encoded_filename
= ENCODE_FILE (absname
);
2349 /* stat is a good way to tell whether the file exists,
2350 regardless of what access permissions it has. */
2351 if (stat (SDATA (encoded_filename
), &statbuf
) >= 0)
2354 Fsignal (Qfile_already_exists
,
2355 Fcons (build_string ("File already exists"),
2356 Fcons (absname
, Qnil
)));
2358 tem
= format2 ("File %s already exists; %s anyway? ",
2359 absname
, build_string (querystring
));
2361 tem
= Fy_or_n_p (tem
);
2363 tem
= do_yes_or_no_p (tem
);
2366 Fsignal (Qfile_already_exists
,
2367 Fcons (build_string ("File already exists"),
2368 Fcons (absname
, Qnil
)));
2375 statptr
->st_mode
= 0;
2380 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2381 "fCopy file: \nFCopy %s to file: \np\nP",
2382 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2383 If NEWNAME names a directory, copy FILE there.
2384 Signals a `file-already-exists' error if file NEWNAME already exists,
2385 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
2386 A number as third arg means request confirmation if NEWNAME already exists.
2387 This is what happens in interactive use with M-x.
2388 Fourth arg KEEP-TIME non-nil means give the new file the same
2389 last-modified time as the old one. (This works on only some systems.)
2390 A prefix arg makes KEEP-TIME non-nil.
2391 Also set the file modes of the target file to match the source file. */)
2392 (file
, newname
, ok_if_already_exists
, keep_time
)
2393 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2396 char buf
[16 * 1024];
2397 struct stat st
, out_st
;
2398 Lisp_Object handler
;
2399 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2400 int count
= SPECPDL_INDEX ();
2401 int input_file_statable_p
;
2402 Lisp_Object encoded_file
, encoded_newname
;
2404 encoded_file
= encoded_newname
= Qnil
;
2405 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2406 CHECK_STRING (file
);
2407 CHECK_STRING (newname
);
2409 if (!NILP (Ffile_directory_p (newname
)))
2410 newname
= Fexpand_file_name (file
, newname
);
2412 newname
= Fexpand_file_name (newname
, Qnil
);
2414 file
= Fexpand_file_name (file
, Qnil
);
2416 /* If the input file name has special constructs in it,
2417 call the corresponding file handler. */
2418 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2419 /* Likewise for output file name. */
2421 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2422 if (!NILP (handler
))
2423 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2424 ok_if_already_exists
, keep_time
));
2426 encoded_file
= ENCODE_FILE (file
);
2427 encoded_newname
= ENCODE_FILE (newname
);
2429 if (NILP (ok_if_already_exists
)
2430 || INTEGERP (ok_if_already_exists
))
2431 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2432 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2433 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2437 if (!CopyFile (SDATA (encoded_file
),
2438 SDATA (encoded_newname
),
2440 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2441 /* CopyFile retains the timestamp by default. */
2442 else if (NILP (keep_time
))
2448 EMACS_GET_TIME (now
);
2449 filename
= SDATA (encoded_newname
);
2451 /* Ensure file is writable while its modified time is set. */
2452 attributes
= GetFileAttributes (filename
);
2453 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2454 if (set_file_times (filename
, now
, now
))
2456 /* Restore original attributes. */
2457 SetFileAttributes (filename
, attributes
);
2458 Fsignal (Qfile_date_error
,
2459 Fcons (build_string ("Cannot set file date"),
2460 Fcons (newname
, Qnil
)));
2462 /* Restore original attributes. */
2463 SetFileAttributes (filename
, attributes
);
2465 #else /* not WINDOWSNT */
2467 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2471 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2473 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2475 /* We can only copy regular files and symbolic links. Other files are not
2477 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2479 #if !defined (DOS_NT) || __DJGPP__ > 1
2480 if (out_st
.st_mode
!= 0
2481 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2484 report_file_error ("Input and output files are the same",
2485 Fcons (file
, Fcons (newname
, Qnil
)));
2489 #if defined (S_ISREG) && defined (S_ISLNK)
2490 if (input_file_statable_p
)
2492 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2494 #if defined (EISDIR)
2495 /* Get a better looking error message. */
2498 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2501 #endif /* S_ISREG && S_ISLNK */
2504 /* Create the copy file with the same record format as the input file */
2505 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2508 /* System's default file type was set to binary by _fmode in emacs.c. */
2509 ofd
= creat (SDATA (encoded_newname
), S_IREAD
| S_IWRITE
);
2510 #else /* not MSDOS */
2511 ofd
= creat (SDATA (encoded_newname
), 0666);
2512 #endif /* not MSDOS */
2515 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2517 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2521 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2522 if (emacs_write (ofd
, buf
, n
) != n
)
2523 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2526 /* Closing the output clobbers the file times on some systems. */
2527 if (emacs_close (ofd
) < 0)
2528 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2530 if (input_file_statable_p
)
2532 if (!NILP (keep_time
))
2534 EMACS_TIME atime
, mtime
;
2535 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2536 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2537 if (set_file_times (SDATA (encoded_newname
),
2539 Fsignal (Qfile_date_error
,
2540 Fcons (build_string ("Cannot set file date"),
2541 Fcons (newname
, Qnil
)));
2544 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2546 #if defined (__DJGPP__) && __DJGPP__ > 1
2547 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2548 and if it can't, it tells so. Otherwise, under MSDOS we usually
2549 get only the READ bit, which will make the copied file read-only,
2550 so it's better not to chmod at all. */
2551 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2552 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2553 #endif /* DJGPP version 2 or newer */
2558 #endif /* WINDOWSNT */
2560 /* Discard the unwind protects. */
2561 specpdl_ptr
= specpdl
+ count
;
2567 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2568 Smake_directory_internal
, 1, 1, 0,
2569 doc
: /* Create a new directory named DIRECTORY. */)
2571 Lisp_Object directory
;
2573 const unsigned char *dir
;
2574 Lisp_Object handler
;
2575 Lisp_Object encoded_dir
;
2577 CHECK_STRING (directory
);
2578 directory
= Fexpand_file_name (directory
, Qnil
);
2580 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2581 if (!NILP (handler
))
2582 return call2 (handler
, Qmake_directory_internal
, directory
);
2584 encoded_dir
= ENCODE_FILE (directory
);
2586 dir
= SDATA (encoded_dir
);
2589 if (mkdir (dir
) != 0)
2591 if (mkdir (dir
, 0777) != 0)
2593 report_file_error ("Creating directory", Flist (1, &directory
));
2598 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2599 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2601 Lisp_Object directory
;
2603 const unsigned char *dir
;
2604 Lisp_Object handler
;
2605 Lisp_Object encoded_dir
;
2607 CHECK_STRING (directory
);
2608 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2610 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2611 if (!NILP (handler
))
2612 return call2 (handler
, Qdelete_directory
, directory
);
2614 encoded_dir
= ENCODE_FILE (directory
);
2616 dir
= SDATA (encoded_dir
);
2618 if (rmdir (dir
) != 0)
2619 report_file_error ("Removing directory", Flist (1, &directory
));
2624 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2625 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2626 If file has multiple names, it continues to exist with the other names. */)
2628 Lisp_Object filename
;
2630 Lisp_Object handler
;
2631 Lisp_Object encoded_file
;
2632 struct gcpro gcpro1
;
2635 if (!NILP (Ffile_directory_p (filename
))
2636 && NILP (Ffile_symlink_p (filename
)))
2637 Fsignal (Qfile_error
,
2638 Fcons (build_string ("Removing old name: is a directory"),
2639 Fcons (filename
, Qnil
)));
2641 filename
= Fexpand_file_name (filename
, Qnil
);
2643 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2644 if (!NILP (handler
))
2645 return call2 (handler
, Qdelete_file
, filename
);
2647 encoded_file
= ENCODE_FILE (filename
);
2649 if (0 > unlink (SDATA (encoded_file
)))
2650 report_file_error ("Removing old name", Flist (1, &filename
));
2655 internal_delete_file_1 (ignore
)
2661 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2664 internal_delete_file (filename
)
2665 Lisp_Object filename
;
2667 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2668 Qt
, internal_delete_file_1
));
2671 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2672 "fRename file: \nFRename %s to file: \np",
2673 doc
: /* Rename FILE as NEWNAME. Both args strings.
2674 If file has names other than FILE, it continues to have those names.
2675 Signals a `file-already-exists' error if a file NEWNAME already exists
2676 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2677 A number as third arg means request confirmation if NEWNAME already exists.
2678 This is what happens in interactive use with M-x. */)
2679 (file
, newname
, ok_if_already_exists
)
2680 Lisp_Object file
, newname
, ok_if_already_exists
;
2683 Lisp_Object args
[2];
2685 Lisp_Object handler
;
2686 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2687 Lisp_Object encoded_file
, encoded_newname
;
2689 encoded_file
= encoded_newname
= Qnil
;
2690 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2691 CHECK_STRING (file
);
2692 CHECK_STRING (newname
);
2693 file
= Fexpand_file_name (file
, Qnil
);
2694 newname
= Fexpand_file_name (newname
, Qnil
);
2696 /* If the file name has special constructs in it,
2697 call the corresponding file handler. */
2698 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2700 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2701 if (!NILP (handler
))
2702 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2703 file
, newname
, ok_if_already_exists
));
2705 encoded_file
= ENCODE_FILE (file
);
2706 encoded_newname
= ENCODE_FILE (newname
);
2709 /* If the file names are identical but for the case, don't ask for
2710 confirmation: they simply want to change the letter-case of the
2712 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2714 if (NILP (ok_if_already_exists
)
2715 || INTEGERP (ok_if_already_exists
))
2716 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2717 INTEGERP (ok_if_already_exists
), 0, 0);
2719 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2721 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2722 || 0 > unlink (SDATA (encoded_file
)))
2727 Fcopy_file (file
, newname
,
2728 /* We have already prompted if it was an integer,
2729 so don't have copy-file prompt again. */
2730 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2731 Fdelete_file (file
);
2738 report_file_error ("Renaming", Flist (2, args
));
2741 report_file_error ("Renaming", Flist (2, &file
));
2748 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2749 "fAdd name to file: \nFName to add to %s: \np",
2750 doc
: /* Give FILE additional name NEWNAME. Both args strings.
2751 Signals a `file-already-exists' error if a file NEWNAME already exists
2752 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2753 A number as third arg means request confirmation if NEWNAME already exists.
2754 This is what happens in interactive use with M-x. */)
2755 (file
, newname
, ok_if_already_exists
)
2756 Lisp_Object file
, newname
, ok_if_already_exists
;
2759 Lisp_Object args
[2];
2761 Lisp_Object handler
;
2762 Lisp_Object encoded_file
, encoded_newname
;
2763 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2765 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2766 encoded_file
= encoded_newname
= Qnil
;
2767 CHECK_STRING (file
);
2768 CHECK_STRING (newname
);
2769 file
= Fexpand_file_name (file
, Qnil
);
2770 newname
= Fexpand_file_name (newname
, Qnil
);
2772 /* If the file name has special constructs in it,
2773 call the corresponding file handler. */
2774 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2775 if (!NILP (handler
))
2776 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2777 newname
, ok_if_already_exists
));
2779 /* If the new name has special constructs in it,
2780 call the corresponding file handler. */
2781 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2782 if (!NILP (handler
))
2783 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2784 newname
, ok_if_already_exists
));
2786 encoded_file
= ENCODE_FILE (file
);
2787 encoded_newname
= ENCODE_FILE (newname
);
2789 if (NILP (ok_if_already_exists
)
2790 || INTEGERP (ok_if_already_exists
))
2791 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2792 INTEGERP (ok_if_already_exists
), 0, 0);
2794 unlink (SDATA (newname
));
2795 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2800 report_file_error ("Adding new name", Flist (2, args
));
2802 report_file_error ("Adding new name", Flist (2, &file
));
2811 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2812 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2813 doc
: /* Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2814 Signals a `file-already-exists' error if a file LINKNAME already exists
2815 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2816 A number as third arg means request confirmation if LINKNAME already exists.
2817 This happens for interactive use with M-x. */)
2818 (filename
, linkname
, ok_if_already_exists
)
2819 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2822 Lisp_Object args
[2];
2824 Lisp_Object handler
;
2825 Lisp_Object encoded_filename
, encoded_linkname
;
2826 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2828 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2829 encoded_filename
= encoded_linkname
= Qnil
;
2830 CHECK_STRING (filename
);
2831 CHECK_STRING (linkname
);
2832 /* If the link target has a ~, we must expand it to get
2833 a truly valid file name. Otherwise, do not expand;
2834 we want to permit links to relative file names. */
2835 if (SREF (filename
, 0) == '~')
2836 filename
= Fexpand_file_name (filename
, Qnil
);
2837 linkname
= Fexpand_file_name (linkname
, Qnil
);
2839 /* If the file name has special constructs in it,
2840 call the corresponding file handler. */
2841 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2842 if (!NILP (handler
))
2843 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2844 linkname
, ok_if_already_exists
));
2846 /* If the new link name has special constructs in it,
2847 call the corresponding file handler. */
2848 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2849 if (!NILP (handler
))
2850 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2851 linkname
, ok_if_already_exists
));
2853 encoded_filename
= ENCODE_FILE (filename
);
2854 encoded_linkname
= ENCODE_FILE (linkname
);
2856 if (NILP (ok_if_already_exists
)
2857 || INTEGERP (ok_if_already_exists
))
2858 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2859 INTEGERP (ok_if_already_exists
), 0, 0);
2860 if (0 > symlink (SDATA (encoded_filename
),
2861 SDATA (encoded_linkname
)))
2863 /* If we didn't complain already, silently delete existing file. */
2864 if (errno
== EEXIST
)
2866 unlink (SDATA (encoded_linkname
));
2867 if (0 <= symlink (SDATA (encoded_filename
),
2868 SDATA (encoded_linkname
)))
2878 report_file_error ("Making symbolic link", Flist (2, args
));
2880 report_file_error ("Making symbolic link", Flist (2, &filename
));
2886 #endif /* S_IFLNK */
2890 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2891 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2892 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2893 If STRING is nil or a null string, the logical name NAME is deleted. */)
2898 CHECK_STRING (name
);
2900 delete_logical_name (SDATA (name
));
2903 CHECK_STRING (string
);
2905 if (SCHARS (string
) == 0)
2906 delete_logical_name (SDATA (name
));
2908 define_logical_name (SDATA (name
), SDATA (string
));
2917 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2918 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2920 Lisp_Object path
, login
;
2924 CHECK_STRING (path
);
2925 CHECK_STRING (login
);
2927 netresult
= netunam (SDATA (path
), SDATA (login
));
2929 if (netresult
== -1)
2934 #endif /* HPUX_NET */
2936 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2938 doc
: /* Return t if file FILENAME specifies an absolute file name.
2939 On Unix, this is a name starting with a `/' or a `~'. */)
2941 Lisp_Object filename
;
2943 const unsigned char *ptr
;
2945 CHECK_STRING (filename
);
2946 ptr
= SDATA (filename
);
2947 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2949 /* ??? This criterion is probably wrong for '<'. */
2950 || index (ptr
, ':') || index (ptr
, '<')
2951 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2955 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2963 /* Return nonzero if file FILENAME exists and can be executed. */
2966 check_executable (filename
)
2970 int len
= strlen (filename
);
2973 if (stat (filename
, &st
) < 0)
2975 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2976 return ((st
.st_mode
& S_IEXEC
) != 0);
2978 return (S_ISREG (st
.st_mode
)
2980 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2981 || stricmp (suffix
, ".exe") == 0
2982 || stricmp (suffix
, ".bat") == 0)
2983 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2984 #endif /* not WINDOWSNT */
2985 #else /* not DOS_NT */
2986 #ifdef HAVE_EUIDACCESS
2987 return (euidaccess (filename
, 1) >= 0);
2989 /* Access isn't quite right because it uses the real uid
2990 and we really want to test with the effective uid.
2991 But Unix doesn't give us a right way to do it. */
2992 return (access (filename
, 1) >= 0);
2994 #endif /* not DOS_NT */
2997 /* Return nonzero if file FILENAME exists and can be written. */
3000 check_writable (filename
)
3005 if (stat (filename
, &st
) < 0)
3007 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3008 #else /* not MSDOS */
3009 #ifdef HAVE_EUIDACCESS
3010 return (euidaccess (filename
, 2) >= 0);
3012 /* Access isn't quite right because it uses the real uid
3013 and we really want to test with the effective uid.
3014 But Unix doesn't give us a right way to do it.
3015 Opening with O_WRONLY could work for an ordinary file,
3016 but would lose for directories. */
3017 return (access (filename
, 2) >= 0);
3019 #endif /* not MSDOS */
3022 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3023 doc
: /* Return t if file FILENAME exists. (This does not mean you can read it.)
3024 See also `file-readable-p' and `file-attributes'. */)
3026 Lisp_Object filename
;
3028 Lisp_Object absname
;
3029 Lisp_Object handler
;
3030 struct stat statbuf
;
3032 CHECK_STRING (filename
);
3033 absname
= Fexpand_file_name (filename
, Qnil
);
3035 /* If the file name has special constructs in it,
3036 call the corresponding file handler. */
3037 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3038 if (!NILP (handler
))
3039 return call2 (handler
, Qfile_exists_p
, absname
);
3041 absname
= ENCODE_FILE (absname
);
3043 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3046 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3047 doc
: /* Return t if FILENAME can be executed by you.
3048 For a directory, this means you can access files in that directory. */)
3050 Lisp_Object filename
;
3052 Lisp_Object absname
;
3053 Lisp_Object handler
;
3055 CHECK_STRING (filename
);
3056 absname
= Fexpand_file_name (filename
, Qnil
);
3058 /* If the file name has special constructs in it,
3059 call the corresponding file handler. */
3060 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3061 if (!NILP (handler
))
3062 return call2 (handler
, Qfile_executable_p
, absname
);
3064 absname
= ENCODE_FILE (absname
);
3066 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3069 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3070 doc
: /* Return t if file FILENAME exists and you can read it.
3071 See also `file-exists-p' and `file-attributes'. */)
3073 Lisp_Object filename
;
3075 Lisp_Object absname
;
3076 Lisp_Object handler
;
3079 struct stat statbuf
;
3081 CHECK_STRING (filename
);
3082 absname
= Fexpand_file_name (filename
, Qnil
);
3084 /* If the file name has special constructs in it,
3085 call the corresponding file handler. */
3086 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3087 if (!NILP (handler
))
3088 return call2 (handler
, Qfile_readable_p
, absname
);
3090 absname
= ENCODE_FILE (absname
);
3092 #if defined(DOS_NT) || defined(macintosh)
3093 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3095 if (access (SDATA (absname
), 0) == 0)
3098 #else /* not DOS_NT and not macintosh */
3100 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3101 /* Opening a fifo without O_NONBLOCK can wait.
3102 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3103 except in the case of a fifo, on a system which handles it. */
3104 desc
= stat (SDATA (absname
), &statbuf
);
3107 if (S_ISFIFO (statbuf
.st_mode
))
3108 flags
|= O_NONBLOCK
;
3110 desc
= emacs_open (SDATA (absname
), flags
, 0);
3115 #endif /* not DOS_NT and not macintosh */
3118 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3120 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3121 doc
: /* Return t if file FILENAME can be written or created by you. */)
3123 Lisp_Object filename
;
3125 Lisp_Object absname
, dir
, encoded
;
3126 Lisp_Object handler
;
3127 struct stat statbuf
;
3129 CHECK_STRING (filename
);
3130 absname
= Fexpand_file_name (filename
, Qnil
);
3132 /* If the file name has special constructs in it,
3133 call the corresponding file handler. */
3134 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3135 if (!NILP (handler
))
3136 return call2 (handler
, Qfile_writable_p
, absname
);
3138 encoded
= ENCODE_FILE (absname
);
3139 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3140 return (check_writable (SDATA (encoded
))
3143 dir
= Ffile_name_directory (absname
);
3146 dir
= Fdirectory_file_name (dir
);
3150 dir
= Fdirectory_file_name (dir
);
3153 dir
= ENCODE_FILE (dir
);
3155 /* The read-only attribute of the parent directory doesn't affect
3156 whether a file or directory can be created within it. Some day we
3157 should check ACLs though, which do affect this. */
3158 if (stat (SDATA (dir
), &statbuf
) < 0)
3160 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3162 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3167 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3168 doc
: /* Access file FILENAME, and get an error if that does not work.
3169 The second argument STRING is used in the error message.
3170 If there is no error, we return nil. */)
3172 Lisp_Object filename
, string
;
3174 Lisp_Object handler
, encoded_filename
, absname
;
3177 CHECK_STRING (filename
);
3178 absname
= Fexpand_file_name (filename
, Qnil
);
3180 CHECK_STRING (string
);
3182 /* If the file name has special constructs in it,
3183 call the corresponding file handler. */
3184 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3185 if (!NILP (handler
))
3186 return call3 (handler
, Qaccess_file
, absname
, string
);
3188 encoded_filename
= ENCODE_FILE (absname
);
3190 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3192 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3198 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3199 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3200 The value is the link target, as a string.
3201 Otherwise returns nil. */)
3203 Lisp_Object filename
;
3205 Lisp_Object handler
;
3207 CHECK_STRING (filename
);
3208 filename
= Fexpand_file_name (filename
, Qnil
);
3210 /* If the file name has special constructs in it,
3211 call the corresponding file handler. */
3212 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3213 if (!NILP (handler
))
3214 return call2 (handler
, Qfile_symlink_p
, filename
);
3223 filename
= ENCODE_FILE (filename
);
3230 buf
= (char *) xrealloc (buf
, bufsize
);
3231 bzero (buf
, bufsize
);
3234 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3238 /* HP-UX reports ERANGE if buffer is too small. */
3239 if (errno
== ERANGE
)
3249 while (valsize
>= bufsize
);
3251 val
= make_string (buf
, valsize
);
3252 if (buf
[0] == '/' && index (buf
, ':'))
3253 val
= concat2 (build_string ("/:"), val
);
3255 val
= DECODE_FILE (val
);
3258 #else /* not S_IFLNK */
3260 #endif /* not S_IFLNK */
3263 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3264 doc
: /* Return t if FILENAME names an existing directory.
3265 Symbolic links to directories count as directories.
3266 See `file-symlink-p' to distinguish symlinks. */)
3268 Lisp_Object filename
;
3270 register Lisp_Object absname
;
3272 Lisp_Object handler
;
3274 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3276 /* If the file name has special constructs in it,
3277 call the corresponding file handler. */
3278 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3279 if (!NILP (handler
))
3280 return call2 (handler
, Qfile_directory_p
, absname
);
3282 absname
= ENCODE_FILE (absname
);
3284 if (stat (SDATA (absname
), &st
) < 0)
3286 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3289 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3290 doc
: /* Return t if file FILENAME names a directory you can open.
3291 For the value to be t, FILENAME must specify the name of a directory as a file,
3292 and the directory must allow you to open files in it. In order to use a
3293 directory as a buffer's current directory, this predicate must return true.
3294 A directory name spec may be given instead; then the value is t
3295 if the directory so specified exists and really is a readable and
3296 searchable directory. */)
3298 Lisp_Object filename
;
3300 Lisp_Object handler
;
3302 struct gcpro gcpro1
;
3304 /* If the file name has special constructs in it,
3305 call the corresponding file handler. */
3306 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3307 if (!NILP (handler
))
3308 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3311 tem
= (NILP (Ffile_directory_p (filename
))
3312 || NILP (Ffile_executable_p (filename
)));
3314 return tem
? Qnil
: Qt
;
3317 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3318 doc
: /* Return t if file FILENAME is the name of a regular file.
3319 This is the sort of file that holds an ordinary stream of data bytes. */)
3321 Lisp_Object filename
;
3323 register Lisp_Object absname
;
3325 Lisp_Object handler
;
3327 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3329 /* If the file name has special constructs in it,
3330 call the corresponding file handler. */
3331 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3332 if (!NILP (handler
))
3333 return call2 (handler
, Qfile_regular_p
, absname
);
3335 absname
= ENCODE_FILE (absname
);
3340 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3342 /* Tell stat to use expensive method to get accurate info. */
3343 Vw32_get_true_file_attributes
= Qt
;
3344 result
= stat (SDATA (absname
), &st
);
3345 Vw32_get_true_file_attributes
= tem
;
3349 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3352 if (stat (SDATA (absname
), &st
) < 0)
3354 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3358 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3359 doc
: /* Return mode bits of file named FILENAME, as an integer. */)
3361 Lisp_Object filename
;
3363 Lisp_Object absname
;
3365 Lisp_Object handler
;
3367 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3369 /* If the file name has special constructs in it,
3370 call the corresponding file handler. */
3371 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3372 if (!NILP (handler
))
3373 return call2 (handler
, Qfile_modes
, absname
);
3375 absname
= ENCODE_FILE (absname
);
3377 if (stat (SDATA (absname
), &st
) < 0)
3379 #if defined (MSDOS) && __DJGPP__ < 2
3380 if (check_executable (SDATA (absname
)))
3381 st
.st_mode
|= S_IEXEC
;
3382 #endif /* MSDOS && __DJGPP__ < 2 */
3384 return make_number (st
.st_mode
& 07777);
3387 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3388 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3389 Only the 12 low bits of MODE are used. */)
3391 Lisp_Object filename
, mode
;
3393 Lisp_Object absname
, encoded_absname
;
3394 Lisp_Object handler
;
3396 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3397 CHECK_NUMBER (mode
);
3399 /* If the file name has special constructs in it,
3400 call the corresponding file handler. */
3401 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3402 if (!NILP (handler
))
3403 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3405 encoded_absname
= ENCODE_FILE (absname
);
3407 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3408 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3413 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3414 doc
: /* Set the file permission bits for newly created files.
3415 The argument MODE should be an integer; only the low 9 bits are used.
3416 This setting is inherited by subprocesses. */)
3420 CHECK_NUMBER (mode
);
3422 umask ((~ XINT (mode
)) & 0777);
3427 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3428 doc
: /* Return the default file protection for created files.
3429 The value is an integer. */)
3435 realmask
= umask (0);
3438 XSETINT (value
, (~ realmask
) & 0777);
3448 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3449 doc
: /* Tell Unix to finish all pending disk updates. */)
3458 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3459 doc
: /* Return t if file FILE1 is newer than file FILE2.
3460 If FILE1 does not exist, the answer is nil;
3461 otherwise, if FILE2 does not exist, the answer is t. */)
3463 Lisp_Object file1
, file2
;
3465 Lisp_Object absname1
, absname2
;
3468 Lisp_Object handler
;
3469 struct gcpro gcpro1
, gcpro2
;
3471 CHECK_STRING (file1
);
3472 CHECK_STRING (file2
);
3475 GCPRO2 (absname1
, file2
);
3476 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3477 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3480 /* If the file name has special constructs in it,
3481 call the corresponding file handler. */
3482 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3484 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3485 if (!NILP (handler
))
3486 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3488 GCPRO2 (absname1
, absname2
);
3489 absname1
= ENCODE_FILE (absname1
);
3490 absname2
= ENCODE_FILE (absname2
);
3493 if (stat (SDATA (absname1
), &st
) < 0)
3496 mtime1
= st
.st_mtime
;
3498 if (stat (SDATA (absname2
), &st
) < 0)
3501 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3505 Lisp_Object Qfind_buffer_file_type
;
3508 #ifndef READ_BUF_SIZE
3509 #define READ_BUF_SIZE (64 << 10)
3512 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3514 /* This function is called after Lisp functions to decide a coding
3515 system are called, or when they cause an error. Before they are
3516 called, the current buffer is set unibyte and it contains only a
3517 newly inserted text (thus the buffer was empty before the
3520 The functions may set markers, overlays, text properties, or even
3521 alter the buffer contents, change the current buffer.
3523 Here, we reset all those changes by:
3524 o set back the current buffer.
3525 o move all markers and overlays to BEG.
3526 o remove all text properties.
3527 o set back the buffer multibyteness. */
3530 decide_coding_unwind (unwind_data
)
3531 Lisp_Object unwind_data
;
3533 Lisp_Object multibyte
, undo_list
, buffer
;
3535 multibyte
= XCAR (unwind_data
);
3536 unwind_data
= XCDR (unwind_data
);
3537 undo_list
= XCAR (unwind_data
);
3538 buffer
= XCDR (unwind_data
);
3540 if (current_buffer
!= XBUFFER (buffer
))
3541 set_buffer_internal (XBUFFER (buffer
));
3542 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3543 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3544 BUF_INTERVALS (current_buffer
) = 0;
3545 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3547 /* Now we are safe to change the buffer's multibyteness directly. */
3548 current_buffer
->enable_multibyte_characters
= multibyte
;
3549 current_buffer
->undo_list
= undo_list
;
3555 /* Used to pass values from insert-file-contents to read_non_regular. */
3557 static int non_regular_fd
;
3558 static int non_regular_inserted
;
3559 static int non_regular_nbytes
;
3562 /* Read from a non-regular file.
3563 Read non_regular_trytry bytes max from non_regular_fd.
3564 Non_regular_inserted specifies where to put the read bytes.
3565 Value is the number of bytes read. */
3574 nbytes
= emacs_read (non_regular_fd
,
3575 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3576 non_regular_nbytes
);
3578 return make_number (nbytes
);
3582 /* Condition-case handler used when reading from non-regular files
3583 in insert-file-contents. */
3586 read_non_regular_quit ()
3592 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3594 doc
: /* Insert contents of file FILENAME after point.
3595 Returns list of absolute file name and number of characters inserted.
3596 If second argument VISIT is non-nil, the buffer's visited filename
3597 and last save file modtime are set, and it is marked unmodified.
3598 If visiting and the file does not exist, visiting is completed
3599 before the error is signaled.
3600 The optional third and fourth arguments BEG and END
3601 specify what portion of the file to insert.
3602 These arguments count bytes in the file, not characters in the buffer.
3603 If VISIT is non-nil, BEG and END must be nil.
3605 If optional fifth argument REPLACE is non-nil,
3606 it means replace the current buffer contents (in the accessible portion)
3607 with the file contents. This is better than simply deleting and inserting
3608 the whole thing because (1) it preserves some marker positions
3609 and (2) it puts less data in the undo list.
3610 When REPLACE is non-nil, the value is the number of characters actually read,
3611 which is often less than the number of characters to be read.
3613 This does code conversion according to the value of
3614 `coding-system-for-read' or `file-coding-system-alist',
3615 and sets the variable `last-coding-system-used' to the coding system
3617 (filename
, visit
, beg
, end
, replace
)
3618 Lisp_Object filename
, visit
, beg
, end
, replace
;
3623 register int how_much
;
3624 register int unprocessed
;
3625 int count
= SPECPDL_INDEX ();
3626 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3627 Lisp_Object handler
, val
, insval
, orig_filename
;
3630 int not_regular
= 0;
3631 unsigned char read_buf
[READ_BUF_SIZE
];
3632 struct coding_system coding
;
3633 unsigned char buffer
[1 << 14];
3634 int replace_handled
= 0;
3635 int set_coding_system
= 0;
3636 Lisp_Object coding_system
;
3639 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3640 error ("Cannot do file visiting in an indirect buffer");
3642 if (!NILP (current_buffer
->read_only
))
3643 Fbarf_if_buffer_read_only ();
3647 orig_filename
= Qnil
;
3649 GCPRO4 (filename
, val
, p
, orig_filename
);
3651 CHECK_STRING (filename
);
3652 filename
= Fexpand_file_name (filename
, Qnil
);
3654 /* The value Qnil means that the coding system is not yet
3656 coding_system
= Qnil
;
3658 /* If the file name has special constructs in it,
3659 call the corresponding file handler. */
3660 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3661 if (!NILP (handler
))
3663 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3664 visit
, beg
, end
, replace
);
3665 if (CONSP (val
) && CONSP (XCDR (val
)))
3666 inserted
= XINT (XCAR (XCDR (val
)));
3670 orig_filename
= filename
;
3671 filename
= ENCODE_FILE (filename
);
3677 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3679 /* Tell stat to use expensive method to get accurate info. */
3680 Vw32_get_true_file_attributes
= Qt
;
3681 total
= stat (SDATA (filename
), &st
);
3682 Vw32_get_true_file_attributes
= tem
;
3687 if (stat (SDATA (filename
), &st
) < 0)
3689 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3690 || fstat (fd
, &st
) < 0)
3691 #endif /* not APOLLO */
3692 #endif /* WINDOWSNT */
3694 if (fd
>= 0) emacs_close (fd
);
3697 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3700 if (!NILP (Vcoding_system_for_read
))
3701 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3706 /* This code will need to be changed in order to work on named
3707 pipes, and it's probably just not worth it. So we should at
3708 least signal an error. */
3709 if (!S_ISREG (st
.st_mode
))
3716 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3717 Fsignal (Qfile_error
,
3718 Fcons (build_string ("not a regular file"),
3719 Fcons (orig_filename
, Qnil
)));
3724 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3727 /* Replacement should preserve point as it preserves markers. */
3728 if (!NILP (replace
))
3729 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3731 record_unwind_protect (close_file_unwind
, make_number (fd
));
3733 /* Supposedly happens on VMS. */
3734 /* Can happen on any platform that uses long as type of off_t, but allows
3735 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3736 give a message suitable for the latter case. */
3737 if (! not_regular
&& st
.st_size
< 0)
3738 error ("Maximum buffer size exceeded");
3740 /* Prevent redisplay optimizations. */
3741 current_buffer
->clip_changed
= 1;
3745 if (!NILP (beg
) || !NILP (end
))
3746 error ("Attempt to visit less than an entire file");
3747 if (BEG
< Z
&& NILP (replace
))
3748 error ("Cannot do file visiting in a non-empty buffer");
3754 XSETFASTINT (beg
, 0);
3762 XSETINT (end
, st
.st_size
);
3764 /* Arithmetic overflow can occur if an Emacs integer cannot
3765 represent the file size, or if the calculations below
3766 overflow. The calculations below double the file size
3767 twice, so check that it can be multiplied by 4 safely. */
3768 if (XINT (end
) != st
.st_size
3769 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3770 error ("Maximum buffer size exceeded");
3772 /* The file size returned from stat may be zero, but data
3773 may be readable nonetheless, for example when this is a
3774 file in the /proc filesystem. */
3775 if (st
.st_size
== 0)
3776 XSETINT (end
, READ_BUF_SIZE
);
3780 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3782 coding_system
= Qutf_8_emacs
;
3783 setup_coding_system (coding_system
, &coding
);
3784 /* Ensure we set Vlast_coding_system_used. */
3785 set_coding_system
= 1;
3789 /* Decide the coding system to use for reading the file now
3790 because we can't use an optimized method for handling
3791 `coding:' tag if the current buffer is not empty. */
3792 if (!NILP (Vcoding_system_for_read
))
3793 coding_system
= Vcoding_system_for_read
;
3794 else if (! NILP (replace
))
3795 /* In REPLACE mode, we can use the same coding system
3796 that was used to visit the file. */
3797 coding_system
= current_buffer
->buffer_file_coding_system
;
3800 /* Don't try looking inside a file for a coding system
3801 specification if it is not seekable. */
3802 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3804 /* Find a coding system specified in the heading two
3805 lines or in the tailing several lines of the file.
3806 We assume that the 1K-byte and 3K-byte for heading
3807 and tailing respectively are sufficient for this
3811 if (st
.st_size
<= (1024 * 4))
3812 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3815 nread
= emacs_read (fd
, read_buf
, 1024);
3818 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3819 report_file_error ("Setting file position",
3820 Fcons (orig_filename
, Qnil
));
3821 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3826 error ("IO error reading %s: %s",
3827 SDATA (orig_filename
), emacs_strerror (errno
));
3830 struct buffer
*prev
= current_buffer
;
3834 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3836 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3837 buf
= XBUFFER (buffer
);
3839 delete_all_overlays (buf
);
3840 buf
->directory
= current_buffer
->directory
;
3841 buf
->read_only
= Qnil
;
3842 buf
->filename
= Qnil
;
3843 buf
->undo_list
= Qt
;
3844 eassert (buf
->overlays_before
== NULL
);
3845 eassert (buf
->overlays_after
== NULL
);
3847 set_buffer_internal (buf
);
3849 buf
->enable_multibyte_characters
= Qnil
;
3851 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3852 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3853 coding_system
= call2 (Vset_auto_coding_function
,
3854 filename
, make_number (nread
));
3855 set_buffer_internal (prev
);
3857 /* Discard the unwind protect for recovering the
3861 /* Rewind the file for the actual read done later. */
3862 if (lseek (fd
, 0, 0) < 0)
3863 report_file_error ("Setting file position",
3864 Fcons (orig_filename
, Qnil
));
3868 if (NILP (coding_system
))
3870 /* If we have not yet decided a coding system, check
3871 file-coding-system-alist. */
3872 Lisp_Object args
[6];
3874 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3875 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3876 coding_system
= Ffind_operation_coding_system (6, args
);
3877 if (CONSP (coding_system
))
3878 coding_system
= XCAR (coding_system
);
3882 if (NILP (coding_system
))
3883 coding_system
= Qundecided
;
3885 CHECK_CODING_SYSTEM (coding_system
);
3887 if (NILP (current_buffer
->enable_multibyte_characters
))
3888 /* We must suppress all character code conversion except for
3889 end-of-line conversion. */
3890 coding_system
= raw_text_coding_system (coding_system
);
3892 setup_coding_system (coding_system
, &coding
);
3893 /* Ensure we set Vlast_coding_system_used. */
3894 set_coding_system
= 1;
3897 /* If requested, replace the accessible part of the buffer
3898 with the file contents. Avoid replacing text at the
3899 beginning or end of the buffer that matches the file contents;
3900 that preserves markers pointing to the unchanged parts.
3902 Here we implement this feature in an optimized way
3903 for the case where code conversion is NOT needed.
3904 The following if-statement handles the case of conversion
3905 in a less optimal way.
3907 If the code conversion is "automatic" then we try using this
3908 method and hope for the best.
3909 But if we discover the need for conversion, we give up on this method
3910 and let the following if-statement handle the replace job. */
3913 && (NILP (coding_system
)
3914 || ! CODING_REQUIRE_DECODING (&coding
)))
3916 /* same_at_start and same_at_end count bytes,
3917 because file access counts bytes
3918 and BEG and END count bytes. */
3919 int same_at_start
= BEGV_BYTE
;
3920 int same_at_end
= ZV_BYTE
;
3922 /* There is still a possibility we will find the need to do code
3923 conversion. If that happens, we set this variable to 1 to
3924 give up on handling REPLACE in the optimized way. */
3925 int giveup_match_end
= 0;
3927 if (XINT (beg
) != 0)
3929 if (lseek (fd
, XINT (beg
), 0) < 0)
3930 report_file_error ("Setting file position",
3931 Fcons (orig_filename
, Qnil
));
3936 /* Count how many chars at the start of the file
3937 match the text at the beginning of the buffer. */
3942 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
3944 error ("IO error reading %s: %s",
3945 SDATA (orig_filename
), emacs_strerror (errno
));
3946 else if (nread
== 0)
3949 if (CODING_REQUIRE_DETECTION (&coding
))
3951 coding_system
= detect_coding_system (buffer
, nread
, nread
, 1, 0,
3953 setup_coding_system (coding_system
, &coding
);
3956 if (CODING_REQUIRE_DECODING (&coding
))
3957 /* We found that the file should be decoded somehow.
3958 Let's give up here. */
3960 giveup_match_end
= 1;
3965 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3966 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3967 same_at_start
++, bufpos
++;
3968 /* If we found a discrepancy, stop the scan.
3969 Otherwise loop around and scan the next bufferful. */
3970 if (bufpos
!= nread
)
3974 /* If the file matches the buffer completely,
3975 there's no need to replace anything. */
3976 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3980 /* Truncate the buffer to the size of the file. */
3981 del_range_1 (same_at_start
, same_at_end
, 0, 0);
3986 /* Count how many chars at the end of the file
3987 match the text at the end of the buffer. But, if we have
3988 already found that decoding is necessary, don't waste time. */
3989 while (!giveup_match_end
)
3991 int total_read
, nread
, bufpos
, curpos
, trial
;
3993 /* At what file position are we now scanning? */
3994 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3995 /* If the entire file matches the buffer tail, stop the scan. */
3998 /* How much can we scan in the next step? */
3999 trial
= min (curpos
, sizeof buffer
);
4000 if (lseek (fd
, curpos
- trial
, 0) < 0)
4001 report_file_error ("Setting file position",
4002 Fcons (orig_filename
, Qnil
));
4004 total_read
= nread
= 0;
4005 while (total_read
< trial
)
4007 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4009 error ("IO error reading %s: %s",
4010 SDATA (orig_filename
), emacs_strerror (errno
));
4011 else if (nread
== 0)
4013 total_read
+= nread
;
4016 /* Scan this bufferful from the end, comparing with
4017 the Emacs buffer. */
4018 bufpos
= total_read
;
4020 /* Compare with same_at_start to avoid counting some buffer text
4021 as matching both at the file's beginning and at the end. */
4022 while (bufpos
> 0 && same_at_end
> same_at_start
4023 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4024 same_at_end
--, bufpos
--;
4026 /* If we found a discrepancy, stop the scan.
4027 Otherwise loop around and scan the preceding bufferful. */
4030 /* If this discrepancy is because of code conversion,
4031 we cannot use this method; giveup and try the other. */
4032 if (same_at_end
> same_at_start
4033 && FETCH_BYTE (same_at_end
- 1) >= 0200
4034 && ! NILP (current_buffer
->enable_multibyte_characters
)
4035 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4036 giveup_match_end
= 1;
4045 if (! giveup_match_end
)
4049 /* We win! We can handle REPLACE the optimized way. */
4051 /* Extend the start of non-matching text area to multibyte
4052 character boundary. */
4053 if (! NILP (current_buffer
->enable_multibyte_characters
))
4054 while (same_at_start
> BEGV_BYTE
4055 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4058 /* Extend the end of non-matching text area to multibyte
4059 character boundary. */
4060 if (! NILP (current_buffer
->enable_multibyte_characters
))
4061 while (same_at_end
< ZV_BYTE
4062 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4065 /* Don't try to reuse the same piece of text twice. */
4066 overlap
= (same_at_start
- BEGV_BYTE
4067 - (same_at_end
+ st
.st_size
- ZV
));
4069 same_at_end
+= overlap
;
4071 /* Arrange to read only the nonmatching middle part of the file. */
4072 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4073 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4075 del_range_byte (same_at_start
, same_at_end
, 0);
4076 /* Insert from the file at the proper position. */
4077 temp
= BYTE_TO_CHAR (same_at_start
);
4078 SET_PT_BOTH (temp
, same_at_start
);
4080 /* If display currently starts at beginning of line,
4081 keep it that way. */
4082 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4083 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4085 replace_handled
= 1;
4089 /* If requested, replace the accessible part of the buffer
4090 with the file contents. Avoid replacing text at the
4091 beginning or end of the buffer that matches the file contents;
4092 that preserves markers pointing to the unchanged parts.
4094 Here we implement this feature for the case where code conversion
4095 is needed, in a simple way that needs a lot of memory.
4096 The preceding if-statement handles the case of no conversion
4097 in a more optimized way. */
4098 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4100 int same_at_start
= BEGV_BYTE
;
4101 int same_at_end
= ZV_BYTE
;
4102 int same_at_start_charpos
;
4106 unsigned char *decoded
;
4108 int this_count
= SPECPDL_INDEX ();
4109 int multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
4110 Lisp_Object conversion_buffer
;
4112 conversion_buffer
= code_conversion_save (1, multibyte
);
4114 /* First read the whole file, performing code conversion into
4115 CONVERSION_BUFFER. */
4117 if (lseek (fd
, XINT (beg
), 0) < 0)
4118 report_file_error ("Setting file position",
4119 Fcons (orig_filename
, Qnil
));
4121 total
= st
.st_size
; /* Total bytes in the file. */
4122 how_much
= 0; /* Bytes read from file so far. */
4123 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4124 unprocessed
= 0; /* Bytes not processed in previous loop. */
4126 GCPRO1 (conversion_buffer
);
4127 while (how_much
< total
)
4129 /* We read one bunch by one (READ_BUF_SIZE bytes) to allow
4130 quitting while reading a huge while. */
4131 /* try is reserved in some compilers (Microsoft C) */
4132 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4135 /* Allow quitting out of the actual I/O. */
4138 this = emacs_read (fd
, read_buf
+ unprocessed
, trytry
);
4150 BUF_SET_PT (XBUFFER (conversion_buffer
),
4151 BUF_Z (XBUFFER (conversion_buffer
)));
4152 decode_coding_c_string (&coding
, read_buf
, unprocessed
+ this,
4154 unprocessed
= coding
.carryover_bytes
;
4155 if (coding
.carryover_bytes
> 0)
4156 bcopy (coding
.carryover
, read_buf
, unprocessed
);
4161 /* At this point, HOW_MUCH should equal TOTAL, or should be <= 0
4162 if we couldn't read the file. */
4167 error ("IO error reading %s: %s",
4168 SDATA (orig_filename
), emacs_strerror (errno
));
4169 else if (how_much
== -2)
4170 error ("maximum buffer size exceeded");
4173 if (unprocessed
> 0)
4175 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4176 decode_coding_c_string (&coding
, read_buf
, unprocessed
,
4178 coding
.mode
&= ~CODING_MODE_LAST_BLOCK
;
4181 decoded
= BUF_BEG_ADDR (XBUFFER (conversion_buffer
));
4182 inserted
= (BUF_Z_BYTE (XBUFFER (conversion_buffer
))
4183 - BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
4185 /* Compare the beginning of the converted string with the buffer
4189 while (bufpos
< inserted
&& same_at_start
< same_at_end
4190 && FETCH_BYTE (same_at_start
) == decoded
[bufpos
])
4191 same_at_start
++, bufpos
++;
4193 /* If the file matches the head of buffer completely,
4194 there's no need to replace anything. */
4196 if (bufpos
== inserted
)
4199 /* Truncate the buffer to the size of the file. */
4200 del_range_byte (same_at_start
, same_at_end
, 0);
4203 unbind_to (this_count
, Qnil
);
4207 /* Extend the start of non-matching text area to the previous
4208 multibyte character boundary. */
4209 if (! NILP (current_buffer
->enable_multibyte_characters
))
4210 while (same_at_start
> BEGV_BYTE
4211 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4214 /* Scan this bufferful from the end, comparing with
4215 the Emacs buffer. */
4218 /* Compare with same_at_start to avoid counting some buffer text
4219 as matching both at the file's beginning and at the end. */
4220 while (bufpos
> 0 && same_at_end
> same_at_start
4221 && FETCH_BYTE (same_at_end
- 1) == decoded
[bufpos
- 1])
4222 same_at_end
--, bufpos
--;
4224 /* Extend the end of non-matching text area to the next
4225 multibyte character boundary. */
4226 if (! NILP (current_buffer
->enable_multibyte_characters
))
4227 while (same_at_end
< ZV_BYTE
4228 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4231 /* Don't try to reuse the same piece of text twice. */
4232 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4234 same_at_end
+= overlap
;
4236 /* If display currently starts at beginning of line,
4237 keep it that way. */
4238 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4239 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4241 /* Replace the chars that we need to replace,
4242 and update INSERTED to equal the number of bytes
4243 we are taking from the decoded string. */
4244 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
4246 if (same_at_end
!= same_at_start
)
4248 del_range_byte (same_at_start
, same_at_end
, 0);
4250 same_at_start
= GPT_BYTE
;
4254 temp
= BYTE_TO_CHAR (same_at_start
);
4256 /* Insert from the file at the proper position. */
4257 SET_PT_BOTH (temp
, same_at_start
);
4258 same_at_start_charpos
4259 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4262 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4263 same_at_start
+ inserted
)
4264 - same_at_start_charpos
);
4265 insert_from_buffer (XBUFFER (conversion_buffer
),
4266 same_at_start_charpos
, inserted_chars
, 0);
4267 /* Set `inserted' to the number of inserted characters. */
4268 inserted
= PT
- temp
;
4270 unbind_to (this_count
, Qnil
);
4277 register Lisp_Object temp
;
4279 total
= XINT (end
) - XINT (beg
);
4281 /* Make sure point-max won't overflow after this insertion. */
4282 XSETINT (temp
, total
);
4283 if (total
!= XINT (temp
))
4284 error ("Maximum buffer size exceeded");
4287 /* For a special file, all we can do is guess. */
4288 total
= READ_BUF_SIZE
;
4290 if (NILP (visit
) && total
> 0)
4291 prepare_to_modify_buffer (PT
, PT
, NULL
);
4294 if (GAP_SIZE
< total
)
4295 make_gap (total
- GAP_SIZE
);
4297 if (XINT (beg
) != 0 || !NILP (replace
))
4299 if (lseek (fd
, XINT (beg
), 0) < 0)
4300 report_file_error ("Setting file position",
4301 Fcons (orig_filename
, Qnil
));
4304 /* In the following loop, HOW_MUCH contains the total bytes read so
4305 far for a regular file, and not changed for a special file. But,
4306 before exiting the loop, it is set to a negative value if I/O
4310 /* Total bytes inserted. */
4313 /* Here, we don't do code conversion in the loop. It is done by
4314 decode_coding_gap after all data are read into the buffer. */
4316 int gap_size
= GAP_SIZE
;
4318 while (how_much
< total
)
4320 /* try is reserved in some compilers (Microsoft C) */
4321 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4328 /* Maybe make more room. */
4329 if (gap_size
< trytry
)
4331 make_gap (total
- gap_size
);
4332 gap_size
= GAP_SIZE
;
4335 /* Read from the file, capturing `quit'. When an
4336 error occurs, end the loop, and arrange for a quit
4337 to be signaled after decoding the text we read. */
4338 non_regular_fd
= fd
;
4339 non_regular_inserted
= inserted
;
4340 non_regular_nbytes
= trytry
;
4341 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4342 read_non_regular_quit
);
4353 /* Allow quitting out of the actual I/O. We don't make text
4354 part of the buffer until all the reading is done, so a C-g
4355 here doesn't do any harm. */
4358 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4370 /* For a regular file, where TOTAL is the real size,
4371 count HOW_MUCH to compare with it.
4372 For a special file, where TOTAL is just a buffer size,
4373 so don't bother counting in HOW_MUCH.
4374 (INSERTED is where we count the number of characters inserted.) */
4381 /* Make the text read part of the buffer. */
4382 GAP_SIZE
-= inserted
;
4384 GPT_BYTE
+= inserted
;
4386 ZV_BYTE
+= inserted
;
4391 /* Put an anchor to ensure multi-byte form ends at gap. */
4396 /* Discard the unwind protect for closing the file. */
4400 error ("IO error reading %s: %s",
4401 SDATA (orig_filename
), emacs_strerror (errno
));
4405 if (NILP (coding_system
))
4407 /* The coding system is not yet decided. Decide it by an
4408 optimized method for handling `coding:' tag.
4410 Note that we can get here only if the buffer was empty
4411 before the insertion. */
4413 if (!NILP (Vcoding_system_for_read
))
4414 coding_system
= Vcoding_system_for_read
;
4417 /* Since we are sure that the current buffer was empty
4418 before the insertion, we can toggle
4419 enable-multibyte-characters directly here without taking
4420 care of marker adjustment. By this way, we can run Lisp
4421 program safely before decoding the inserted text. */
4422 Lisp_Object unwind_data
;
4423 int count
= SPECPDL_INDEX ();
4425 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4426 Fcons (current_buffer
->undo_list
,
4427 Fcurrent_buffer ()));
4428 current_buffer
->enable_multibyte_characters
= Qnil
;
4429 current_buffer
->undo_list
= Qt
;
4430 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4432 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4434 coding_system
= call2 (Vset_auto_coding_function
,
4435 filename
, make_number (inserted
));
4438 if (NILP (coding_system
))
4440 /* If the coding system is not yet decided, check
4441 file-coding-system-alist. */
4442 Lisp_Object args
[6];
4444 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4445 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4446 coding_system
= Ffind_operation_coding_system (6, args
);
4447 if (CONSP (coding_system
))
4448 coding_system
= XCAR (coding_system
);
4451 unbind_to (count
, Qnil
);
4452 inserted
= Z_BYTE
- BEG_BYTE
;
4455 if (NILP (coding_system
))
4456 coding_system
= Qundecided
;
4458 CHECK_CODING_SYSTEM (coding_system
);
4460 if (NILP (current_buffer
->enable_multibyte_characters
))
4461 /* We must suppress all character code conversion except for
4462 end-of-line conversion. */
4463 coding_system
= raw_text_coding_system (coding_system
);
4464 setup_coding_system (coding_system
, &coding
);
4465 /* Ensure we set Vlast_coding_system_used. */
4466 set_coding_system
= 1;
4471 /* When we visit a file by raw-text, we change the buffer to
4473 if (CODING_FOR_UNIBYTE (&coding
)
4474 /* Can't do this if part of the buffer might be preserved. */
4476 /* Visiting a file with these coding system makes the buffer
4478 current_buffer
->enable_multibyte_characters
= Qnil
;
4481 coding
.dst_multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
4482 if (CODING_MAY_REQUIRE_DECODING (&coding
)
4483 && (inserted
> 0 || CODING_REQUIRE_FLUSHING (&coding
)))
4485 move_gap_both (PT
, PT_BYTE
);
4486 GAP_SIZE
+= inserted
;
4487 ZV_BYTE
-= inserted
;
4491 decode_coding_gap (&coding
, inserted
, inserted
);
4492 inserted
= coding
.produced_char
;
4493 coding_system
= CODING_ID_NAME (coding
.id
);
4495 else if (inserted
> 0)
4496 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4499 /* Now INSERTED is measured in characters. */
4502 /* Use the conversion type to determine buffer-file-type
4503 (find-buffer-file-type is now used to help determine the
4505 if ((VECTORP (CODING_ID_EOL_TYPE (coding
.id
))
4506 || EQ (CODING_ID_EOL_TYPE (coding
.id
), Qunix
))
4507 && ! CODING_REQUIRE_DECODING (&coding
))
4508 current_buffer
->buffer_file_type
= Qt
;
4510 current_buffer
->buffer_file_type
= Qnil
;
4517 if (!EQ (current_buffer
->undo_list
, Qt
))
4518 current_buffer
->undo_list
= Qnil
;
4520 stat (SDATA (filename
), &st
);
4525 current_buffer
->modtime
= st
.st_mtime
;
4526 current_buffer
->filename
= orig_filename
;
4529 SAVE_MODIFF
= MODIFF
;
4530 current_buffer
->auto_save_modified
= MODIFF
;
4531 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4532 #ifdef CLASH_DETECTION
4535 if (!NILP (current_buffer
->file_truename
))
4536 unlock_file (current_buffer
->file_truename
);
4537 unlock_file (filename
);
4539 #endif /* CLASH_DETECTION */
4541 Fsignal (Qfile_error
,
4542 Fcons (build_string ("not a regular file"),
4543 Fcons (orig_filename
, Qnil
)));
4546 if (set_coding_system
)
4547 Vlast_coding_system_used
= coding_system
;
4549 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4551 insval
= call1 (Qafter_insert_file_set_coding
, make_number (inserted
));
4552 if (! NILP (insval
))
4554 CHECK_NUMBER (insval
);
4555 inserted
= XFASTINT (insval
);
4559 /* Decode file format */
4562 int empty_undo_list_p
= 0;
4564 /* If we're anyway going to discard undo information, don't
4565 record it in the first place. The buffer's undo list at this
4566 point is either nil or t when visiting a file. */
4569 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4570 current_buffer
->undo_list
= Qt
;
4573 insval
= call3 (Qformat_decode
,
4574 Qnil
, make_number (inserted
), visit
);
4575 CHECK_NUMBER (insval
);
4576 inserted
= XFASTINT (insval
);
4579 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4582 /* Call after-change hooks for the inserted text, aside from the case
4583 of normal visiting (not with REPLACE), which is done in a new buffer
4584 "before" the buffer is changed. */
4585 if (inserted
> 0 && total
> 0
4586 && (NILP (visit
) || !NILP (replace
)))
4588 signal_after_change (PT
, 0, inserted
);
4589 update_compositions (PT
, PT
, CHECK_BORDER
);
4592 p
= Vafter_insert_file_functions
;
4595 insval
= call1 (XCAR (p
), make_number (inserted
));
4598 CHECK_NUMBER (insval
);
4599 inserted
= XFASTINT (insval
);
4606 && current_buffer
->modtime
== -1)
4608 /* If visiting nonexistent file, return nil. */
4609 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4613 Fsignal (Qquit
, Qnil
);
4615 /* ??? Retval needs to be dealt with in all cases consistently. */
4617 val
= Fcons (orig_filename
,
4618 Fcons (make_number (inserted
),
4621 RETURN_UNGCPRO (unbind_to (count
, val
));
4624 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4626 /* If build_annotations switched buffers, switch back to BUF.
4627 Kill the temporary buffer that was selected in the meantime.
4629 Since this kill only the last temporary buffer, some buffers remain
4630 not killed if build_annotations switched buffers more than once.
4634 build_annotations_unwind (buf
)
4639 if (XBUFFER (buf
) == current_buffer
)
4641 tembuf
= Fcurrent_buffer ();
4643 Fkill_buffer (tembuf
);
4647 /* Decide the coding-system to encode the data with. */
4650 choose_write_coding_system (start
, end
, filename
,
4651 append
, visit
, lockname
, coding
)
4652 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4653 struct coding_system
*coding
;
4659 else if (!NILP (Vcoding_system_for_write
))
4661 val
= Vcoding_system_for_write
;
4662 if (coding_system_require_warning
4663 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4664 /* Confirm that VAL can surely encode the current region. */
4665 val
= call5 (Vselect_safe_coding_system_function
,
4666 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4671 /* If the variable `buffer-file-coding-system' is set locally,
4672 it means that the file was read with some kind of code
4673 conversion or the variable is explicitly set by users. We
4674 had better write it out with the same coding system even if
4675 `enable-multibyte-characters' is nil.
4677 If it is not set locally, we anyway have to convert EOL
4678 format if the default value of `buffer-file-coding-system'
4679 tells that it is not Unix-like (LF only) format. */
4680 int using_default_coding
= 0;
4681 int force_raw_text
= 0;
4683 val
= current_buffer
->buffer_file_coding_system
;
4685 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4688 if (NILP (current_buffer
->enable_multibyte_characters
))
4694 /* Check file-coding-system-alist. */
4695 Lisp_Object args
[7], coding_systems
;
4697 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4698 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4700 coding_systems
= Ffind_operation_coding_system (7, args
);
4701 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4702 val
= XCDR (coding_systems
);
4707 /* If we still have not decided a coding system, use the
4708 default value of buffer-file-coding-system. */
4709 val
= current_buffer
->buffer_file_coding_system
;
4710 using_default_coding
= 1;
4713 if (! NILP (val
) && ! force_raw_text
)
4715 Lisp_Object spec
, attrs
;
4717 CHECK_CODING_SYSTEM_GET_SPEC (val
, spec
);
4718 attrs
= AREF (spec
, 0);
4719 if (EQ (CODING_ATTR_TYPE (attrs
), Qraw_text
))
4724 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4725 /* Confirm that VAL can surely encode the current region. */
4726 val
= call5 (Vselect_safe_coding_system_function
,
4727 start
, end
, val
, Qnil
, filename
);
4729 /* If the decided coding-system doesn't specify end-of-line
4730 format, we use that of
4731 `default-buffer-file-coding-system'. */
4732 if (! using_default_coding
4733 && ! NILP (buffer_defaults
.buffer_file_coding_system
))
4734 val
= (coding_inherit_eol_type
4735 (val
, buffer_defaults
.buffer_file_coding_system
));
4737 /* If we decide not to encode text, use `raw-text' or one of its
4740 val
= raw_text_coding_system (val
);
4743 setup_coding_system (val
, coding
);
4745 && VECTORP (CODING_ID_EOL_TYPE (coding
->id
)))
4746 val
= AREF (CODING_ID_EOL_TYPE (coding
->id
), 0);
4748 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4749 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4753 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4754 "r\nFWrite region to file: \ni\ni\ni\np",
4755 doc
: /* Write current region into specified file.
4756 When called from a program, requires three arguments:
4757 START, END and FILENAME. START and END are normally buffer positions
4758 specifying the part of the buffer to write.
4759 If START is nil, that means to use the entire buffer contents.
4760 If START is a string, then output that string to the file
4761 instead of any buffer contents; END is ignored.
4763 Optional fourth argument APPEND if non-nil means
4764 append to existing file contents (if any). If it is an integer,
4765 seek to that offset in the file before writing.
4766 Optional fifth argument VISIT if t means
4767 set the last-save-file-modtime of buffer to this file's modtime
4768 and mark buffer not modified.
4769 If VISIT is a string, it is a second file name;
4770 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4771 VISIT is also the file name to lock and unlock for clash detection.
4772 If VISIT is neither t nor nil nor a string,
4773 that means do not display the \"Wrote file\" message.
4774 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4775 use for locking and unlocking, overriding FILENAME and VISIT.
4776 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4777 for an existing file with the same name. If MUSTBENEW is `excl',
4778 that means to get an error if the file already exists; never overwrite.
4779 If MUSTBENEW is neither nil nor `excl', that means ask for
4780 confirmation before overwriting, but do go ahead and overwrite the file
4781 if the user confirms.
4783 This does code conversion according to the value of
4784 `coding-system-for-write', `buffer-file-coding-system', or
4785 `file-coding-system-alist', and sets the variable
4786 `last-coding-system-used' to the coding system actually used. */)
4787 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4788 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4793 const unsigned char *fn
;
4795 int count
= SPECPDL_INDEX ();
4798 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4800 Lisp_Object handler
;
4801 Lisp_Object visit_file
;
4802 Lisp_Object annotations
;
4803 Lisp_Object encoded_filename
;
4804 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4805 int quietly
= !NILP (visit
);
4806 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4807 struct buffer
*given_buffer
;
4809 int buffer_file_type
= O_BINARY
;
4811 struct coding_system coding
;
4813 if (current_buffer
->base_buffer
&& visiting
)
4814 error ("Cannot do file visiting in an indirect buffer");
4816 if (!NILP (start
) && !STRINGP (start
))
4817 validate_region (&start
, &end
);
4819 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4821 filename
= Fexpand_file_name (filename
, Qnil
);
4823 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4824 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4826 if (STRINGP (visit
))
4827 visit_file
= Fexpand_file_name (visit
, Qnil
);
4829 visit_file
= filename
;
4831 if (NILP (lockname
))
4832 lockname
= visit_file
;
4836 /* If the file name has special constructs in it,
4837 call the corresponding file handler. */
4838 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4839 /* If FILENAME has no handler, see if VISIT has one. */
4840 if (NILP (handler
) && STRINGP (visit
))
4841 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4843 if (!NILP (handler
))
4846 val
= call6 (handler
, Qwrite_region
, start
, end
,
4847 filename
, append
, visit
);
4851 SAVE_MODIFF
= MODIFF
;
4852 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4853 current_buffer
->filename
= visit_file
;
4859 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4861 /* Special kludge to simplify auto-saving. */
4864 XSETFASTINT (start
, BEG
);
4865 XSETFASTINT (end
, Z
);
4869 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4870 count1
= SPECPDL_INDEX ();
4872 given_buffer
= current_buffer
;
4874 if (!STRINGP (start
))
4876 annotations
= build_annotations (start
, end
);
4878 if (current_buffer
!= given_buffer
)
4880 XSETFASTINT (start
, BEGV
);
4881 XSETFASTINT (end
, ZV
);
4887 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4889 /* Decide the coding-system to encode the data with.
4890 We used to make this choice before calling build_annotations, but that
4891 leads to problems when a write-annotate-function takes care of
4892 unsavable chars (as was the case with X-Symbol). */
4893 Vlast_coding_system_used
4894 = choose_write_coding_system (start
, end
, filename
,
4895 append
, visit
, lockname
, &coding
);
4897 #ifdef CLASH_DETECTION
4900 #if 0 /* This causes trouble for GNUS. */
4901 /* If we've locked this file for some other buffer,
4902 query before proceeding. */
4903 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4904 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4907 lock_file (lockname
);
4909 #endif /* CLASH_DETECTION */
4911 encoded_filename
= ENCODE_FILE (filename
);
4913 fn
= SDATA (encoded_filename
);
4917 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
4918 #else /* not DOS_NT */
4919 desc
= emacs_open (fn
, O_WRONLY
, 0);
4920 #endif /* not DOS_NT */
4922 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4924 if (auto_saving
) /* Overwrite any previous version of autosave file */
4926 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4927 desc
= emacs_open (fn
, O_RDWR
, 0);
4929 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4930 ? SDATA (current_buffer
->filename
) : 0,
4933 else /* Write to temporary name and rename if no errors */
4935 Lisp_Object temp_name
;
4936 temp_name
= Ffile_name_directory (filename
);
4938 if (!NILP (temp_name
))
4940 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4941 build_string ("$$SAVE$$")));
4942 fname
= SDATA (filename
);
4943 fn
= SDATA (temp_name
);
4944 desc
= creat_copy_attrs (fname
, fn
);
4947 /* If we can't open the temporary file, try creating a new
4948 version of the original file. VMS "creat" creates a
4949 new version rather than truncating an existing file. */
4952 desc
= creat (fn
, 0666);
4953 #if 0 /* This can clobber an existing file and fail to replace it,
4954 if the user runs out of space. */
4957 /* We can't make a new version;
4958 try to truncate and rewrite existing version if any. */
4960 desc
= emacs_open (fn
, O_RDWR
, 0);
4966 desc
= creat (fn
, 0666);
4970 desc
= emacs_open (fn
,
4971 O_WRONLY
| O_CREAT
| buffer_file_type
4972 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
4973 S_IREAD
| S_IWRITE
);
4974 #else /* not DOS_NT */
4975 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
4976 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
4977 auto_saving
? auto_save_mode_bits
: 0666);
4978 #endif /* not DOS_NT */
4979 #endif /* not VMS */
4983 #ifdef CLASH_DETECTION
4985 if (!auto_saving
) unlock_file (lockname
);
4987 #endif /* CLASH_DETECTION */
4989 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4992 record_unwind_protect (close_file_unwind
, make_number (desc
));
4994 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
4998 if (NUMBERP (append
))
4999 ret
= lseek (desc
, XINT (append
), 1);
5001 ret
= lseek (desc
, 0, 2);
5004 #ifdef CLASH_DETECTION
5005 if (!auto_saving
) unlock_file (lockname
);
5006 #endif /* CLASH_DETECTION */
5008 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5016 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5017 * if we do writes that don't end with a carriage return. Furthermore
5018 * it cannot handle writes of more then 16K. The modified
5019 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5020 * this EXCEPT for the last record (iff it doesn't end with a carriage
5021 * return). This implies that if your buffer doesn't end with a carriage
5022 * return, you get one free... tough. However it also means that if
5023 * we make two calls to sys_write (a la the following code) you can
5024 * get one at the gap as well. The easiest way to fix this (honest)
5025 * is to move the gap to the next newline (or the end of the buffer).
5030 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5031 move_gap (find_next_newline (GPT
, 1));
5034 /* The new encoding routine doesn't require the following. */
5036 /* Whether VMS or not, we must move the gap to the next of newline
5037 when we must put designation sequences at beginning of line. */
5038 if (INTEGERP (start
)
5039 && coding
.type
== coding_type_iso2022
5040 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5041 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5043 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5044 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5045 move_gap_both (PT
, PT_BYTE
);
5046 SET_PT_BOTH (opoint
, opoint_byte
);
5054 if (STRINGP (start
))
5056 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5057 &annotations
, &coding
);
5060 else if (XINT (start
) != XINT (end
))
5062 failure
= 0 > a_write (desc
, Qnil
,
5063 XINT (start
), XINT (end
) - XINT (start
),
5064 &annotations
, &coding
);
5069 /* If file was empty, still need to write the annotations */
5070 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5071 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5075 if (CODING_REQUIRE_FLUSHING (&coding
)
5076 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5079 /* We have to flush out a data. */
5080 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5081 failure
= 0 > e_write (desc
, Qnil
, 1, 1, &coding
);
5088 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5089 Disk full in NFS may be reported here. */
5090 /* mib says that closing the file will try to write as fast as NFS can do
5091 it, and that means the fsync here is not crucial for autosave files. */
5092 if (!auto_saving
&& fsync (desc
) < 0)
5094 /* If fsync fails with EINTR, don't treat that as serious. */
5096 failure
= 1, save_errno
= errno
;
5100 /* Spurious "file has changed on disk" warnings have been
5101 observed on Suns as well.
5102 It seems that `close' can change the modtime, under nfs.
5104 (This has supposedly been fixed in Sunos 4,
5105 but who knows about all the other machines with NFS?) */
5108 /* On VMS and APOLLO, must do the stat after the close
5109 since closing changes the modtime. */
5112 /* Recall that #if defined does not work on VMS. */
5119 /* NFS can report a write failure now. */
5120 if (emacs_close (desc
) < 0)
5121 failure
= 1, save_errno
= errno
;
5124 /* If we wrote to a temporary name and had no errors, rename to real name. */
5128 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5136 /* Discard the unwind protect for close_file_unwind. */
5137 specpdl_ptr
= specpdl
+ count1
;
5138 /* Restore the original current buffer. */
5139 visit_file
= unbind_to (count
, visit_file
);
5141 #ifdef CLASH_DETECTION
5143 unlock_file (lockname
);
5144 #endif /* CLASH_DETECTION */
5146 /* Do this before reporting IO error
5147 to avoid a "file has changed on disk" warning on
5148 next attempt to save. */
5150 current_buffer
->modtime
= st
.st_mtime
;
5153 error ("IO error writing %s: %s", SDATA (filename
),
5154 emacs_strerror (save_errno
));
5158 SAVE_MODIFF
= MODIFF
;
5159 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5160 current_buffer
->filename
= visit_file
;
5161 update_mode_lines
++;
5167 message_with_string ((! INTEGERP (append
)
5177 Lisp_Object
merge ();
5179 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5180 doc
: /* Return t if (car A) is numerically less than (car B). */)
5184 return Flss (Fcar (a
), Fcar (b
));
5187 /* Build the complete list of annotations appropriate for writing out
5188 the text between START and END, by calling all the functions in
5189 write-region-annotate-functions and merging the lists they return.
5190 If one of these functions switches to a different buffer, we assume
5191 that buffer contains altered text. Therefore, the caller must
5192 make sure to restore the current buffer in all cases,
5193 as save-excursion would do. */
5196 build_annotations (start
, end
)
5197 Lisp_Object start
, end
;
5199 Lisp_Object annotations
;
5201 struct gcpro gcpro1
, gcpro2
;
5202 Lisp_Object original_buffer
;
5203 int i
, used_global
= 0;
5205 XSETBUFFER (original_buffer
, current_buffer
);
5208 p
= Vwrite_region_annotate_functions
;
5209 GCPRO2 (annotations
, p
);
5212 struct buffer
*given_buffer
= current_buffer
;
5213 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5214 { /* Use the global value of the hook. */
5217 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5219 p
= Fappend (2, arg
);
5222 Vwrite_region_annotations_so_far
= annotations
;
5223 res
= call2 (XCAR (p
), start
, end
);
5224 /* If the function makes a different buffer current,
5225 assume that means this buffer contains altered text to be output.
5226 Reset START and END from the buffer bounds
5227 and discard all previous annotations because they should have
5228 been dealt with by this function. */
5229 if (current_buffer
!= given_buffer
)
5231 XSETFASTINT (start
, BEGV
);
5232 XSETFASTINT (end
, ZV
);
5235 Flength (res
); /* Check basic validity of return value */
5236 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5240 /* Now do the same for annotation functions implied by the file-format */
5241 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
5242 p
= Vauto_save_file_format
;
5244 p
= current_buffer
->file_format
;
5245 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5247 struct buffer
*given_buffer
= current_buffer
;
5249 Vwrite_region_annotations_so_far
= annotations
;
5251 /* Value is either a list of annotations or nil if the function
5252 has written annotations to a temporary buffer, which is now
5254 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5255 original_buffer
, make_number (i
));
5256 if (current_buffer
!= given_buffer
)
5258 XSETFASTINT (start
, BEGV
);
5259 XSETFASTINT (end
, ZV
);
5264 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5272 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5273 If STRING is nil, POS is the character position in the current buffer.
5274 Intersperse with them the annotations from *ANNOT
5275 which fall within the range of POS to POS + NCHARS,
5276 each at its appropriate position.
5278 We modify *ANNOT by discarding elements as we use them up.
5280 The return value is negative in case of system call failure. */
5283 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5286 register int nchars
;
5289 struct coding_system
*coding
;
5293 int lastpos
= pos
+ nchars
;
5295 while (NILP (*annot
) || CONSP (*annot
))
5297 tem
= Fcar_safe (Fcar (*annot
));
5300 nextpos
= XFASTINT (tem
);
5302 /* If there are no more annotations in this range,
5303 output the rest of the range all at once. */
5304 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5305 return e_write (desc
, string
, pos
, lastpos
, coding
);
5307 /* Output buffer text up to the next annotation's position. */
5310 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5314 /* Output the annotation. */
5315 tem
= Fcdr (Fcar (*annot
));
5318 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5321 *annot
= Fcdr (*annot
);
5326 #ifndef WRITE_BUF_SIZE
5327 #define WRITE_BUF_SIZE (16 * 1024)
5330 /* Write text in the range START and END into descriptor DESC,
5331 encoding them with coding system CODING. If STRING is nil, START
5332 and END are character positions of the current buffer, else they
5333 are indexes to the string STRING. */
5336 e_write (desc
, string
, start
, end
, coding
)
5340 struct coding_system
*coding
;
5344 if (STRINGP (string
))
5347 end
= SCHARS (string
);
5350 /* We used to have a code for handling selective display here. But,
5351 now it is handled within encode_coding. */
5354 if (STRINGP (string
))
5355 encode_coding_object (coding
, string
,
5356 start
, string_char_to_byte (string
, start
),
5357 end
, string_char_to_byte (string
, end
), Qt
);
5359 encode_coding_object (coding
, Fcurrent_buffer (),
5360 start
, CHAR_TO_BYTE (start
),
5361 end
, CHAR_TO_BYTE (end
), Qt
);
5363 if (coding
->produced
> 0)
5365 coding
->produced
-= emacs_write (desc
, SDATA (coding
->dst_object
),
5368 if (coding
->produced
)
5374 start
+= coding
->consumed_char
;
5376 while (start
< end
);
5381 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5382 Sverify_visited_file_modtime
, 1, 1, 0,
5383 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5384 This means that the file has not been changed since it was visited or saved. */)
5390 Lisp_Object handler
;
5391 Lisp_Object filename
;
5396 if (!STRINGP (b
->filename
)) return Qt
;
5397 if (b
->modtime
== 0) return Qt
;
5399 /* If the file name has special constructs in it,
5400 call the corresponding file handler. */
5401 handler
= Ffind_file_name_handler (b
->filename
,
5402 Qverify_visited_file_modtime
);
5403 if (!NILP (handler
))
5404 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5406 filename
= ENCODE_FILE (b
->filename
);
5408 if (stat (SDATA (filename
), &st
) < 0)
5410 /* If the file doesn't exist now and didn't exist before,
5411 we say that it isn't modified, provided the error is a tame one. */
5412 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5417 if (st
.st_mtime
== b
->modtime
5418 /* If both are positive, accept them if they are off by one second. */
5419 || (st
.st_mtime
> 0 && b
->modtime
> 0
5420 && (st
.st_mtime
== b
->modtime
+ 1
5421 || st
.st_mtime
== b
->modtime
- 1)))
5426 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5427 Sclear_visited_file_modtime
, 0, 0, 0,
5428 doc
: /* Clear out records of last mod time of visited file.
5429 Next attempt to save will certainly not complain of a discrepancy. */)
5432 current_buffer
->modtime
= 0;
5436 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5437 Svisited_file_modtime
, 0, 0, 0,
5438 doc
: /* Return the current buffer's recorded visited file modification time.
5439 The value is a list of the form (HIGH . LOW), like the time values
5440 that `file-attributes' returns. */)
5443 return long_to_cons ((unsigned long) current_buffer
->modtime
);
5446 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5447 Sset_visited_file_modtime
, 0, 1, 0,
5448 doc
: /* Update buffer's recorded modification time from the visited file's time.
5449 Useful if the buffer was not read from the file normally
5450 or if the file itself has been changed for some known benign reason.
5451 An argument specifies the modification time value to use
5452 \(instead of that of the visited file), in the form of a list
5453 \(HIGH . LOW) or (HIGH LOW). */)
5455 Lisp_Object time_list
;
5457 if (!NILP (time_list
))
5458 current_buffer
->modtime
= cons_to_long (time_list
);
5461 register Lisp_Object filename
;
5463 Lisp_Object handler
;
5465 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5467 /* If the file name has special constructs in it,
5468 call the corresponding file handler. */
5469 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5470 if (!NILP (handler
))
5471 /* The handler can find the file name the same way we did. */
5472 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5474 filename
= ENCODE_FILE (filename
);
5476 if (stat (SDATA (filename
), &st
) >= 0)
5477 current_buffer
->modtime
= st
.st_mtime
;
5484 auto_save_error (error
)
5487 Lisp_Object args
[3], msg
;
5489 struct gcpro gcpro1
;
5493 args
[0] = build_string ("Auto-saving %s: %s");
5494 args
[1] = current_buffer
->name
;
5495 args
[2] = Ferror_message_string (error
);
5496 msg
= Fformat (3, args
);
5498 nbytes
= SBYTES (msg
);
5500 for (i
= 0; i
< 3; ++i
)
5503 message2 (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5505 message2_nolog (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5506 Fsleep_for (make_number (1), Qnil
);
5518 /* Get visited file's mode to become the auto save file's mode. */
5519 if (! NILP (current_buffer
->filename
)
5520 && stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5521 /* But make sure we can overwrite it later! */
5522 auto_save_mode_bits
= st
.st_mode
| 0600;
5524 auto_save_mode_bits
= 0666;
5527 Fwrite_region (Qnil
, Qnil
,
5528 current_buffer
->auto_save_file_name
,
5529 Qnil
, Qlambda
, Qnil
, Qnil
);
5533 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5538 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5539 | XFASTINT (XCDR (stream
))));
5544 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5547 minibuffer_auto_raise
= XINT (value
);
5552 do_auto_save_make_dir (dir
)
5555 return call2 (Qmake_directory
, dir
, Qt
);
5559 do_auto_save_eh (ignore
)
5565 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5566 doc
: /* Auto-save all buffers that need it.
5567 This is all buffers that have auto-saving enabled
5568 and are changed since last auto-saved.
5569 Auto-saving writes the buffer into a file
5570 so that your editing is not lost if the system crashes.
5571 This file is not the file you visited; that changes only when you save.
5572 Normally we run the normal hook `auto-save-hook' before saving.
5574 A non-nil NO-MESSAGE argument means do not print any message if successful.
5575 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5576 (no_message
, current_only
)
5577 Lisp_Object no_message
, current_only
;
5579 struct buffer
*old
= current_buffer
, *b
;
5580 Lisp_Object tail
, buf
;
5582 int do_handled_files
;
5585 Lisp_Object lispstream
;
5586 int count
= SPECPDL_INDEX ();
5587 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5588 int old_message_p
= 0;
5589 struct gcpro gcpro1
, gcpro2
;
5591 if (max_specpdl_size
< specpdl_size
+ 40)
5592 max_specpdl_size
= specpdl_size
+ 40;
5597 if (NILP (no_message
))
5599 old_message_p
= push_message ();
5600 record_unwind_protect (pop_message_unwind
, Qnil
);
5603 /* Ordinarily don't quit within this function,
5604 but don't make it impossible to quit (in case we get hung in I/O). */
5608 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5609 point to non-strings reached from Vbuffer_alist. */
5611 if (!NILP (Vrun_hooks
))
5612 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5614 if (STRINGP (Vauto_save_list_file_name
))
5616 Lisp_Object listfile
;
5618 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5620 /* Don't try to create the directory when shutting down Emacs,
5621 because creating the directory might signal an error, and
5622 that would leave Emacs in a strange state. */
5623 if (!NILP (Vrun_hooks
))
5627 GCPRO2 (dir
, listfile
);
5628 dir
= Ffile_name_directory (listfile
);
5629 if (NILP (Ffile_directory_p (dir
)))
5630 internal_condition_case_1 (do_auto_save_make_dir
,
5631 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5636 stream
= fopen (SDATA (listfile
), "w");
5639 /* Arrange to close that file whether or not we get an error.
5640 Also reset auto_saving to 0. */
5641 lispstream
= Fcons (Qnil
, Qnil
);
5642 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
5643 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
5654 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5655 record_unwind_protect (do_auto_save_unwind_1
,
5656 make_number (minibuffer_auto_raise
));
5657 minibuffer_auto_raise
= 0;
5660 /* First, save all files which don't have handlers. If Emacs is
5661 crashing, the handlers may tweak what is causing Emacs to crash
5662 in the first place, and it would be a shame if Emacs failed to
5663 autosave perfectly ordinary files because it couldn't handle some
5665 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5666 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5668 buf
= XCDR (XCAR (tail
));
5671 /* Record all the buffers that have auto save mode
5672 in the special file that lists them. For each of these buffers,
5673 Record visited name (if any) and auto save name. */
5674 if (STRINGP (b
->auto_save_file_name
)
5675 && stream
!= NULL
&& do_handled_files
== 0)
5677 if (!NILP (b
->filename
))
5679 fwrite (SDATA (b
->filename
), 1,
5680 SBYTES (b
->filename
), stream
);
5682 putc ('\n', stream
);
5683 fwrite (SDATA (b
->auto_save_file_name
), 1,
5684 SBYTES (b
->auto_save_file_name
), stream
);
5685 putc ('\n', stream
);
5688 if (!NILP (current_only
)
5689 && b
!= current_buffer
)
5692 /* Don't auto-save indirect buffers.
5693 The base buffer takes care of it. */
5697 /* Check for auto save enabled
5698 and file changed since last auto save
5699 and file changed since last real save. */
5700 if (STRINGP (b
->auto_save_file_name
)
5701 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5702 && b
->auto_save_modified
< BUF_MODIFF (b
)
5703 /* -1 means we've turned off autosaving for a while--see below. */
5704 && XINT (b
->save_length
) >= 0
5705 && (do_handled_files
5706 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5709 EMACS_TIME before_time
, after_time
;
5711 EMACS_GET_TIME (before_time
);
5713 /* If we had a failure, don't try again for 20 minutes. */
5714 if (b
->auto_save_failure_time
>= 0
5715 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5718 if ((XFASTINT (b
->save_length
) * 10
5719 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5720 /* A short file is likely to change a large fraction;
5721 spare the user annoying messages. */
5722 && XFASTINT (b
->save_length
) > 5000
5723 /* These messages are frequent and annoying for `*mail*'. */
5724 && !EQ (b
->filename
, Qnil
)
5725 && NILP (no_message
))
5727 /* It has shrunk too much; turn off auto-saving here. */
5728 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5729 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5731 minibuffer_auto_raise
= 0;
5732 /* Turn off auto-saving until there's a real save,
5733 and prevent any more warnings. */
5734 XSETINT (b
->save_length
, -1);
5735 Fsleep_for (make_number (1), Qnil
);
5738 set_buffer_internal (b
);
5739 if (!auto_saved
&& NILP (no_message
))
5740 message1 ("Auto-saving...");
5741 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5743 b
->auto_save_modified
= BUF_MODIFF (b
);
5744 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5745 set_buffer_internal (old
);
5747 EMACS_GET_TIME (after_time
);
5749 /* If auto-save took more than 60 seconds,
5750 assume it was an NFS failure that got a timeout. */
5751 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5752 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5756 /* Prevent another auto save till enough input events come in. */
5757 record_auto_save ();
5759 if (auto_saved
&& NILP (no_message
))
5763 /* If we are going to restore an old message,
5764 give time to read ours. */
5765 sit_for (1, 0, 0, 0, 0);
5769 /* If we displayed a message and then restored a state
5770 with no message, leave a "done" message on the screen. */
5771 message1 ("Auto-saving...done");
5776 /* This restores the message-stack status. */
5777 unbind_to (count
, Qnil
);
5781 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5782 Sset_buffer_auto_saved
, 0, 0, 0,
5783 doc
: /* Mark current buffer as auto-saved with its current text.
5784 No auto-save file will be written until the buffer changes again. */)
5787 current_buffer
->auto_save_modified
= MODIFF
;
5788 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5789 current_buffer
->auto_save_failure_time
= -1;
5793 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5794 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5795 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5798 current_buffer
->auto_save_failure_time
= -1;
5802 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5804 doc
: /* Return t if buffer has been auto-saved since last read in or saved. */)
5807 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5810 /* Reading and completing file names */
5811 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
5813 /* In the string VAL, change each $ to $$ and return the result. */
5816 double_dollars (val
)
5819 register const unsigned char *old
;
5820 register unsigned char *new;
5824 osize
= SBYTES (val
);
5826 /* Count the number of $ characters. */
5827 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
5828 if (*old
++ == '$') count
++;
5832 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
5835 for (n
= osize
; n
> 0; n
--)
5849 read_file_name_cleanup (arg
)
5852 return (current_buffer
->directory
= arg
);
5855 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
5857 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
5858 (string
, dir
, action
)
5859 Lisp_Object string
, dir
, action
;
5860 /* action is nil for complete, t for return list of completions,
5861 lambda for verify final value */
5863 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
5865 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5867 CHECK_STRING (string
);
5874 /* No need to protect ACTION--we only compare it with t and nil. */
5875 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
5877 if (SCHARS (string
) == 0)
5879 if (EQ (action
, Qlambda
))
5887 orig_string
= string
;
5888 string
= Fsubstitute_in_file_name (string
);
5889 changed
= NILP (Fstring_equal (string
, orig_string
));
5890 name
= Ffile_name_nondirectory (string
);
5891 val
= Ffile_name_directory (string
);
5893 realdir
= Fexpand_file_name (val
, realdir
);
5898 specdir
= Ffile_name_directory (string
);
5899 val
= Ffile_name_completion (name
, realdir
);
5904 return double_dollars (string
);
5908 if (!NILP (specdir
))
5909 val
= concat2 (specdir
, val
);
5911 return double_dollars (val
);
5914 #endif /* not VMS */
5918 if (EQ (action
, Qt
))
5920 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
5924 if (NILP (Vread_file_name_predicate
)
5925 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
5929 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
5931 /* Brute-force speed up for directory checking:
5932 Discard strings which don't end in a slash. */
5933 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
5935 Lisp_Object tem
= XCAR (all
);
5937 if (STRINGP (tem
) &&
5938 (len
= SCHARS (tem
), len
> 0) &&
5939 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
5940 comp
= Fcons (tem
, comp
);
5946 /* Must do it the hard (and slow) way. */
5947 GCPRO3 (all
, comp
, specdir
);
5948 count
= SPECPDL_INDEX ();
5949 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
5950 current_buffer
->directory
= realdir
;
5951 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
5952 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
5953 comp
= Fcons (XCAR (all
), comp
);
5954 unbind_to (count
, Qnil
);
5957 return Fnreverse (comp
);
5960 /* Only other case actually used is ACTION = lambda */
5962 /* Supposedly this helps commands such as `cd' that read directory names,
5963 but can someone explain how it helps them? -- RMS */
5964 if (SCHARS (name
) == 0)
5967 if (!NILP (Vread_file_name_predicate
))
5968 return call1 (Vread_file_name_predicate
, string
);
5969 return Ffile_exists_p (string
);
5972 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
5973 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
5974 Value is not expanded---you must call `expand-file-name' yourself.
5975 Default name to DEFAULT-FILENAME if user enters a null string.
5976 (If DEFAULT-FILENAME is omitted, the visited file name is used,
5977 except that if INITIAL is specified, that combined with DIR is used.)
5978 Fourth arg MUSTMATCH non-nil means require existing file's name.
5979 Non-nil and non-t means also require confirmation after completion.
5980 Fifth arg INITIAL specifies text to start with.
5981 If optional sixth arg PREDICATE is non-nil, possible completions and the
5982 resulting file name must satisfy (funcall PREDICATE NAME).
5983 DIR defaults to current buffer's directory default.
5985 If this command was invoked with the mouse, use a file dialog box if
5986 `use-dialog-box' is non-nil, and the window system or X toolkit in use
5987 provides a file dialog box. */)
5988 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
5989 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
5991 Lisp_Object val
, insdef
, tem
;
5992 struct gcpro gcpro1
, gcpro2
;
5993 register char *homedir
;
5994 Lisp_Object decoded_homedir
;
5995 int replace_in_history
= 0;
5996 int add_to_history
= 0;
6000 dir
= current_buffer
->directory
;
6001 if (NILP (default_filename
))
6002 default_filename
= !NILP (initial
)
6003 ? Fexpand_file_name (initial
, dir
)
6004 : current_buffer
->filename
;
6006 /* If dir starts with user's homedir, change that to ~. */
6007 homedir
= (char *) egetenv ("HOME");
6009 /* homedir can be NULL in temacs, since Vprocess_environment is not
6010 yet set up. We shouldn't crash in that case. */
6013 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6014 CORRECT_DIR_SEPS (homedir
);
6019 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6022 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6023 SBYTES (decoded_homedir
))
6024 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6026 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6027 dir
= concat2 (build_string ("~"), dir
);
6029 /* Likewise for default_filename. */
6031 && STRINGP (default_filename
)
6032 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6033 SBYTES (decoded_homedir
))
6034 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6037 = Fsubstring (default_filename
,
6038 make_number (SCHARS (decoded_homedir
)), Qnil
);
6039 default_filename
= concat2 (build_string ("~"), default_filename
);
6041 if (!NILP (default_filename
))
6043 CHECK_STRING (default_filename
);
6044 default_filename
= double_dollars (default_filename
);
6047 if (insert_default_directory
&& STRINGP (dir
))
6050 if (!NILP (initial
))
6052 Lisp_Object args
[2], pos
;
6056 insdef
= Fconcat (2, args
);
6057 pos
= make_number (SCHARS (double_dollars (dir
)));
6058 insdef
= Fcons (double_dollars (insdef
), pos
);
6061 insdef
= double_dollars (insdef
);
6063 else if (STRINGP (initial
))
6064 insdef
= Fcons (double_dollars (initial
), make_number (0));
6068 if (!NILP (Vread_file_name_function
))
6070 Lisp_Object args
[7];
6072 GCPRO2 (insdef
, default_filename
);
6073 args
[0] = Vread_file_name_function
;
6076 args
[3] = default_filename
;
6077 args
[4] = mustmatch
;
6079 args
[6] = predicate
;
6080 RETURN_UNGCPRO (Ffuncall (7, args
));
6083 count
= SPECPDL_INDEX ();
6085 specbind (intern ("completion-ignore-case"), Qt
);
6088 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6089 specbind (intern ("read-file-name-predicate"),
6090 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6092 GCPRO2 (insdef
, default_filename
);
6094 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
6095 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6099 /* If DIR contains a file name, split it. */
6101 file
= Ffile_name_nondirectory (dir
);
6102 if (SCHARS (file
) && NILP (default_filename
))
6104 default_filename
= file
;
6105 dir
= Ffile_name_directory (dir
);
6107 if (!NILP(default_filename
))
6108 default_filename
= Fexpand_file_name (default_filename
, dir
);
6109 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
);
6114 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6115 dir
, mustmatch
, insdef
,
6116 Qfile_name_history
, default_filename
, Qnil
);
6118 tem
= Fsymbol_value (Qfile_name_history
);
6119 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6120 replace_in_history
= 1;
6122 /* If Fcompleting_read returned the inserted default string itself
6123 (rather than a new string with the same contents),
6124 it has to mean that the user typed RET with the minibuffer empty.
6125 In that case, we really want to return ""
6126 so that commands such as set-visited-file-name can distinguish. */
6127 if (EQ (val
, default_filename
))
6129 /* In this case, Fcompleting_read has not added an element
6130 to the history. Maybe we should. */
6131 if (! replace_in_history
)
6137 unbind_to (count
, Qnil
);
6140 error ("No file name specified");
6142 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6144 if (!NILP (tem
) && !NILP (default_filename
))
6145 val
= default_filename
;
6146 else if (SCHARS (val
) == 0 && NILP (insdef
))
6148 if (!NILP (default_filename
))
6149 val
= default_filename
;
6151 error ("No default file name");
6153 val
= Fsubstitute_in_file_name (val
);
6155 if (replace_in_history
)
6156 /* Replace what Fcompleting_read added to the history
6157 with what we will actually return. */
6158 XSETCAR (Fsymbol_value (Qfile_name_history
), double_dollars (val
));
6159 else if (add_to_history
)
6161 /* Add the value to the history--but not if it matches
6162 the last value already there. */
6163 Lisp_Object val1
= double_dollars (val
);
6164 tem
= Fsymbol_value (Qfile_name_history
);
6165 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6166 Fset (Qfile_name_history
,
6177 /* Must be set before any path manipulation is performed. */
6178 XSETFASTINT (Vdirectory_sep_char
, '/');
6185 Qexpand_file_name
= intern ("expand-file-name");
6186 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6187 Qdirectory_file_name
= intern ("directory-file-name");
6188 Qfile_name_directory
= intern ("file-name-directory");
6189 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6190 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6191 Qfile_name_as_directory
= intern ("file-name-as-directory");
6192 Qcopy_file
= intern ("copy-file");
6193 Qmake_directory_internal
= intern ("make-directory-internal");
6194 Qmake_directory
= intern ("make-directory");
6195 Qdelete_directory
= intern ("delete-directory");
6196 Qdelete_file
= intern ("delete-file");
6197 Qrename_file
= intern ("rename-file");
6198 Qadd_name_to_file
= intern ("add-name-to-file");
6199 Qmake_symbolic_link
= intern ("make-symbolic-link");
6200 Qfile_exists_p
= intern ("file-exists-p");
6201 Qfile_executable_p
= intern ("file-executable-p");
6202 Qfile_readable_p
= intern ("file-readable-p");
6203 Qfile_writable_p
= intern ("file-writable-p");
6204 Qfile_symlink_p
= intern ("file-symlink-p");
6205 Qaccess_file
= intern ("access-file");
6206 Qfile_directory_p
= intern ("file-directory-p");
6207 Qfile_regular_p
= intern ("file-regular-p");
6208 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6209 Qfile_modes
= intern ("file-modes");
6210 Qset_file_modes
= intern ("set-file-modes");
6211 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6212 Qinsert_file_contents
= intern ("insert-file-contents");
6213 Qwrite_region
= intern ("write-region");
6214 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6215 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6216 Qauto_save_coding
= intern ("auto-save-coding");
6218 staticpro (&Qexpand_file_name
);
6219 staticpro (&Qsubstitute_in_file_name
);
6220 staticpro (&Qdirectory_file_name
);
6221 staticpro (&Qfile_name_directory
);
6222 staticpro (&Qfile_name_nondirectory
);
6223 staticpro (&Qunhandled_file_name_directory
);
6224 staticpro (&Qfile_name_as_directory
);
6225 staticpro (&Qcopy_file
);
6226 staticpro (&Qmake_directory_internal
);
6227 staticpro (&Qmake_directory
);
6228 staticpro (&Qdelete_directory
);
6229 staticpro (&Qdelete_file
);
6230 staticpro (&Qrename_file
);
6231 staticpro (&Qadd_name_to_file
);
6232 staticpro (&Qmake_symbolic_link
);
6233 staticpro (&Qfile_exists_p
);
6234 staticpro (&Qfile_executable_p
);
6235 staticpro (&Qfile_readable_p
);
6236 staticpro (&Qfile_writable_p
);
6237 staticpro (&Qaccess_file
);
6238 staticpro (&Qfile_symlink_p
);
6239 staticpro (&Qfile_directory_p
);
6240 staticpro (&Qfile_regular_p
);
6241 staticpro (&Qfile_accessible_directory_p
);
6242 staticpro (&Qfile_modes
);
6243 staticpro (&Qset_file_modes
);
6244 staticpro (&Qfile_newer_than_file_p
);
6245 staticpro (&Qinsert_file_contents
);
6246 staticpro (&Qwrite_region
);
6247 staticpro (&Qverify_visited_file_modtime
);
6248 staticpro (&Qset_visited_file_modtime
);
6249 staticpro (&Qauto_save_coding
);
6251 Qfile_name_history
= intern ("file-name-history");
6252 Fset (Qfile_name_history
, Qnil
);
6253 staticpro (&Qfile_name_history
);
6255 Qfile_error
= intern ("file-error");
6256 staticpro (&Qfile_error
);
6257 Qfile_already_exists
= intern ("file-already-exists");
6258 staticpro (&Qfile_already_exists
);
6259 Qfile_date_error
= intern ("file-date-error");
6260 staticpro (&Qfile_date_error
);
6261 Qexcl
= intern ("excl");
6265 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6266 staticpro (&Qfind_buffer_file_type
);
6269 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6270 doc
: /* *Coding system for encoding file names.
6271 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6272 Vfile_name_coding_system
= Qnil
;
6274 DEFVAR_LISP ("default-file-name-coding-system",
6275 &Vdefault_file_name_coding_system
,
6276 doc
: /* Default coding system for encoding file names.
6277 This variable is used only when `file-name-coding-system' is nil.
6279 This variable is set/changed by the command `set-language-environment'.
6280 User should not set this variable manually,
6281 instead use `file-name-coding-system' to get a constant encoding
6282 of file names regardless of the current language environment. */);
6283 Vdefault_file_name_coding_system
= Qnil
;
6285 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
6286 doc
: /* *Format in which to write auto-save files.
6287 Should be a list of symbols naming formats that are defined in `format-alist'.
6288 If it is t, which is the default, auto-save files are written in the
6289 same format as a regular save would use. */);
6290 Vauto_save_file_format
= Qt
;
6292 Qformat_decode
= intern ("format-decode");
6293 staticpro (&Qformat_decode
);
6294 Qformat_annotate_function
= intern ("format-annotate-function");
6295 staticpro (&Qformat_annotate_function
);
6296 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6297 staticpro (&Qafter_insert_file_set_coding
);
6299 Qcar_less_than_car
= intern ("car-less-than-car");
6300 staticpro (&Qcar_less_than_car
);
6302 Fput (Qfile_error
, Qerror_conditions
,
6303 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6304 Fput (Qfile_error
, Qerror_message
,
6305 build_string ("File error"));
6307 Fput (Qfile_already_exists
, Qerror_conditions
,
6308 Fcons (Qfile_already_exists
,
6309 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6310 Fput (Qfile_already_exists
, Qerror_message
,
6311 build_string ("File already exists"));
6313 Fput (Qfile_date_error
, Qerror_conditions
,
6314 Fcons (Qfile_date_error
,
6315 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6316 Fput (Qfile_date_error
, Qerror_message
,
6317 build_string ("Cannot set file date"));
6319 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6320 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6321 Vread_file_name_function
= Qnil
;
6323 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6324 doc
: /* Current predicate used by `read-file-name-internal'. */);
6325 Vread_file_name_predicate
= Qnil
;
6327 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6328 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer. */);
6329 insert_default_directory
= 1;
6331 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6332 doc
: /* *Non-nil means write new files with record format `stmlf'.
6333 nil means use format `var'. This variable is meaningful only on VMS. */);
6334 vms_stmlf_recfm
= 0;
6336 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6337 doc
: /* Directory separator character for built-in functions that return file names.
6338 The value is always ?/. Don't use this variable, just use `/'. */);
6340 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6341 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6342 If a file name matches REGEXP, then all I/O on that file is done by calling
6345 The first argument given to HANDLER is the name of the I/O primitive
6346 to be handled; the remaining arguments are the arguments that were
6347 passed to that primitive. For example, if you do
6348 (file-exists-p FILENAME)
6349 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6350 (funcall HANDLER 'file-exists-p FILENAME)
6351 The function `find-file-name-handler' checks this list for a handler
6352 for its argument. */);
6353 Vfile_name_handler_alist
= Qnil
;
6355 DEFVAR_LISP ("set-auto-coding-function",
6356 &Vset_auto_coding_function
,
6357 doc
: /* If non-nil, a function to call to decide a coding system of file.
6358 Two arguments are passed to this function: the file name
6359 and the length of a file contents following the point.
6360 This function should return a coding system to decode the file contents.
6361 It should check the file name against `auto-coding-alist'.
6362 If no coding system is decided, it should check a coding system
6363 specified in the heading lines with the format:
6364 -*- ... coding: CODING-SYSTEM; ... -*-
6365 or local variable spec of the tailing lines with `coding:' tag. */);
6366 Vset_auto_coding_function
= Qnil
;
6368 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6369 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6370 Each is passed one argument, the number of characters inserted.
6371 It should return the new character count, and leave point the same.
6372 If `insert-file-contents' is intercepted by a handler from
6373 `file-name-handler-alist', that handler is responsible for calling the
6374 functions in `after-insert-file-functions' if appropriate. */);
6375 Vafter_insert_file_functions
= Qnil
;
6377 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6378 doc
: /* A list of functions to be called at the start of `write-region'.
6379 Each is passed two arguments, START and END as for `write-region'.
6380 These are usually two numbers but not always; see the documentation
6381 for `write-region'. The function should return a list of pairs
6382 of the form (POSITION . STRING), consisting of strings to be effectively
6383 inserted at the specified positions of the file being written (1 means to
6384 insert before the first byte written). The POSITIONs must be sorted into
6385 increasing order. If there are several functions in the list, the several
6386 lists are merged destructively. Alternatively, the function can return
6387 with a different buffer current; in that case it should pay attention
6388 to the annotations returned by previous functions and listed in
6389 `write-region-annotations-so-far'.*/);
6390 Vwrite_region_annotate_functions
= Qnil
;
6391 staticpro (&Qwrite_region_annotate_functions
);
6392 Qwrite_region_annotate_functions
6393 = intern ("write-region-annotate-functions");
6395 DEFVAR_LISP ("write-region-annotations-so-far",
6396 &Vwrite_region_annotations_so_far
,
6397 doc
: /* When an annotation function is called, this holds the previous annotations.
6398 These are the annotations made by other annotation functions
6399 that were already called. See also `write-region-annotate-functions'. */);
6400 Vwrite_region_annotations_so_far
= Qnil
;
6402 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6403 doc
: /* A list of file name handlers that temporarily should not be used.
6404 This applies only to the operation `inhibit-file-name-operation'. */);
6405 Vinhibit_file_name_handlers
= Qnil
;
6407 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6408 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6409 Vinhibit_file_name_operation
= Qnil
;
6411 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6412 doc
: /* File name in which we write a list of all auto save file names.
6413 This variable is initialized automatically from `auto-save-list-file-prefix'
6414 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6415 a non-nil value. */);
6416 Vauto_save_list_file_name
= Qnil
;
6418 defsubr (&Sfind_file_name_handler
);
6419 defsubr (&Sfile_name_directory
);
6420 defsubr (&Sfile_name_nondirectory
);
6421 defsubr (&Sunhandled_file_name_directory
);
6422 defsubr (&Sfile_name_as_directory
);
6423 defsubr (&Sdirectory_file_name
);
6424 defsubr (&Smake_temp_name
);
6425 defsubr (&Sexpand_file_name
);
6426 defsubr (&Ssubstitute_in_file_name
);
6427 defsubr (&Scopy_file
);
6428 defsubr (&Smake_directory_internal
);
6429 defsubr (&Sdelete_directory
);
6430 defsubr (&Sdelete_file
);
6431 defsubr (&Srename_file
);
6432 defsubr (&Sadd_name_to_file
);
6434 defsubr (&Smake_symbolic_link
);
6435 #endif /* S_IFLNK */
6437 defsubr (&Sdefine_logical_name
);
6440 defsubr (&Ssysnetunam
);
6441 #endif /* HPUX_NET */
6442 defsubr (&Sfile_name_absolute_p
);
6443 defsubr (&Sfile_exists_p
);
6444 defsubr (&Sfile_executable_p
);
6445 defsubr (&Sfile_readable_p
);
6446 defsubr (&Sfile_writable_p
);
6447 defsubr (&Saccess_file
);
6448 defsubr (&Sfile_symlink_p
);
6449 defsubr (&Sfile_directory_p
);
6450 defsubr (&Sfile_accessible_directory_p
);
6451 defsubr (&Sfile_regular_p
);
6452 defsubr (&Sfile_modes
);
6453 defsubr (&Sset_file_modes
);
6454 defsubr (&Sset_default_file_modes
);
6455 defsubr (&Sdefault_file_modes
);
6456 defsubr (&Sfile_newer_than_file_p
);
6457 defsubr (&Sinsert_file_contents
);
6458 defsubr (&Swrite_region
);
6459 defsubr (&Scar_less_than_car
);
6460 defsubr (&Sverify_visited_file_modtime
);
6461 defsubr (&Sclear_visited_file_modtime
);
6462 defsubr (&Svisited_file_modtime
);
6463 defsubr (&Sset_visited_file_modtime
);
6464 defsubr (&Sdo_auto_save
);
6465 defsubr (&Sset_buffer_auto_saved
);
6466 defsubr (&Sclear_buffer_auto_save_failure
);
6467 defsubr (&Srecent_auto_save_p
);
6469 defsubr (&Sread_file_name_internal
);
6470 defsubr (&Sread_file_name
);
6473 defsubr (&Sunix_sync
);