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"
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
;
137 extern int use_file_dialog
;
151 /* Nonzero during writing of auto-save files */
154 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
155 a new file with the same mode as the original */
156 int auto_save_mode_bits
;
158 /* The symbol bound to coding-system-for-read when
159 insert-file-contents is called for recovering a file. This is not
160 an actual coding system name, but just an indicator to tell
161 insert-file-contents to use `emacs-mule' with a special flag for
162 auto saving and recovering a file. */
163 Lisp_Object Qauto_save_coding
;
165 /* Coding system for file names, or nil if none. */
166 Lisp_Object Vfile_name_coding_system
;
168 /* Coding system for file names used only when
169 Vfile_name_coding_system is nil. */
170 Lisp_Object Vdefault_file_name_coding_system
;
172 /* Alist of elements (REGEXP . HANDLER) for file names
173 whose I/O is done with a special handler. */
174 Lisp_Object Vfile_name_handler_alist
;
176 /* Format for auto-save files */
177 Lisp_Object Vauto_save_file_format
;
179 /* Lisp functions for translating file formats */
180 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
182 /* Function to be called to decide a coding system of a reading file. */
183 Lisp_Object Vset_auto_coding_function
;
185 /* Functions to be called to process text properties in inserted file. */
186 Lisp_Object Vafter_insert_file_functions
;
188 /* Lisp function for setting buffer-file-coding-system and the
189 multibyteness of the current buffer after inserting a file. */
190 Lisp_Object Qafter_insert_file_set_coding
;
192 /* Functions to be called to create text property annotations for file. */
193 Lisp_Object Vwrite_region_annotate_functions
;
194 Lisp_Object Qwrite_region_annotate_functions
;
196 /* During build_annotations, each time an annotation function is called,
197 this holds the annotations made by the previous functions. */
198 Lisp_Object Vwrite_region_annotations_so_far
;
200 /* File name in which we write a list of all our auto save files. */
201 Lisp_Object Vauto_save_list_file_name
;
203 /* Function to call to read a file name. */
204 Lisp_Object Vread_file_name_function
;
206 /* Current predicate used by read_file_name_internal. */
207 Lisp_Object Vread_file_name_predicate
;
209 /* Nonzero means, when reading a filename in the minibuffer,
210 start out by inserting the default directory into the minibuffer. */
211 int insert_default_directory
;
213 /* On VMS, nonzero means write new files with record format stmlf.
214 Zero means use var format. */
217 /* On NT, specifies the directory separator character, used (eg.) when
218 expanding file names. This can be bound to / or \. */
219 Lisp_Object Vdirectory_sep_char
;
221 extern Lisp_Object Vuser_login_name
;
224 extern Lisp_Object Vw32_get_true_file_attributes
;
227 extern int minibuf_level
;
229 extern int minibuffer_auto_raise
;
231 /* These variables describe handlers that have "already" had a chance
232 to handle the current operation.
234 Vinhibit_file_name_handlers is a list of file name handlers.
235 Vinhibit_file_name_operation is the operation being handled.
236 If we try to handle that operation, we ignore those handlers. */
238 static Lisp_Object Vinhibit_file_name_handlers
;
239 static Lisp_Object Vinhibit_file_name_operation
;
241 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
243 Lisp_Object Qfile_name_history
;
245 Lisp_Object Qcar_less_than_car
;
247 static int a_write
P_ ((int, Lisp_Object
, int, int,
248 Lisp_Object
*, struct coding_system
*));
249 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
253 report_file_error (string
, data
)
257 Lisp_Object errstring
;
260 synchronize_system_messages_locale ();
261 errstring
= code_convert_string_norecord (build_string (strerror (errorno
)),
262 Vlocale_coding_system
, 0);
268 Fsignal (Qfile_already_exists
, Fcons (errstring
, data
));
271 /* System error messages are capitalized. Downcase the initial
272 unless it is followed by a slash. */
273 if (SREF (errstring
, 1) != '/')
274 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
276 Fsignal (Qfile_error
,
277 Fcons (build_string (string
), Fcons (errstring
, data
)));
282 close_file_unwind (fd
)
285 emacs_close (XFASTINT (fd
));
289 /* Restore point, having saved it as a marker. */
292 restore_point_unwind (location
)
293 Lisp_Object location
;
295 Fgoto_char (location
);
296 Fset_marker (location
, Qnil
, Qnil
);
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 int coding_system_decided
= 0;
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 /* If the file name has special constructs in it,
3655 call the corresponding file handler. */
3656 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3657 if (!NILP (handler
))
3659 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3660 visit
, beg
, end
, replace
);
3661 if (CONSP (val
) && CONSP (XCDR (val
)))
3662 inserted
= XINT (XCAR (XCDR (val
)));
3666 orig_filename
= filename
;
3667 filename
= ENCODE_FILE (filename
);
3673 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3675 /* Tell stat to use expensive method to get accurate info. */
3676 Vw32_get_true_file_attributes
= Qt
;
3677 total
= stat (SDATA (filename
), &st
);
3678 Vw32_get_true_file_attributes
= tem
;
3683 if (stat (SDATA (filename
), &st
) < 0)
3685 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3686 || fstat (fd
, &st
) < 0)
3687 #endif /* not APOLLO */
3688 #endif /* WINDOWSNT */
3690 if (fd
>= 0) emacs_close (fd
);
3693 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3696 if (!NILP (Vcoding_system_for_read
))
3697 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3702 /* This code will need to be changed in order to work on named
3703 pipes, and it's probably just not worth it. So we should at
3704 least signal an error. */
3705 if (!S_ISREG (st
.st_mode
))
3712 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3713 Fsignal (Qfile_error
,
3714 Fcons (build_string ("not a regular file"),
3715 Fcons (orig_filename
, Qnil
)));
3720 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3723 /* Replacement should preserve point as it preserves markers. */
3724 if (!NILP (replace
))
3725 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3727 record_unwind_protect (close_file_unwind
, make_number (fd
));
3729 /* Supposedly happens on VMS. */
3730 /* Can happen on any platform that uses long as type of off_t, but allows
3731 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3732 give a message suitable for the latter case. */
3733 if (! not_regular
&& st
.st_size
< 0)
3734 error ("Maximum buffer size exceeded");
3736 /* Prevent redisplay optimizations. */
3737 current_buffer
->clip_changed
= 1;
3741 if (!NILP (beg
) || !NILP (end
))
3742 error ("Attempt to visit less than an entire file");
3743 if (BEG
< Z
&& NILP (replace
))
3744 error ("Cannot do file visiting in a non-empty buffer");
3750 XSETFASTINT (beg
, 0);
3758 XSETINT (end
, st
.st_size
);
3760 /* Arithmetic overflow can occur if an Emacs integer cannot
3761 represent the file size, or if the calculations below
3762 overflow. The calculations below double the file size
3763 twice, so check that it can be multiplied by 4 safely. */
3764 if (XINT (end
) != st
.st_size
3765 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3766 error ("Maximum buffer size exceeded");
3768 /* The file size returned from stat may be zero, but data
3769 may be readable nonetheless, for example when this is a
3770 file in the /proc filesystem. */
3771 if (st
.st_size
== 0)
3772 XSETINT (end
, READ_BUF_SIZE
);
3776 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3778 /* We use emacs-mule for auto saving... */
3779 setup_coding_system (Qemacs_mule
, &coding
);
3780 /* ... but with the special flag to indicate to read in a
3781 multibyte sequence for eight-bit-control char as is. */
3783 coding
.src_multibyte
= 0;
3784 coding
.dst_multibyte
3785 = !NILP (current_buffer
->enable_multibyte_characters
);
3786 coding
.eol_type
= CODING_EOL_LF
;
3787 coding_system_decided
= 1;
3791 /* Decide the coding system to use for reading the file now
3792 because we can't use an optimized method for handling
3793 `coding:' tag if the current buffer is not empty. */
3797 if (!NILP (Vcoding_system_for_read
))
3798 val
= Vcoding_system_for_read
;
3799 else if (! NILP (replace
))
3800 /* In REPLACE mode, we can use the same coding system
3801 that was used to visit the file. */
3802 val
= current_buffer
->buffer_file_coding_system
;
3805 /* Don't try looking inside a file for a coding system
3806 specification if it is not seekable. */
3807 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3809 /* Find a coding system specified in the heading two
3810 lines or in the tailing several lines of the file.
3811 We assume that the 1K-byte and 3K-byte for heading
3812 and tailing respectively are sufficient for this
3816 if (st
.st_size
<= (1024 * 4))
3817 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3820 nread
= emacs_read (fd
, read_buf
, 1024);
3823 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3824 report_file_error ("Setting file position",
3825 Fcons (orig_filename
, Qnil
));
3826 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3831 error ("IO error reading %s: %s",
3832 SDATA (orig_filename
), emacs_strerror (errno
));
3835 struct buffer
*prev
= current_buffer
;
3839 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3841 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3842 buf
= XBUFFER (buffer
);
3844 delete_all_overlays (buf
);
3845 buf
->directory
= current_buffer
->directory
;
3846 buf
->read_only
= Qnil
;
3847 buf
->filename
= Qnil
;
3848 buf
->undo_list
= Qt
;
3849 eassert (buf
->overlays_before
== NULL
);
3850 eassert (buf
->overlays_after
== NULL
);
3852 set_buffer_internal (buf
);
3854 buf
->enable_multibyte_characters
= Qnil
;
3856 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3857 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3858 val
= call2 (Vset_auto_coding_function
,
3859 filename
, make_number (nread
));
3860 set_buffer_internal (prev
);
3862 /* Discard the unwind protect for recovering the
3866 /* Rewind the file for the actual read done later. */
3867 if (lseek (fd
, 0, 0) < 0)
3868 report_file_error ("Setting file position",
3869 Fcons (orig_filename
, Qnil
));
3875 /* If we have not yet decided a coding system, check
3876 file-coding-system-alist. */
3877 Lisp_Object args
[6], coding_systems
;
3879 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3880 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3881 coding_systems
= Ffind_operation_coding_system (6, args
);
3882 if (CONSP (coding_systems
))
3883 val
= XCAR (coding_systems
);
3887 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3888 /* Ensure we set Vlast_coding_system_used. */
3889 set_coding_system
= 1;
3891 if (NILP (current_buffer
->enable_multibyte_characters
)
3893 /* We must suppress all character code conversion except for
3894 end-of-line conversion. */
3895 setup_raw_text_coding_system (&coding
);
3897 coding
.src_multibyte
= 0;
3898 coding
.dst_multibyte
3899 = !NILP (current_buffer
->enable_multibyte_characters
);
3900 coding_system_decided
= 1;
3903 /* If requested, replace the accessible part of the buffer
3904 with the file contents. Avoid replacing text at the
3905 beginning or end of the buffer that matches the file contents;
3906 that preserves markers pointing to the unchanged parts.
3908 Here we implement this feature in an optimized way
3909 for the case where code conversion is NOT needed.
3910 The following if-statement handles the case of conversion
3911 in a less optimal way.
3913 If the code conversion is "automatic" then we try using this
3914 method and hope for the best.
3915 But if we discover the need for conversion, we give up on this method
3916 and let the following if-statement handle the replace job. */
3919 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
3921 /* same_at_start and same_at_end count bytes,
3922 because file access counts bytes
3923 and BEG and END count bytes. */
3924 int same_at_start
= BEGV_BYTE
;
3925 int same_at_end
= ZV_BYTE
;
3927 /* There is still a possibility we will find the need to do code
3928 conversion. If that happens, we set this variable to 1 to
3929 give up on handling REPLACE in the optimized way. */
3930 int giveup_match_end
= 0;
3932 if (XINT (beg
) != 0)
3934 if (lseek (fd
, XINT (beg
), 0) < 0)
3935 report_file_error ("Setting file position",
3936 Fcons (orig_filename
, Qnil
));
3941 /* Count how many chars at the start of the file
3942 match the text at the beginning of the buffer. */
3947 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
3949 error ("IO error reading %s: %s",
3950 SDATA (orig_filename
), emacs_strerror (errno
));
3951 else if (nread
== 0)
3954 if (coding
.type
== coding_type_undecided
)
3955 detect_coding (&coding
, buffer
, nread
);
3956 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
3957 /* We found that the file should be decoded somehow.
3958 Let's give up here. */
3960 giveup_match_end
= 1;
3964 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3965 detect_eol (&coding
, buffer
, nread
);
3966 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3967 && coding
.eol_type
!= CODING_EOL_LF
)
3968 /* We found that the format of eol should be decoded.
3969 Let's give up here. */
3971 giveup_match_end
= 1;
3976 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3977 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3978 same_at_start
++, bufpos
++;
3979 /* If we found a discrepancy, stop the scan.
3980 Otherwise loop around and scan the next bufferful. */
3981 if (bufpos
!= nread
)
3985 /* If the file matches the buffer completely,
3986 there's no need to replace anything. */
3987 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3991 /* Truncate the buffer to the size of the file. */
3992 del_range_1 (same_at_start
, same_at_end
, 0, 0);
3997 /* Count how many chars at the end of the file
3998 match the text at the end of the buffer. But, if we have
3999 already found that decoding is necessary, don't waste time. */
4000 while (!giveup_match_end
)
4002 int total_read
, nread
, bufpos
, curpos
, trial
;
4004 /* At what file position are we now scanning? */
4005 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4006 /* If the entire file matches the buffer tail, stop the scan. */
4009 /* How much can we scan in the next step? */
4010 trial
= min (curpos
, sizeof buffer
);
4011 if (lseek (fd
, curpos
- trial
, 0) < 0)
4012 report_file_error ("Setting file position",
4013 Fcons (orig_filename
, Qnil
));
4015 total_read
= nread
= 0;
4016 while (total_read
< trial
)
4018 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4020 error ("IO error reading %s: %s",
4021 SDATA (orig_filename
), emacs_strerror (errno
));
4022 else if (nread
== 0)
4024 total_read
+= nread
;
4027 /* Scan this bufferful from the end, comparing with
4028 the Emacs buffer. */
4029 bufpos
= total_read
;
4031 /* Compare with same_at_start to avoid counting some buffer text
4032 as matching both at the file's beginning and at the end. */
4033 while (bufpos
> 0 && same_at_end
> same_at_start
4034 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4035 same_at_end
--, bufpos
--;
4037 /* If we found a discrepancy, stop the scan.
4038 Otherwise loop around and scan the preceding bufferful. */
4041 /* If this discrepancy is because of code conversion,
4042 we cannot use this method; giveup and try the other. */
4043 if (same_at_end
> same_at_start
4044 && FETCH_BYTE (same_at_end
- 1) >= 0200
4045 && ! NILP (current_buffer
->enable_multibyte_characters
)
4046 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4047 giveup_match_end
= 1;
4056 if (! giveup_match_end
)
4060 /* We win! We can handle REPLACE the optimized way. */
4062 /* Extend the start of non-matching text area to multibyte
4063 character boundary. */
4064 if (! NILP (current_buffer
->enable_multibyte_characters
))
4065 while (same_at_start
> BEGV_BYTE
4066 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4069 /* Extend the end of non-matching text area to multibyte
4070 character boundary. */
4071 if (! NILP (current_buffer
->enable_multibyte_characters
))
4072 while (same_at_end
< ZV_BYTE
4073 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4076 /* Don't try to reuse the same piece of text twice. */
4077 overlap
= (same_at_start
- BEGV_BYTE
4078 - (same_at_end
+ st
.st_size
- ZV
));
4080 same_at_end
+= overlap
;
4082 /* Arrange to read only the nonmatching middle part of the file. */
4083 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4084 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4086 del_range_byte (same_at_start
, same_at_end
, 0);
4087 /* Insert from the file at the proper position. */
4088 temp
= BYTE_TO_CHAR (same_at_start
);
4089 SET_PT_BOTH (temp
, same_at_start
);
4091 /* If display currently starts at beginning of line,
4092 keep it that way. */
4093 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4094 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4096 replace_handled
= 1;
4100 /* If requested, replace the accessible part of the buffer
4101 with the file contents. Avoid replacing text at the
4102 beginning or end of the buffer that matches the file contents;
4103 that preserves markers pointing to the unchanged parts.
4105 Here we implement this feature for the case where code conversion
4106 is needed, in a simple way that needs a lot of memory.
4107 The preceding if-statement handles the case of no conversion
4108 in a more optimized way. */
4109 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4111 int same_at_start
= BEGV_BYTE
;
4112 int same_at_end
= ZV_BYTE
;
4115 /* Make sure that the gap is large enough. */
4116 int bufsize
= 2 * st
.st_size
;
4117 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4120 /* First read the whole file, performing code conversion into
4121 CONVERSION_BUFFER. */
4123 if (lseek (fd
, XINT (beg
), 0) < 0)
4125 xfree (conversion_buffer
);
4126 report_file_error ("Setting file position",
4127 Fcons (orig_filename
, Qnil
));
4130 total
= st
.st_size
; /* Total bytes in the file. */
4131 how_much
= 0; /* Bytes read from file so far. */
4132 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4133 unprocessed
= 0; /* Bytes not processed in previous loop. */
4135 while (how_much
< total
)
4137 /* try is reserved in some compilers (Microsoft C) */
4138 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4139 unsigned char *destination
= read_buf
+ unprocessed
;
4142 /* Allow quitting out of the actual I/O. */
4145 this = emacs_read (fd
, destination
, trytry
);
4148 if (this < 0 || this + unprocessed
== 0)
4156 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4158 int require
, result
;
4160 this += unprocessed
;
4162 /* If we are using more space than estimated,
4163 make CONVERSION_BUFFER bigger. */
4164 require
= decoding_buffer_size (&coding
, this);
4165 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4167 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4168 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4171 /* Convert this batch with results in CONVERSION_BUFFER. */
4172 if (how_much
>= total
) /* This is the last block. */
4173 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4174 if (coding
.composing
!= COMPOSITION_DISABLED
)
4175 coding_allocate_composition_data (&coding
, BEGV
);
4176 result
= decode_coding (&coding
, read_buf
,
4177 conversion_buffer
+ inserted
,
4178 this, bufsize
- inserted
);
4180 /* Save for next iteration whatever we didn't convert. */
4181 unprocessed
= this - coding
.consumed
;
4182 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4183 if (!NILP (current_buffer
->enable_multibyte_characters
))
4184 this = coding
.produced
;
4186 this = str_as_unibyte (conversion_buffer
+ inserted
,
4193 /* At this point, INSERTED is how many characters (i.e. bytes)
4194 are present in CONVERSION_BUFFER.
4195 HOW_MUCH should equal TOTAL,
4196 or should be <= 0 if we couldn't read the file. */
4200 xfree (conversion_buffer
);
4203 error ("IO error reading %s: %s",
4204 SDATA (orig_filename
), emacs_strerror (errno
));
4205 else if (how_much
== -2)
4206 error ("maximum buffer size exceeded");
4209 /* Compare the beginning of the converted file
4210 with the buffer text. */
4213 while (bufpos
< inserted
&& same_at_start
< same_at_end
4214 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4215 same_at_start
++, bufpos
++;
4217 /* If the file matches the buffer completely,
4218 there's no need to replace anything. */
4220 if (bufpos
== inserted
)
4222 xfree (conversion_buffer
);
4225 /* Truncate the buffer to the size of the file. */
4226 del_range_byte (same_at_start
, same_at_end
, 0);
4231 /* Extend the start of non-matching text area to multibyte
4232 character boundary. */
4233 if (! NILP (current_buffer
->enable_multibyte_characters
))
4234 while (same_at_start
> BEGV_BYTE
4235 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4238 /* Scan this bufferful from the end, comparing with
4239 the Emacs buffer. */
4242 /* Compare with same_at_start to avoid counting some buffer text
4243 as matching both at the file's beginning and at the end. */
4244 while (bufpos
> 0 && same_at_end
> same_at_start
4245 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4246 same_at_end
--, bufpos
--;
4248 /* Extend the end of non-matching text area to multibyte
4249 character boundary. */
4250 if (! NILP (current_buffer
->enable_multibyte_characters
))
4251 while (same_at_end
< ZV_BYTE
4252 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4255 /* Don't try to reuse the same piece of text twice. */
4256 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4258 same_at_end
+= overlap
;
4260 /* If display currently starts at beginning of line,
4261 keep it that way. */
4262 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4263 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4265 /* Replace the chars that we need to replace,
4266 and update INSERTED to equal the number of bytes
4267 we are taking from the file. */
4268 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
4270 if (same_at_end
!= same_at_start
)
4272 del_range_byte (same_at_start
, same_at_end
, 0);
4274 same_at_start
= GPT_BYTE
;
4278 temp
= BYTE_TO_CHAR (same_at_start
);
4280 /* Insert from the file at the proper position. */
4281 SET_PT_BOTH (temp
, same_at_start
);
4282 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
4284 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4285 coding_restore_composition (&coding
, Fcurrent_buffer ());
4286 coding_free_composition_data (&coding
);
4288 /* Set `inserted' to the number of inserted characters. */
4289 inserted
= PT
- temp
;
4291 xfree (conversion_buffer
);
4300 register Lisp_Object temp
;
4302 total
= XINT (end
) - XINT (beg
);
4304 /* Make sure point-max won't overflow after this insertion. */
4305 XSETINT (temp
, total
);
4306 if (total
!= XINT (temp
))
4307 error ("Maximum buffer size exceeded");
4310 /* For a special file, all we can do is guess. */
4311 total
= READ_BUF_SIZE
;
4313 if (NILP (visit
) && total
> 0)
4314 prepare_to_modify_buffer (PT
, PT
, NULL
);
4317 if (GAP_SIZE
< total
)
4318 make_gap (total
- GAP_SIZE
);
4320 if (XINT (beg
) != 0 || !NILP (replace
))
4322 if (lseek (fd
, XINT (beg
), 0) < 0)
4323 report_file_error ("Setting file position",
4324 Fcons (orig_filename
, Qnil
));
4327 /* In the following loop, HOW_MUCH contains the total bytes read so
4328 far for a regular file, and not changed for a special file. But,
4329 before exiting the loop, it is set to a negative value if I/O
4333 /* Total bytes inserted. */
4336 /* Here, we don't do code conversion in the loop. It is done by
4337 code_convert_region after all data are read into the buffer. */
4339 int gap_size
= GAP_SIZE
;
4341 while (how_much
< total
)
4343 /* try is reserved in some compilers (Microsoft C) */
4344 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4351 /* Maybe make more room. */
4352 if (gap_size
< trytry
)
4354 make_gap (total
- gap_size
);
4355 gap_size
= GAP_SIZE
;
4358 /* Read from the file, capturing `quit'. When an
4359 error occurs, end the loop, and arrange for a quit
4360 to be signaled after decoding the text we read. */
4361 non_regular_fd
= fd
;
4362 non_regular_inserted
= inserted
;
4363 non_regular_nbytes
= trytry
;
4364 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4365 read_non_regular_quit
);
4376 /* Allow quitting out of the actual I/O. We don't make text
4377 part of the buffer until all the reading is done, so a C-g
4378 here doesn't do any harm. */
4381 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4393 /* For a regular file, where TOTAL is the real size,
4394 count HOW_MUCH to compare with it.
4395 For a special file, where TOTAL is just a buffer size,
4396 so don't bother counting in HOW_MUCH.
4397 (INSERTED is where we count the number of characters inserted.) */
4404 /* Make the text read part of the buffer. */
4405 GAP_SIZE
-= inserted
;
4407 GPT_BYTE
+= inserted
;
4409 ZV_BYTE
+= inserted
;
4414 /* Put an anchor to ensure multi-byte form ends at gap. */
4419 /* Discard the unwind protect for closing the file. */
4423 error ("IO error reading %s: %s",
4424 SDATA (orig_filename
), emacs_strerror (errno
));
4428 if (! coding_system_decided
)
4430 /* The coding system is not yet decided. Decide it by an
4431 optimized method for handling `coding:' tag.
4433 Note that we can get here only if the buffer was empty
4434 before the insertion. */
4438 if (!NILP (Vcoding_system_for_read
))
4439 val
= Vcoding_system_for_read
;
4442 /* Since we are sure that the current buffer was empty
4443 before the insertion, we can toggle
4444 enable-multibyte-characters directly here without taking
4445 care of marker adjustment and byte combining problem. By
4446 this way, we can run Lisp program safely before decoding
4447 the inserted text. */
4448 Lisp_Object unwind_data
;
4449 int count
= SPECPDL_INDEX ();
4451 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4452 Fcons (current_buffer
->undo_list
,
4453 Fcurrent_buffer ()));
4454 current_buffer
->enable_multibyte_characters
= Qnil
;
4455 current_buffer
->undo_list
= Qt
;
4456 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4458 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4460 val
= call2 (Vset_auto_coding_function
,
4461 filename
, make_number (inserted
));
4466 /* If the coding system is not yet decided, check
4467 file-coding-system-alist. */
4468 Lisp_Object args
[6], coding_systems
;
4470 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4471 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4472 coding_systems
= Ffind_operation_coding_system (6, args
);
4473 if (CONSP (coding_systems
))
4474 val
= XCAR (coding_systems
);
4477 unbind_to (count
, Qnil
);
4478 inserted
= Z_BYTE
- BEG_BYTE
;
4481 /* The following kludgy code is to avoid some compiler bug.
4483 setup_coding_system (val, &coding);
4486 struct coding_system temp_coding
;
4487 setup_coding_system (val
, &temp_coding
);
4488 bcopy (&temp_coding
, &coding
, sizeof coding
);
4490 /* Ensure we set Vlast_coding_system_used. */
4491 set_coding_system
= 1;
4493 if (NILP (current_buffer
->enable_multibyte_characters
)
4495 /* We must suppress all character code conversion except for
4496 end-of-line conversion. */
4497 setup_raw_text_coding_system (&coding
);
4498 coding
.src_multibyte
= 0;
4499 coding
.dst_multibyte
4500 = !NILP (current_buffer
->enable_multibyte_characters
);
4504 /* Can't do this if part of the buffer might be preserved. */
4506 && (coding
.type
== coding_type_no_conversion
4507 || coding
.type
== coding_type_raw_text
))
4509 /* Visiting a file with these coding system makes the buffer
4511 current_buffer
->enable_multibyte_characters
= Qnil
;
4512 coding
.dst_multibyte
= 0;
4515 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4517 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4519 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4521 inserted
= coding
.produced_char
;
4524 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4528 /* Now INSERTED is measured in characters. */
4531 /* Use the conversion type to determine buffer-file-type
4532 (find-buffer-file-type is now used to help determine the
4534 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4535 || coding
.eol_type
== CODING_EOL_LF
)
4536 && ! CODING_REQUIRE_DECODING (&coding
))
4537 current_buffer
->buffer_file_type
= Qt
;
4539 current_buffer
->buffer_file_type
= Qnil
;
4546 if (!EQ (current_buffer
->undo_list
, Qt
))
4547 current_buffer
->undo_list
= Qnil
;
4549 stat (SDATA (filename
), &st
);
4554 current_buffer
->modtime
= st
.st_mtime
;
4555 current_buffer
->filename
= orig_filename
;
4558 SAVE_MODIFF
= MODIFF
;
4559 current_buffer
->auto_save_modified
= MODIFF
;
4560 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4561 #ifdef CLASH_DETECTION
4564 if (!NILP (current_buffer
->file_truename
))
4565 unlock_file (current_buffer
->file_truename
);
4566 unlock_file (filename
);
4568 #endif /* CLASH_DETECTION */
4570 Fsignal (Qfile_error
,
4571 Fcons (build_string ("not a regular file"),
4572 Fcons (orig_filename
, Qnil
)));
4575 if (set_coding_system
)
4576 Vlast_coding_system_used
= coding
.symbol
;
4578 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4580 insval
= call1 (Qafter_insert_file_set_coding
, make_number (inserted
));
4581 if (! NILP (insval
))
4583 CHECK_NUMBER (insval
);
4584 inserted
= XFASTINT (insval
);
4588 /* Decode file format */
4591 int empty_undo_list_p
= 0;
4593 /* If we're anyway going to discard undo information, don't
4594 record it in the first place. The buffer's undo list at this
4595 point is either nil or t when visiting a file. */
4598 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4599 current_buffer
->undo_list
= Qt
;
4602 insval
= call3 (Qformat_decode
,
4603 Qnil
, make_number (inserted
), visit
);
4604 CHECK_NUMBER (insval
);
4605 inserted
= XFASTINT (insval
);
4608 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4611 /* Call after-change hooks for the inserted text, aside from the case
4612 of normal visiting (not with REPLACE), which is done in a new buffer
4613 "before" the buffer is changed. */
4614 if (inserted
> 0 && total
> 0
4615 && (NILP (visit
) || !NILP (replace
)))
4617 signal_after_change (PT
, 0, inserted
);
4618 update_compositions (PT
, PT
, CHECK_BORDER
);
4621 p
= Vafter_insert_file_functions
;
4624 insval
= call1 (XCAR (p
), make_number (inserted
));
4627 CHECK_NUMBER (insval
);
4628 inserted
= XFASTINT (insval
);
4635 && current_buffer
->modtime
== -1)
4637 /* If visiting nonexistent file, return nil. */
4638 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4642 Fsignal (Qquit
, Qnil
);
4644 /* ??? Retval needs to be dealt with in all cases consistently. */
4646 val
= Fcons (orig_filename
,
4647 Fcons (make_number (inserted
),
4650 RETURN_UNGCPRO (unbind_to (count
, val
));
4653 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4654 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4655 Lisp_Object
, Lisp_Object
));
4657 /* If build_annotations switched buffers, switch back to BUF.
4658 Kill the temporary buffer that was selected in the meantime.
4660 Since this kill only the last temporary buffer, some buffers remain
4661 not killed if build_annotations switched buffers more than once.
4665 build_annotations_unwind (buf
)
4670 if (XBUFFER (buf
) == current_buffer
)
4672 tembuf
= Fcurrent_buffer ();
4674 Fkill_buffer (tembuf
);
4678 /* Decide the coding-system to encode the data with. */
4681 choose_write_coding_system (start
, end
, filename
,
4682 append
, visit
, lockname
, coding
)
4683 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4684 struct coding_system
*coding
;
4690 /* We use emacs-mule for auto saving... */
4691 setup_coding_system (Qemacs_mule
, coding
);
4692 /* ... but with the special flag to indicate not to strip off
4693 leading code of eight-bit-control chars. */
4695 goto done_setup_coding
;
4697 else if (!NILP (Vcoding_system_for_write
))
4699 val
= Vcoding_system_for_write
;
4700 if (coding_system_require_warning
4701 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4702 /* Confirm that VAL can surely encode the current region. */
4703 val
= call5 (Vselect_safe_coding_system_function
,
4704 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4709 /* If the variable `buffer-file-coding-system' is set locally,
4710 it means that the file was read with some kind of code
4711 conversion or the variable is explicitly set by users. We
4712 had better write it out with the same coding system even if
4713 `enable-multibyte-characters' is nil.
4715 If it is not set locally, we anyway have to convert EOL
4716 format if the default value of `buffer-file-coding-system'
4717 tells that it is not Unix-like (LF only) format. */
4718 int using_default_coding
= 0;
4719 int force_raw_text
= 0;
4721 val
= current_buffer
->buffer_file_coding_system
;
4723 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4726 if (NILP (current_buffer
->enable_multibyte_characters
))
4732 /* Check file-coding-system-alist. */
4733 Lisp_Object args
[7], coding_systems
;
4735 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4736 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4738 coding_systems
= Ffind_operation_coding_system (7, args
);
4739 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4740 val
= XCDR (coding_systems
);
4744 && !NILP (current_buffer
->buffer_file_coding_system
))
4746 /* If we still have not decided a coding system, use the
4747 default value of buffer-file-coding-system. */
4748 val
= current_buffer
->buffer_file_coding_system
;
4749 using_default_coding
= 1;
4753 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4754 /* Confirm that VAL can surely encode the current region. */
4755 val
= call5 (Vselect_safe_coding_system_function
,
4756 start
, end
, val
, Qnil
, filename
);
4758 setup_coding_system (Fcheck_coding_system (val
), coding
);
4759 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4760 && !using_default_coding
)
4762 if (! EQ (default_buffer_file_coding
.symbol
,
4763 buffer_defaults
.buffer_file_coding_system
))
4764 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4765 &default_buffer_file_coding
);
4766 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4768 Lisp_Object subsidiaries
;
4770 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4771 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4772 if (VECTORP (subsidiaries
)
4773 && XVECTOR (subsidiaries
)->size
== 3)
4775 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4780 setup_raw_text_coding_system (coding
);
4781 goto done_setup_coding
;
4784 setup_coding_system (Fcheck_coding_system (val
), coding
);
4787 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4788 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4791 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4792 "r\nFWrite region to file: \ni\ni\ni\np",
4793 doc
: /* Write current region into specified file.
4794 When called from a program, requires three arguments:
4795 START, END and FILENAME. START and END are normally buffer positions
4796 specifying the part of the buffer to write.
4797 If START is nil, that means to use the entire buffer contents.
4798 If START is a string, then output that string to the file
4799 instead of any buffer contents; END is ignored.
4801 Optional fourth argument APPEND if non-nil means
4802 append to existing file contents (if any). If it is an integer,
4803 seek to that offset in the file before writing.
4804 Optional fifth argument VISIT if t means
4805 set the last-save-file-modtime of buffer to this file's modtime
4806 and mark buffer not modified.
4807 If VISIT is a string, it is a second file name;
4808 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4809 VISIT is also the file name to lock and unlock for clash detection.
4810 If VISIT is neither t nor nil nor a string,
4811 that means do not display the \"Wrote file\" message.
4812 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4813 use for locking and unlocking, overriding FILENAME and VISIT.
4814 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4815 for an existing file with the same name. If MUSTBENEW is `excl',
4816 that means to get an error if the file already exists; never overwrite.
4817 If MUSTBENEW is neither nil nor `excl', that means ask for
4818 confirmation before overwriting, but do go ahead and overwrite the file
4819 if the user confirms.
4821 This does code conversion according to the value of
4822 `coding-system-for-write', `buffer-file-coding-system', or
4823 `file-coding-system-alist', and sets the variable
4824 `last-coding-system-used' to the coding system actually used. */)
4825 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4826 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4831 const unsigned char *fn
;
4834 int count
= SPECPDL_INDEX ();
4837 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4839 Lisp_Object handler
;
4840 Lisp_Object visit_file
;
4841 Lisp_Object annotations
;
4842 Lisp_Object encoded_filename
;
4843 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4844 int quietly
= !NILP (visit
);
4845 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4846 struct buffer
*given_buffer
;
4848 int buffer_file_type
= O_BINARY
;
4850 struct coding_system coding
;
4852 if (current_buffer
->base_buffer
&& visiting
)
4853 error ("Cannot do file visiting in an indirect buffer");
4855 if (!NILP (start
) && !STRINGP (start
))
4856 validate_region (&start
, &end
);
4858 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4860 filename
= Fexpand_file_name (filename
, Qnil
);
4862 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4863 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4865 if (STRINGP (visit
))
4866 visit_file
= Fexpand_file_name (visit
, Qnil
);
4868 visit_file
= filename
;
4870 if (NILP (lockname
))
4871 lockname
= visit_file
;
4875 /* If the file name has special constructs in it,
4876 call the corresponding file handler. */
4877 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4878 /* If FILENAME has no handler, see if VISIT has one. */
4879 if (NILP (handler
) && STRINGP (visit
))
4880 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4882 if (!NILP (handler
))
4885 val
= call6 (handler
, Qwrite_region
, start
, end
,
4886 filename
, append
, visit
);
4890 SAVE_MODIFF
= MODIFF
;
4891 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4892 current_buffer
->filename
= visit_file
;
4898 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4900 /* Special kludge to simplify auto-saving. */
4903 XSETFASTINT (start
, BEG
);
4904 XSETFASTINT (end
, Z
);
4908 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4909 count1
= SPECPDL_INDEX ();
4911 given_buffer
= current_buffer
;
4913 if (!STRINGP (start
))
4915 annotations
= build_annotations (start
, end
);
4917 if (current_buffer
!= given_buffer
)
4919 XSETFASTINT (start
, BEGV
);
4920 XSETFASTINT (end
, ZV
);
4926 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4928 /* Decide the coding-system to encode the data with.
4929 We used to make this choice before calling build_annotations, but that
4930 leads to problems when a write-annotate-function takes care of
4931 unsavable chars (as was the case with X-Symbol). */
4932 choose_write_coding_system (start
, end
, filename
,
4933 append
, visit
, lockname
, &coding
);
4934 Vlast_coding_system_used
= coding
.symbol
;
4936 given_buffer
= current_buffer
;
4937 if (! STRINGP (start
))
4939 annotations
= build_annotations_2 (start
, end
,
4940 coding
.pre_write_conversion
, annotations
);
4941 if (current_buffer
!= given_buffer
)
4943 XSETFASTINT (start
, BEGV
);
4944 XSETFASTINT (end
, ZV
);
4948 #ifdef CLASH_DETECTION
4951 #if 0 /* This causes trouble for GNUS. */
4952 /* If we've locked this file for some other buffer,
4953 query before proceeding. */
4954 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4955 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4958 lock_file (lockname
);
4960 #endif /* CLASH_DETECTION */
4962 encoded_filename
= ENCODE_FILE (filename
);
4964 fn
= SDATA (encoded_filename
);
4968 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
4969 #else /* not DOS_NT */
4970 desc
= emacs_open (fn
, O_WRONLY
, 0);
4971 #endif /* not DOS_NT */
4973 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4975 if (auto_saving
) /* Overwrite any previous version of autosave file */
4977 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4978 desc
= emacs_open (fn
, O_RDWR
, 0);
4980 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4981 ? SDATA (current_buffer
->filename
) : 0,
4984 else /* Write to temporary name and rename if no errors */
4986 Lisp_Object temp_name
;
4987 temp_name
= Ffile_name_directory (filename
);
4989 if (!NILP (temp_name
))
4991 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4992 build_string ("$$SAVE$$")));
4993 fname
= SDATA (filename
);
4994 fn
= SDATA (temp_name
);
4995 desc
= creat_copy_attrs (fname
, fn
);
4998 /* If we can't open the temporary file, try creating a new
4999 version of the original file. VMS "creat" creates a
5000 new version rather than truncating an existing file. */
5003 desc
= creat (fn
, 0666);
5004 #if 0 /* This can clobber an existing file and fail to replace it,
5005 if the user runs out of space. */
5008 /* We can't make a new version;
5009 try to truncate and rewrite existing version if any. */
5011 desc
= emacs_open (fn
, O_RDWR
, 0);
5017 desc
= creat (fn
, 0666);
5021 desc
= emacs_open (fn
,
5022 O_WRONLY
| O_CREAT
| buffer_file_type
5023 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5024 S_IREAD
| S_IWRITE
);
5025 #else /* not DOS_NT */
5026 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5027 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5028 auto_saving
? auto_save_mode_bits
: 0666);
5029 #endif /* not DOS_NT */
5030 #endif /* not VMS */
5034 #ifdef CLASH_DETECTION
5036 if (!auto_saving
) unlock_file (lockname
);
5038 #endif /* CLASH_DETECTION */
5040 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5043 record_unwind_protect (close_file_unwind
, make_number (desc
));
5045 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5049 if (NUMBERP (append
))
5050 ret
= lseek (desc
, XINT (append
), 1);
5052 ret
= lseek (desc
, 0, 2);
5055 #ifdef CLASH_DETECTION
5056 if (!auto_saving
) unlock_file (lockname
);
5057 #endif /* CLASH_DETECTION */
5059 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5067 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5068 * if we do writes that don't end with a carriage return. Furthermore
5069 * it cannot handle writes of more then 16K. The modified
5070 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5071 * this EXCEPT for the last record (iff it doesn't end with a carriage
5072 * return). This implies that if your buffer doesn't end with a carriage
5073 * return, you get one free... tough. However it also means that if
5074 * we make two calls to sys_write (a la the following code) you can
5075 * get one at the gap as well. The easiest way to fix this (honest)
5076 * is to move the gap to the next newline (or the end of the buffer).
5081 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5082 move_gap (find_next_newline (GPT
, 1));
5084 /* Whether VMS or not, we must move the gap to the next of newline
5085 when we must put designation sequences at beginning of line. */
5086 if (INTEGERP (start
)
5087 && coding
.type
== coding_type_iso2022
5088 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5089 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5091 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5092 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5093 move_gap_both (PT
, PT_BYTE
);
5094 SET_PT_BOTH (opoint
, opoint_byte
);
5101 if (STRINGP (start
))
5103 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5104 &annotations
, &coding
);
5107 else if (XINT (start
) != XINT (end
))
5109 tem
= CHAR_TO_BYTE (XINT (start
));
5111 if (XINT (start
) < GPT
)
5113 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5114 min (GPT
, XINT (end
)) - XINT (start
),
5115 &annotations
, &coding
);
5119 if (XINT (end
) > GPT
&& !failure
)
5121 tem
= max (XINT (start
), GPT
);
5122 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5123 &annotations
, &coding
);
5129 /* If file was empty, still need to write the annotations */
5130 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5131 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5135 if (CODING_REQUIRE_FLUSHING (&coding
)
5136 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5139 /* We have to flush out a data. */
5140 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5141 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5148 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5149 Disk full in NFS may be reported here. */
5150 /* mib says that closing the file will try to write as fast as NFS can do
5151 it, and that means the fsync here is not crucial for autosave files. */
5152 if (!auto_saving
&& fsync (desc
) < 0)
5154 /* If fsync fails with EINTR, don't treat that as serious. */
5156 failure
= 1, save_errno
= errno
;
5160 /* Spurious "file has changed on disk" warnings have been
5161 observed on Suns as well.
5162 It seems that `close' can change the modtime, under nfs.
5164 (This has supposedly been fixed in Sunos 4,
5165 but who knows about all the other machines with NFS?) */
5168 /* On VMS and APOLLO, must do the stat after the close
5169 since closing changes the modtime. */
5172 /* Recall that #if defined does not work on VMS. */
5179 /* NFS can report a write failure now. */
5180 if (emacs_close (desc
) < 0)
5181 failure
= 1, save_errno
= errno
;
5184 /* If we wrote to a temporary name and had no errors, rename to real name. */
5188 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5196 /* Discard the unwind protect for close_file_unwind. */
5197 specpdl_ptr
= specpdl
+ count1
;
5198 /* Restore the original current buffer. */
5199 visit_file
= unbind_to (count
, visit_file
);
5201 #ifdef CLASH_DETECTION
5203 unlock_file (lockname
);
5204 #endif /* CLASH_DETECTION */
5206 /* Do this before reporting IO error
5207 to avoid a "file has changed on disk" warning on
5208 next attempt to save. */
5210 current_buffer
->modtime
= st
.st_mtime
;
5213 error ("IO error writing %s: %s", SDATA (filename
),
5214 emacs_strerror (save_errno
));
5218 SAVE_MODIFF
= MODIFF
;
5219 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5220 current_buffer
->filename
= visit_file
;
5221 update_mode_lines
++;
5227 message_with_string ((INTEGERP (append
)
5237 Lisp_Object
merge ();
5239 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5240 doc
: /* Return t if (car A) is numerically less than (car B). */)
5244 return Flss (Fcar (a
), Fcar (b
));
5247 /* Build the complete list of annotations appropriate for writing out
5248 the text between START and END, by calling all the functions in
5249 write-region-annotate-functions and merging the lists they return.
5250 If one of these functions switches to a different buffer, we assume
5251 that buffer contains altered text. Therefore, the caller must
5252 make sure to restore the current buffer in all cases,
5253 as save-excursion would do. */
5256 build_annotations (start
, end
)
5257 Lisp_Object start
, end
;
5259 Lisp_Object annotations
;
5261 struct gcpro gcpro1
, gcpro2
;
5262 Lisp_Object original_buffer
;
5263 int i
, used_global
= 0;
5265 XSETBUFFER (original_buffer
, current_buffer
);
5268 p
= Vwrite_region_annotate_functions
;
5269 GCPRO2 (annotations
, p
);
5272 struct buffer
*given_buffer
= current_buffer
;
5273 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5274 { /* Use the global value of the hook. */
5277 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5279 p
= Fappend (2, arg
);
5282 Vwrite_region_annotations_so_far
= annotations
;
5283 res
= call2 (XCAR (p
), start
, end
);
5284 /* If the function makes a different buffer current,
5285 assume that means this buffer contains altered text to be output.
5286 Reset START and END from the buffer bounds
5287 and discard all previous annotations because they should have
5288 been dealt with by this function. */
5289 if (current_buffer
!= given_buffer
)
5291 XSETFASTINT (start
, BEGV
);
5292 XSETFASTINT (end
, ZV
);
5295 Flength (res
); /* Check basic validity of return value */
5296 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5300 /* Now do the same for annotation functions implied by the file-format */
5301 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
5302 p
= Vauto_save_file_format
;
5304 p
= current_buffer
->file_format
;
5305 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5307 struct buffer
*given_buffer
= current_buffer
;
5309 Vwrite_region_annotations_so_far
= annotations
;
5311 /* Value is either a list of annotations or nil if the function
5312 has written annotations to a temporary buffer, which is now
5314 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5315 original_buffer
, make_number (i
));
5316 if (current_buffer
!= given_buffer
)
5318 XSETFASTINT (start
, BEGV
);
5319 XSETFASTINT (end
, ZV
);
5324 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5332 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5333 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5335 struct gcpro gcpro1
;
5338 GCPRO1 (annotations
);
5339 /* At last, do the same for the function PRE_WRITE_CONVERSION
5340 implied by the current coding-system. */
5341 if (!NILP (pre_write_conversion
))
5343 struct buffer
*given_buffer
= current_buffer
;
5344 Vwrite_region_annotations_so_far
= annotations
;
5345 res
= call2 (pre_write_conversion
, start
, end
);
5347 annotations
= (current_buffer
!= given_buffer
5349 : merge (annotations
, res
, Qcar_less_than_car
));
5356 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5357 If STRING is nil, POS is the character position in the current buffer.
5358 Intersperse with them the annotations from *ANNOT
5359 which fall within the range of POS to POS + NCHARS,
5360 each at its appropriate position.
5362 We modify *ANNOT by discarding elements as we use them up.
5364 The return value is negative in case of system call failure. */
5367 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5370 register int nchars
;
5373 struct coding_system
*coding
;
5377 int lastpos
= pos
+ nchars
;
5379 while (NILP (*annot
) || CONSP (*annot
))
5381 tem
= Fcar_safe (Fcar (*annot
));
5384 nextpos
= XFASTINT (tem
);
5386 /* If there are no more annotations in this range,
5387 output the rest of the range all at once. */
5388 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5389 return e_write (desc
, string
, pos
, lastpos
, coding
);
5391 /* Output buffer text up to the next annotation's position. */
5394 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5398 /* Output the annotation. */
5399 tem
= Fcdr (Fcar (*annot
));
5402 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5405 *annot
= Fcdr (*annot
);
5410 #ifndef WRITE_BUF_SIZE
5411 #define WRITE_BUF_SIZE (16 * 1024)
5414 /* Write text in the range START and END into descriptor DESC,
5415 encoding them with coding system CODING. If STRING is nil, START
5416 and END are character positions of the current buffer, else they
5417 are indexes to the string STRING. */
5420 e_write (desc
, string
, start
, end
, coding
)
5424 struct coding_system
*coding
;
5426 register char *addr
;
5427 register int nbytes
;
5428 char buf
[WRITE_BUF_SIZE
];
5432 coding
->composing
= COMPOSITION_DISABLED
;
5433 if (coding
->composing
!= COMPOSITION_DISABLED
)
5434 coding_save_composition (coding
, start
, end
, string
);
5436 if (STRINGP (string
))
5438 addr
= SDATA (string
);
5439 nbytes
= SBYTES (string
);
5440 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5442 else if (start
< end
)
5444 /* It is assured that the gap is not in the range START and END-1. */
5445 addr
= CHAR_POS_ADDR (start
);
5446 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5447 coding
->src_multibyte
5448 = !NILP (current_buffer
->enable_multibyte_characters
);
5454 coding
->src_multibyte
= 1;
5457 /* We used to have a code for handling selective display here. But,
5458 now it is handled within encode_coding. */
5463 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5464 if (coding
->produced
> 0)
5466 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5467 if (coding
->produced
)
5473 nbytes
-= coding
->consumed
;
5474 addr
+= coding
->consumed
;
5475 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5478 /* The source text ends by an incomplete multibyte form.
5479 There's no way other than write it out as is. */
5480 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5489 start
+= coding
->consumed_char
;
5490 if (coding
->cmp_data
)
5491 coding_adjust_composition_offset (coding
, start
);
5494 if (coding
->cmp_data
)
5495 coding_free_composition_data (coding
);
5500 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5501 Sverify_visited_file_modtime
, 1, 1, 0,
5502 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5503 This means that the file has not been changed since it was visited or saved. */)
5509 Lisp_Object handler
;
5510 Lisp_Object filename
;
5515 if (!STRINGP (b
->filename
)) return Qt
;
5516 if (b
->modtime
== 0) return Qt
;
5518 /* If the file name has special constructs in it,
5519 call the corresponding file handler. */
5520 handler
= Ffind_file_name_handler (b
->filename
,
5521 Qverify_visited_file_modtime
);
5522 if (!NILP (handler
))
5523 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5525 filename
= ENCODE_FILE (b
->filename
);
5527 if (stat (SDATA (filename
), &st
) < 0)
5529 /* If the file doesn't exist now and didn't exist before,
5530 we say that it isn't modified, provided the error is a tame one. */
5531 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5536 if (st
.st_mtime
== b
->modtime
5537 /* If both are positive, accept them if they are off by one second. */
5538 || (st
.st_mtime
> 0 && b
->modtime
> 0
5539 && (st
.st_mtime
== b
->modtime
+ 1
5540 || st
.st_mtime
== b
->modtime
- 1)))
5545 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5546 Sclear_visited_file_modtime
, 0, 0, 0,
5547 doc
: /* Clear out records of last mod time of visited file.
5548 Next attempt to save will certainly not complain of a discrepancy. */)
5551 current_buffer
->modtime
= 0;
5555 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5556 Svisited_file_modtime
, 0, 0, 0,
5557 doc
: /* Return the current buffer's recorded visited file modification time.
5558 The value is a list of the form (HIGH . LOW), like the time values
5559 that `file-attributes' returns. */)
5562 return long_to_cons ((unsigned long) current_buffer
->modtime
);
5565 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5566 Sset_visited_file_modtime
, 0, 1, 0,
5567 doc
: /* Update buffer's recorded modification time from the visited file's time.
5568 Useful if the buffer was not read from the file normally
5569 or if the file itself has been changed for some known benign reason.
5570 An argument specifies the modification time value to use
5571 \(instead of that of the visited file), in the form of a list
5572 \(HIGH . LOW) or (HIGH LOW). */)
5574 Lisp_Object time_list
;
5576 if (!NILP (time_list
))
5577 current_buffer
->modtime
= cons_to_long (time_list
);
5580 register Lisp_Object filename
;
5582 Lisp_Object handler
;
5584 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5586 /* If the file name has special constructs in it,
5587 call the corresponding file handler. */
5588 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5589 if (!NILP (handler
))
5590 /* The handler can find the file name the same way we did. */
5591 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5593 filename
= ENCODE_FILE (filename
);
5595 if (stat (SDATA (filename
), &st
) >= 0)
5596 current_buffer
->modtime
= st
.st_mtime
;
5603 auto_save_error (error
)
5606 Lisp_Object args
[3], msg
;
5608 struct gcpro gcpro1
;
5612 args
[0] = build_string ("Auto-saving %s: %s");
5613 args
[1] = current_buffer
->name
;
5614 args
[2] = Ferror_message_string (error
);
5615 msg
= Fformat (3, args
);
5617 nbytes
= SBYTES (msg
);
5619 for (i
= 0; i
< 3; ++i
)
5622 message2 (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5624 message2_nolog (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5625 Fsleep_for (make_number (1), Qnil
);
5637 /* Get visited file's mode to become the auto save file's mode. */
5638 if (! NILP (current_buffer
->filename
)
5639 && stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5640 /* But make sure we can overwrite it later! */
5641 auto_save_mode_bits
= st
.st_mode
| 0600;
5643 auto_save_mode_bits
= 0666;
5646 Fwrite_region (Qnil
, Qnil
,
5647 current_buffer
->auto_save_file_name
,
5648 Qnil
, Qlambda
, Qnil
, Qnil
);
5652 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5657 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5658 | XFASTINT (XCDR (stream
))));
5663 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5666 minibuffer_auto_raise
= XINT (value
);
5671 do_auto_save_make_dir (dir
)
5674 return call2 (Qmake_directory
, dir
, Qt
);
5678 do_auto_save_eh (ignore
)
5684 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5685 doc
: /* Auto-save all buffers that need it.
5686 This is all buffers that have auto-saving enabled
5687 and are changed since last auto-saved.
5688 Auto-saving writes the buffer into a file
5689 so that your editing is not lost if the system crashes.
5690 This file is not the file you visited; that changes only when you save.
5691 Normally we run the normal hook `auto-save-hook' before saving.
5693 A non-nil NO-MESSAGE argument means do not print any message if successful.
5694 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5695 (no_message
, current_only
)
5696 Lisp_Object no_message
, current_only
;
5698 struct buffer
*old
= current_buffer
, *b
;
5699 Lisp_Object tail
, buf
;
5701 int do_handled_files
;
5704 Lisp_Object lispstream
;
5705 int count
= SPECPDL_INDEX ();
5706 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5707 int old_message_p
= 0;
5708 struct gcpro gcpro1
, gcpro2
;
5710 if (max_specpdl_size
< specpdl_size
+ 40)
5711 max_specpdl_size
= specpdl_size
+ 40;
5716 if (NILP (no_message
))
5718 old_message_p
= push_message ();
5719 record_unwind_protect (pop_message_unwind
, Qnil
);
5722 /* Ordinarily don't quit within this function,
5723 but don't make it impossible to quit (in case we get hung in I/O). */
5727 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5728 point to non-strings reached from Vbuffer_alist. */
5730 if (!NILP (Vrun_hooks
))
5731 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5733 if (STRINGP (Vauto_save_list_file_name
))
5735 Lisp_Object listfile
;
5737 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5739 /* Don't try to create the directory when shutting down Emacs,
5740 because creating the directory might signal an error, and
5741 that would leave Emacs in a strange state. */
5742 if (!NILP (Vrun_hooks
))
5746 GCPRO2 (dir
, listfile
);
5747 dir
= Ffile_name_directory (listfile
);
5748 if (NILP (Ffile_directory_p (dir
)))
5749 internal_condition_case_1 (do_auto_save_make_dir
,
5750 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5755 stream
= fopen (SDATA (listfile
), "w");
5758 /* Arrange to close that file whether or not we get an error.
5759 Also reset auto_saving to 0. */
5760 lispstream
= Fcons (Qnil
, Qnil
);
5761 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
5762 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
5773 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5774 record_unwind_protect (do_auto_save_unwind_1
,
5775 make_number (minibuffer_auto_raise
));
5776 minibuffer_auto_raise
= 0;
5779 /* First, save all files which don't have handlers. If Emacs is
5780 crashing, the handlers may tweak what is causing Emacs to crash
5781 in the first place, and it would be a shame if Emacs failed to
5782 autosave perfectly ordinary files because it couldn't handle some
5784 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5785 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5787 buf
= XCDR (XCAR (tail
));
5790 /* Record all the buffers that have auto save mode
5791 in the special file that lists them. For each of these buffers,
5792 Record visited name (if any) and auto save name. */
5793 if (STRINGP (b
->auto_save_file_name
)
5794 && stream
!= NULL
&& do_handled_files
== 0)
5796 if (!NILP (b
->filename
))
5798 fwrite (SDATA (b
->filename
), 1,
5799 SBYTES (b
->filename
), stream
);
5801 putc ('\n', stream
);
5802 fwrite (SDATA (b
->auto_save_file_name
), 1,
5803 SBYTES (b
->auto_save_file_name
), stream
);
5804 putc ('\n', stream
);
5807 if (!NILP (current_only
)
5808 && b
!= current_buffer
)
5811 /* Don't auto-save indirect buffers.
5812 The base buffer takes care of it. */
5816 /* Check for auto save enabled
5817 and file changed since last auto save
5818 and file changed since last real save. */
5819 if (STRINGP (b
->auto_save_file_name
)
5820 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5821 && b
->auto_save_modified
< BUF_MODIFF (b
)
5822 /* -1 means we've turned off autosaving for a while--see below. */
5823 && XINT (b
->save_length
) >= 0
5824 && (do_handled_files
5825 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5828 EMACS_TIME before_time
, after_time
;
5830 EMACS_GET_TIME (before_time
);
5832 /* If we had a failure, don't try again for 20 minutes. */
5833 if (b
->auto_save_failure_time
>= 0
5834 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5837 if ((XFASTINT (b
->save_length
) * 10
5838 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5839 /* A short file is likely to change a large fraction;
5840 spare the user annoying messages. */
5841 && XFASTINT (b
->save_length
) > 5000
5842 /* These messages are frequent and annoying for `*mail*'. */
5843 && !EQ (b
->filename
, Qnil
)
5844 && NILP (no_message
))
5846 /* It has shrunk too much; turn off auto-saving here. */
5847 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5848 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5850 minibuffer_auto_raise
= 0;
5851 /* Turn off auto-saving until there's a real save,
5852 and prevent any more warnings. */
5853 XSETINT (b
->save_length
, -1);
5854 Fsleep_for (make_number (1), Qnil
);
5857 set_buffer_internal (b
);
5858 if (!auto_saved
&& NILP (no_message
))
5859 message1 ("Auto-saving...");
5860 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5862 b
->auto_save_modified
= BUF_MODIFF (b
);
5863 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5864 set_buffer_internal (old
);
5866 EMACS_GET_TIME (after_time
);
5868 /* If auto-save took more than 60 seconds,
5869 assume it was an NFS failure that got a timeout. */
5870 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5871 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5875 /* Prevent another auto save till enough input events come in. */
5876 record_auto_save ();
5878 if (auto_saved
&& NILP (no_message
))
5882 /* If we are going to restore an old message,
5883 give time to read ours. */
5884 sit_for (1, 0, 0, 0, 0);
5888 /* If we displayed a message and then restored a state
5889 with no message, leave a "done" message on the screen. */
5890 message1 ("Auto-saving...done");
5895 /* This restores the message-stack status. */
5896 unbind_to (count
, Qnil
);
5900 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5901 Sset_buffer_auto_saved
, 0, 0, 0,
5902 doc
: /* Mark current buffer as auto-saved with its current text.
5903 No auto-save file will be written until the buffer changes again. */)
5906 current_buffer
->auto_save_modified
= MODIFF
;
5907 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5908 current_buffer
->auto_save_failure_time
= -1;
5912 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5913 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5914 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5917 current_buffer
->auto_save_failure_time
= -1;
5921 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5923 doc
: /* Return t if buffer has been auto-saved since last read in or saved. */)
5926 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5929 /* Reading and completing file names */
5930 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
5932 /* In the string VAL, change each $ to $$ and return the result. */
5935 double_dollars (val
)
5938 register const unsigned char *old
;
5939 register unsigned char *new;
5943 osize
= SBYTES (val
);
5945 /* Count the number of $ characters. */
5946 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
5947 if (*old
++ == '$') count
++;
5951 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
5954 for (n
= osize
; n
> 0; n
--)
5968 read_file_name_cleanup (arg
)
5971 return (current_buffer
->directory
= arg
);
5974 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
5976 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
5977 (string
, dir
, action
)
5978 Lisp_Object string
, dir
, action
;
5979 /* action is nil for complete, t for return list of completions,
5980 lambda for verify final value */
5982 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
5984 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5986 CHECK_STRING (string
);
5993 /* No need to protect ACTION--we only compare it with t and nil. */
5994 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
5996 if (SCHARS (string
) == 0)
5998 if (EQ (action
, Qlambda
))
6006 orig_string
= string
;
6007 string
= Fsubstitute_in_file_name (string
);
6008 changed
= NILP (Fstring_equal (string
, orig_string
));
6009 name
= Ffile_name_nondirectory (string
);
6010 val
= Ffile_name_directory (string
);
6012 realdir
= Fexpand_file_name (val
, realdir
);
6017 specdir
= Ffile_name_directory (string
);
6018 val
= Ffile_name_completion (name
, realdir
);
6023 return double_dollars (string
);
6027 if (!NILP (specdir
))
6028 val
= concat2 (specdir
, val
);
6030 return double_dollars (val
);
6033 #endif /* not VMS */
6037 if (EQ (action
, Qt
))
6039 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6043 if (NILP (Vread_file_name_predicate
)
6044 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6048 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6050 /* Brute-force speed up for directory checking:
6051 Discard strings which don't end in a slash. */
6052 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6054 Lisp_Object tem
= XCAR (all
);
6056 if (STRINGP (tem
) &&
6057 (len
= SCHARS (tem
), len
> 0) &&
6058 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6059 comp
= Fcons (tem
, comp
);
6065 /* Must do it the hard (and slow) way. */
6066 GCPRO3 (all
, comp
, specdir
);
6067 count
= SPECPDL_INDEX ();
6068 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6069 current_buffer
->directory
= realdir
;
6070 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6071 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
6072 comp
= Fcons (XCAR (all
), comp
);
6073 unbind_to (count
, Qnil
);
6076 return Fnreverse (comp
);
6079 /* Only other case actually used is ACTION = lambda */
6081 /* Supposedly this helps commands such as `cd' that read directory names,
6082 but can someone explain how it helps them? -- RMS */
6083 if (SCHARS (name
) == 0)
6086 if (!NILP (Vread_file_name_predicate
))
6087 return call1 (Vread_file_name_predicate
, string
);
6088 return Ffile_exists_p (string
);
6091 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6092 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6093 Value is not expanded---you must call `expand-file-name' yourself.
6094 Default name to DEFAULT-FILENAME if user enters a null string.
6095 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6096 except that if INITIAL is specified, that combined with DIR is used.)
6097 Fourth arg MUSTMATCH non-nil means require existing file's name.
6098 Non-nil and non-t means also require confirmation after completion.
6099 Fifth arg INITIAL specifies text to start with.
6100 If optional sixth arg PREDICATE is non-nil, possible completions and the
6101 resulting file name must satisfy (funcall PREDICATE NAME).
6102 DIR defaults to current buffer's directory default.
6104 If this command was invoked with the mouse, use a file dialog box if
6105 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6106 provides a file dialog box. */)
6107 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6108 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6110 Lisp_Object val
, insdef
, tem
;
6111 struct gcpro gcpro1
, gcpro2
;
6112 register char *homedir
;
6113 Lisp_Object decoded_homedir
;
6114 int replace_in_history
= 0;
6115 int add_to_history
= 0;
6119 dir
= current_buffer
->directory
;
6120 if (NILP (default_filename
))
6121 default_filename
= !NILP (initial
)
6122 ? Fexpand_file_name (initial
, dir
)
6123 : current_buffer
->filename
;
6125 /* If dir starts with user's homedir, change that to ~. */
6126 homedir
= (char *) egetenv ("HOME");
6128 /* homedir can be NULL in temacs, since Vprocess_environment is not
6129 yet set up. We shouldn't crash in that case. */
6132 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6133 CORRECT_DIR_SEPS (homedir
);
6138 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6141 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6142 SBYTES (decoded_homedir
))
6143 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6145 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6146 dir
= concat2 (build_string ("~"), dir
);
6148 /* Likewise for default_filename. */
6150 && STRINGP (default_filename
)
6151 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6152 SBYTES (decoded_homedir
))
6153 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6156 = Fsubstring (default_filename
,
6157 make_number (SCHARS (decoded_homedir
)), Qnil
);
6158 default_filename
= concat2 (build_string ("~"), default_filename
);
6160 if (!NILP (default_filename
))
6162 CHECK_STRING (default_filename
);
6163 default_filename
= double_dollars (default_filename
);
6166 if (insert_default_directory
&& STRINGP (dir
))
6169 if (!NILP (initial
))
6171 Lisp_Object args
[2], pos
;
6175 insdef
= Fconcat (2, args
);
6176 pos
= make_number (SCHARS (double_dollars (dir
)));
6177 insdef
= Fcons (double_dollars (insdef
), pos
);
6180 insdef
= double_dollars (insdef
);
6182 else if (STRINGP (initial
))
6183 insdef
= Fcons (double_dollars (initial
), make_number (0));
6187 if (!NILP (Vread_file_name_function
))
6189 Lisp_Object args
[7];
6191 GCPRO2 (insdef
, default_filename
);
6192 args
[0] = Vread_file_name_function
;
6195 args
[3] = default_filename
;
6196 args
[4] = mustmatch
;
6198 args
[6] = predicate
;
6199 RETURN_UNGCPRO (Ffuncall (7, args
));
6202 count
= SPECPDL_INDEX ();
6204 specbind (intern ("completion-ignore-case"), Qt
);
6207 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6208 specbind (intern ("read-file-name-predicate"),
6209 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6211 GCPRO2 (insdef
, default_filename
);
6213 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
6214 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6219 /* If DIR contains a file name, split it. */
6221 file
= Ffile_name_nondirectory (dir
);
6222 if (SCHARS (file
) && NILP (default_filename
))
6224 default_filename
= file
;
6225 dir
= Ffile_name_directory (dir
);
6227 if (!NILP(default_filename
))
6228 default_filename
= Fexpand_file_name (default_filename
, dir
);
6229 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
);
6234 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6235 dir
, mustmatch
, insdef
,
6236 Qfile_name_history
, default_filename
, Qnil
);
6238 tem
= Fsymbol_value (Qfile_name_history
);
6239 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6240 replace_in_history
= 1;
6242 /* If Fcompleting_read returned the inserted default string itself
6243 (rather than a new string with the same contents),
6244 it has to mean that the user typed RET with the minibuffer empty.
6245 In that case, we really want to return ""
6246 so that commands such as set-visited-file-name can distinguish. */
6247 if (EQ (val
, default_filename
))
6249 /* In this case, Fcompleting_read has not added an element
6250 to the history. Maybe we should. */
6251 if (! replace_in_history
)
6257 unbind_to (count
, Qnil
);
6260 error ("No file name specified");
6262 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6264 if (!NILP (tem
) && !NILP (default_filename
))
6265 val
= default_filename
;
6266 else if (SCHARS (val
) == 0 && NILP (insdef
))
6268 if (!NILP (default_filename
))
6269 val
= default_filename
;
6271 error ("No default file name");
6273 val
= Fsubstitute_in_file_name (val
);
6275 if (replace_in_history
)
6276 /* Replace what Fcompleting_read added to the history
6277 with what we will actually return. */
6278 XSETCAR (Fsymbol_value (Qfile_name_history
), double_dollars (val
));
6279 else if (add_to_history
)
6281 /* Add the value to the history--but not if it matches
6282 the last value already there. */
6283 Lisp_Object val1
= double_dollars (val
);
6284 tem
= Fsymbol_value (Qfile_name_history
);
6285 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6286 Fset (Qfile_name_history
,
6297 /* Must be set before any path manipulation is performed. */
6298 XSETFASTINT (Vdirectory_sep_char
, '/');
6305 Qexpand_file_name
= intern ("expand-file-name");
6306 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6307 Qdirectory_file_name
= intern ("directory-file-name");
6308 Qfile_name_directory
= intern ("file-name-directory");
6309 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6310 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6311 Qfile_name_as_directory
= intern ("file-name-as-directory");
6312 Qcopy_file
= intern ("copy-file");
6313 Qmake_directory_internal
= intern ("make-directory-internal");
6314 Qmake_directory
= intern ("make-directory");
6315 Qdelete_directory
= intern ("delete-directory");
6316 Qdelete_file
= intern ("delete-file");
6317 Qrename_file
= intern ("rename-file");
6318 Qadd_name_to_file
= intern ("add-name-to-file");
6319 Qmake_symbolic_link
= intern ("make-symbolic-link");
6320 Qfile_exists_p
= intern ("file-exists-p");
6321 Qfile_executable_p
= intern ("file-executable-p");
6322 Qfile_readable_p
= intern ("file-readable-p");
6323 Qfile_writable_p
= intern ("file-writable-p");
6324 Qfile_symlink_p
= intern ("file-symlink-p");
6325 Qaccess_file
= intern ("access-file");
6326 Qfile_directory_p
= intern ("file-directory-p");
6327 Qfile_regular_p
= intern ("file-regular-p");
6328 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6329 Qfile_modes
= intern ("file-modes");
6330 Qset_file_modes
= intern ("set-file-modes");
6331 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6332 Qinsert_file_contents
= intern ("insert-file-contents");
6333 Qwrite_region
= intern ("write-region");
6334 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6335 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6336 Qauto_save_coding
= intern ("auto-save-coding");
6338 staticpro (&Qexpand_file_name
);
6339 staticpro (&Qsubstitute_in_file_name
);
6340 staticpro (&Qdirectory_file_name
);
6341 staticpro (&Qfile_name_directory
);
6342 staticpro (&Qfile_name_nondirectory
);
6343 staticpro (&Qunhandled_file_name_directory
);
6344 staticpro (&Qfile_name_as_directory
);
6345 staticpro (&Qcopy_file
);
6346 staticpro (&Qmake_directory_internal
);
6347 staticpro (&Qmake_directory
);
6348 staticpro (&Qdelete_directory
);
6349 staticpro (&Qdelete_file
);
6350 staticpro (&Qrename_file
);
6351 staticpro (&Qadd_name_to_file
);
6352 staticpro (&Qmake_symbolic_link
);
6353 staticpro (&Qfile_exists_p
);
6354 staticpro (&Qfile_executable_p
);
6355 staticpro (&Qfile_readable_p
);
6356 staticpro (&Qfile_writable_p
);
6357 staticpro (&Qaccess_file
);
6358 staticpro (&Qfile_symlink_p
);
6359 staticpro (&Qfile_directory_p
);
6360 staticpro (&Qfile_regular_p
);
6361 staticpro (&Qfile_accessible_directory_p
);
6362 staticpro (&Qfile_modes
);
6363 staticpro (&Qset_file_modes
);
6364 staticpro (&Qfile_newer_than_file_p
);
6365 staticpro (&Qinsert_file_contents
);
6366 staticpro (&Qwrite_region
);
6367 staticpro (&Qverify_visited_file_modtime
);
6368 staticpro (&Qset_visited_file_modtime
);
6369 staticpro (&Qauto_save_coding
);
6371 Qfile_name_history
= intern ("file-name-history");
6372 Fset (Qfile_name_history
, Qnil
);
6373 staticpro (&Qfile_name_history
);
6375 Qfile_error
= intern ("file-error");
6376 staticpro (&Qfile_error
);
6377 Qfile_already_exists
= intern ("file-already-exists");
6378 staticpro (&Qfile_already_exists
);
6379 Qfile_date_error
= intern ("file-date-error");
6380 staticpro (&Qfile_date_error
);
6381 Qexcl
= intern ("excl");
6385 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6386 staticpro (&Qfind_buffer_file_type
);
6389 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6390 doc
: /* *Coding system for encoding file names.
6391 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6392 Vfile_name_coding_system
= Qnil
;
6394 DEFVAR_LISP ("default-file-name-coding-system",
6395 &Vdefault_file_name_coding_system
,
6396 doc
: /* Default coding system for encoding file names.
6397 This variable is used only when `file-name-coding-system' is nil.
6399 This variable is set/changed by the command `set-language-environment'.
6400 User should not set this variable manually,
6401 instead use `file-name-coding-system' to get a constant encoding
6402 of file names regardless of the current language environment. */);
6403 Vdefault_file_name_coding_system
= Qnil
;
6405 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
6406 doc
: /* *Format in which to write auto-save files.
6407 Should be a list of symbols naming formats that are defined in `format-alist'.
6408 If it is t, which is the default, auto-save files are written in the
6409 same format as a regular save would use. */);
6410 Vauto_save_file_format
= Qt
;
6412 Qformat_decode
= intern ("format-decode");
6413 staticpro (&Qformat_decode
);
6414 Qformat_annotate_function
= intern ("format-annotate-function");
6415 staticpro (&Qformat_annotate_function
);
6416 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6417 staticpro (&Qafter_insert_file_set_coding
);
6419 Qcar_less_than_car
= intern ("car-less-than-car");
6420 staticpro (&Qcar_less_than_car
);
6422 Fput (Qfile_error
, Qerror_conditions
,
6423 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6424 Fput (Qfile_error
, Qerror_message
,
6425 build_string ("File error"));
6427 Fput (Qfile_already_exists
, Qerror_conditions
,
6428 Fcons (Qfile_already_exists
,
6429 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6430 Fput (Qfile_already_exists
, Qerror_message
,
6431 build_string ("File already exists"));
6433 Fput (Qfile_date_error
, Qerror_conditions
,
6434 Fcons (Qfile_date_error
,
6435 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6436 Fput (Qfile_date_error
, Qerror_message
,
6437 build_string ("Cannot set file date"));
6439 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6440 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6441 Vread_file_name_function
= Qnil
;
6443 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6444 doc
: /* Current predicate used by `read-file-name-internal'. */);
6445 Vread_file_name_predicate
= Qnil
;
6447 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6448 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer. */);
6449 insert_default_directory
= 1;
6451 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6452 doc
: /* *Non-nil means write new files with record format `stmlf'.
6453 nil means use format `var'. This variable is meaningful only on VMS. */);
6454 vms_stmlf_recfm
= 0;
6456 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6457 doc
: /* Directory separator character for built-in functions that return file names.
6458 The value is always ?/. Don't use this variable, just use `/'. */);
6460 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6461 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6462 If a file name matches REGEXP, then all I/O on that file is done by calling
6465 The first argument given to HANDLER is the name of the I/O primitive
6466 to be handled; the remaining arguments are the arguments that were
6467 passed to that primitive. For example, if you do
6468 (file-exists-p FILENAME)
6469 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6470 (funcall HANDLER 'file-exists-p FILENAME)
6471 The function `find-file-name-handler' checks this list for a handler
6472 for its argument. */);
6473 Vfile_name_handler_alist
= Qnil
;
6475 DEFVAR_LISP ("set-auto-coding-function",
6476 &Vset_auto_coding_function
,
6477 doc
: /* If non-nil, a function to call to decide a coding system of file.
6478 Two arguments are passed to this function: the file name
6479 and the length of a file contents following the point.
6480 This function should return a coding system to decode the file contents.
6481 It should check the file name against `auto-coding-alist'.
6482 If no coding system is decided, it should check a coding system
6483 specified in the heading lines with the format:
6484 -*- ... coding: CODING-SYSTEM; ... -*-
6485 or local variable spec of the tailing lines with `coding:' tag. */);
6486 Vset_auto_coding_function
= Qnil
;
6488 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6489 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6490 Each is passed one argument, the number of characters inserted.
6491 It should return the new character count, and leave point the same.
6492 If `insert-file-contents' is intercepted by a handler from
6493 `file-name-handler-alist', that handler is responsible for calling the
6494 functions in `after-insert-file-functions' if appropriate. */);
6495 Vafter_insert_file_functions
= Qnil
;
6497 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6498 doc
: /* A list of functions to be called at the start of `write-region'.
6499 Each is passed two arguments, START and END as for `write-region'.
6500 These are usually two numbers but not always; see the documentation
6501 for `write-region'. The function should return a list of pairs
6502 of the form (POSITION . STRING), consisting of strings to be effectively
6503 inserted at the specified positions of the file being written (1 means to
6504 insert before the first byte written). The POSITIONs must be sorted into
6505 increasing order. If there are several functions in the list, the several
6506 lists are merged destructively. Alternatively, the function can return
6507 with a different buffer current; in that case it should pay attention
6508 to the annotations returned by previous functions and listed in
6509 `write-region-annotations-so-far'.*/);
6510 Vwrite_region_annotate_functions
= Qnil
;
6511 staticpro (&Qwrite_region_annotate_functions
);
6512 Qwrite_region_annotate_functions
6513 = intern ("write-region-annotate-functions");
6515 DEFVAR_LISP ("write-region-annotations-so-far",
6516 &Vwrite_region_annotations_so_far
,
6517 doc
: /* When an annotation function is called, this holds the previous annotations.
6518 These are the annotations made by other annotation functions
6519 that were already called. See also `write-region-annotate-functions'. */);
6520 Vwrite_region_annotations_so_far
= Qnil
;
6522 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6523 doc
: /* A list of file name handlers that temporarily should not be used.
6524 This applies only to the operation `inhibit-file-name-operation'. */);
6525 Vinhibit_file_name_handlers
= Qnil
;
6527 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6528 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6529 Vinhibit_file_name_operation
= Qnil
;
6531 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6532 doc
: /* File name in which we write a list of all auto save file names.
6533 This variable is initialized automatically from `auto-save-list-file-prefix'
6534 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6535 a non-nil value. */);
6536 Vauto_save_list_file_name
= Qnil
;
6538 defsubr (&Sfind_file_name_handler
);
6539 defsubr (&Sfile_name_directory
);
6540 defsubr (&Sfile_name_nondirectory
);
6541 defsubr (&Sunhandled_file_name_directory
);
6542 defsubr (&Sfile_name_as_directory
);
6543 defsubr (&Sdirectory_file_name
);
6544 defsubr (&Smake_temp_name
);
6545 defsubr (&Sexpand_file_name
);
6546 defsubr (&Ssubstitute_in_file_name
);
6547 defsubr (&Scopy_file
);
6548 defsubr (&Smake_directory_internal
);
6549 defsubr (&Sdelete_directory
);
6550 defsubr (&Sdelete_file
);
6551 defsubr (&Srename_file
);
6552 defsubr (&Sadd_name_to_file
);
6554 defsubr (&Smake_symbolic_link
);
6555 #endif /* S_IFLNK */
6557 defsubr (&Sdefine_logical_name
);
6560 defsubr (&Ssysnetunam
);
6561 #endif /* HPUX_NET */
6562 defsubr (&Sfile_name_absolute_p
);
6563 defsubr (&Sfile_exists_p
);
6564 defsubr (&Sfile_executable_p
);
6565 defsubr (&Sfile_readable_p
);
6566 defsubr (&Sfile_writable_p
);
6567 defsubr (&Saccess_file
);
6568 defsubr (&Sfile_symlink_p
);
6569 defsubr (&Sfile_directory_p
);
6570 defsubr (&Sfile_accessible_directory_p
);
6571 defsubr (&Sfile_regular_p
);
6572 defsubr (&Sfile_modes
);
6573 defsubr (&Sset_file_modes
);
6574 defsubr (&Sset_default_file_modes
);
6575 defsubr (&Sdefault_file_modes
);
6576 defsubr (&Sfile_newer_than_file_p
);
6577 defsubr (&Sinsert_file_contents
);
6578 defsubr (&Swrite_region
);
6579 defsubr (&Scar_less_than_car
);
6580 defsubr (&Sverify_visited_file_modtime
);
6581 defsubr (&Sclear_visited_file_modtime
);
6582 defsubr (&Svisited_file_modtime
);
6583 defsubr (&Sset_visited_file_modtime
);
6584 defsubr (&Sdo_auto_save
);
6585 defsubr (&Sset_buffer_auto_saved
);
6586 defsubr (&Sclear_buffer_auto_save_failure
);
6587 defsubr (&Srecent_auto_save_p
);
6589 defsubr (&Sread_file_name_internal
);
6590 defsubr (&Sread_file_name
);
6593 defsubr (&Sunix_sync
);
6597 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6598 (do not change this comment) */