1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996,
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 2, or (at your option)
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
30 #include <sys/types.h>
37 #if !defined (S_ISLNK) && defined (S_IFLNK)
38 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
41 #if !defined (S_ISFIFO) && defined (S_IFIFO)
42 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
45 #if !defined (S_ISREG) && defined (S_IFREG)
46 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
75 #include "intervals.h"
77 #include "character.h"
86 #endif /* not WINDOWSNT */
90 #include <sys/param.h>
98 #define CORRECT_DIR_SEPS(s) \
99 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
100 else unixtodos_filename (s); \
102 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
103 redirector allows the six letters between 'Z' and 'a' as well. */
105 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
108 #define IS_DRIVE(x) isalpha (x)
110 /* Need to lower-case the drive letter, or else expanded
111 filenames will sometimes compare inequal, because
112 `expand-file-name' doesn't always down-case the drive letter. */
113 #define DRIVE_LETTER(x) (tolower (x))
134 #include "commands.h"
135 extern int use_dialog_box
;
136 extern int use_file_dialog
;
150 #ifndef FILE_SYSTEM_CASE
151 #define FILE_SYSTEM_CASE(filename) (filename)
154 /* Nonzero during writing of auto-save files */
157 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
158 a new file with the same mode as the original */
159 int auto_save_mode_bits
;
161 /* The symbol bound to coding-system-for-read when
162 insert-file-contents is called for recovering a file. This is not
163 an actual coding system name, but just an indicator to tell
164 insert-file-contents to use `emacs-mule' with a special flag for
165 auto saving and recovering a file. */
166 Lisp_Object Qauto_save_coding
;
168 /* Coding system for file names, or nil if none. */
169 Lisp_Object Vfile_name_coding_system
;
171 /* Coding system for file names used only when
172 Vfile_name_coding_system is nil. */
173 Lisp_Object Vdefault_file_name_coding_system
;
175 /* Alist of elements (REGEXP . HANDLER) for file names
176 whose I/O is done with a special handler. */
177 Lisp_Object Vfile_name_handler_alist
;
179 /* Property name of a file name handler,
180 which gives a list of operations it handles.. */
181 Lisp_Object Qoperations
;
183 /* Lisp functions for translating file formats */
184 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
186 /* Function to be called to decide a coding system of a reading file. */
187 Lisp_Object Vset_auto_coding_function
;
189 /* Functions to be called to process text properties in inserted file. */
190 Lisp_Object Vafter_insert_file_functions
;
192 /* Lisp function for setting buffer-file-coding-system and the
193 multibyteness of the current buffer after inserting a file. */
194 Lisp_Object Qafter_insert_file_set_coding
;
196 /* Functions to be called to create text property annotations for file. */
197 Lisp_Object Vwrite_region_annotate_functions
;
198 Lisp_Object Qwrite_region_annotate_functions
;
200 /* During build_annotations, each time an annotation function is called,
201 this holds the annotations made by the previous functions. */
202 Lisp_Object Vwrite_region_annotations_so_far
;
204 /* File name in which we write a list of all our auto save files. */
205 Lisp_Object Vauto_save_list_file_name
;
207 /* Function to call to read a file name. */
208 Lisp_Object Vread_file_name_function
;
210 /* Current predicate used by read_file_name_internal. */
211 Lisp_Object Vread_file_name_predicate
;
213 /* Nonzero means completion ignores case when reading file name. */
214 int read_file_name_completion_ignore_case
;
216 /* Nonzero means, when reading a filename in the minibuffer,
217 start out by inserting the default directory into the minibuffer. */
218 int insert_default_directory
;
220 /* On VMS, nonzero means write new files with record format stmlf.
221 Zero means use var format. */
224 /* On NT, specifies the directory separator character, used (eg.) when
225 expanding file names. This can be bound to / or \. */
226 Lisp_Object Vdirectory_sep_char
;
229 /* Nonzero means skip the call to fsync in Fwrite-region. */
230 int write_region_inhibit_fsync
;
233 extern Lisp_Object Vuser_login_name
;
236 extern Lisp_Object Vw32_get_true_file_attributes
;
239 extern int minibuf_level
;
241 extern int minibuffer_auto_raise
;
243 extern int history_delete_duplicates
;
245 /* These variables describe handlers that have "already" had a chance
246 to handle the current operation.
248 Vinhibit_file_name_handlers is a list of file name handlers.
249 Vinhibit_file_name_operation is the operation being handled.
250 If we try to handle that operation, we ignore those handlers. */
252 static Lisp_Object Vinhibit_file_name_handlers
;
253 static Lisp_Object Vinhibit_file_name_operation
;
255 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
257 Lisp_Object Qfile_name_history
;
259 Lisp_Object Qcar_less_than_car
;
261 static int a_write
P_ ((int, Lisp_Object
, int, int,
262 Lisp_Object
*, struct coding_system
*));
263 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
267 report_file_error (string
, data
)
271 Lisp_Object errstring
;
275 synchronize_system_messages_locale ();
276 str
= strerror (errorno
);
277 errstring
= code_convert_string_norecord (make_unibyte_string (str
,
279 Vlocale_coding_system
, 0);
285 Fsignal (Qfile_already_exists
, Fcons (errstring
, data
));
288 /* System error messages are capitalized. Downcase the initial
289 unless it is followed by a slash. */
290 if (SREF (errstring
, 1) != '/')
291 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
293 Fsignal (Qfile_error
,
294 Fcons (build_string (string
), Fcons (errstring
, data
)));
299 close_file_unwind (fd
)
302 emacs_close (XFASTINT (fd
));
306 /* Restore point, having saved it as a marker. */
309 restore_point_unwind (location
)
310 Lisp_Object location
;
312 Fgoto_char (location
);
313 Fset_marker (location
, Qnil
, Qnil
);
318 Lisp_Object Qexpand_file_name
;
319 Lisp_Object Qsubstitute_in_file_name
;
320 Lisp_Object Qdirectory_file_name
;
321 Lisp_Object Qfile_name_directory
;
322 Lisp_Object Qfile_name_nondirectory
;
323 Lisp_Object Qunhandled_file_name_directory
;
324 Lisp_Object Qfile_name_as_directory
;
325 Lisp_Object Qcopy_file
;
326 Lisp_Object Qmake_directory_internal
;
327 Lisp_Object Qmake_directory
;
328 Lisp_Object Qdelete_directory
;
329 Lisp_Object Qdelete_file
;
330 Lisp_Object Qrename_file
;
331 Lisp_Object Qadd_name_to_file
;
332 Lisp_Object Qmake_symbolic_link
;
333 Lisp_Object Qfile_exists_p
;
334 Lisp_Object Qfile_executable_p
;
335 Lisp_Object Qfile_readable_p
;
336 Lisp_Object Qfile_writable_p
;
337 Lisp_Object Qfile_symlink_p
;
338 Lisp_Object Qaccess_file
;
339 Lisp_Object Qfile_directory_p
;
340 Lisp_Object Qfile_regular_p
;
341 Lisp_Object Qfile_accessible_directory_p
;
342 Lisp_Object Qfile_modes
;
343 Lisp_Object Qset_file_modes
;
344 Lisp_Object Qset_file_times
;
345 Lisp_Object Qfile_newer_than_file_p
;
346 Lisp_Object Qinsert_file_contents
;
347 Lisp_Object Qwrite_region
;
348 Lisp_Object Qverify_visited_file_modtime
;
349 Lisp_Object Qset_visited_file_modtime
;
351 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
352 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
353 Otherwise, return nil.
354 A file name is handled if one of the regular expressions in
355 `file-name-handler-alist' matches it.
357 If OPERATION equals `inhibit-file-name-operation', then we ignore
358 any handlers that are members of `inhibit-file-name-handlers',
359 but we still do run any other handlers. This lets handlers
360 use the standard functions without calling themselves recursively. */)
361 (filename
, operation
)
362 Lisp_Object filename
, operation
;
364 /* This function must not munge the match data. */
365 Lisp_Object chain
, inhibited_handlers
, result
;
369 CHECK_STRING (filename
);
371 if (EQ (operation
, Vinhibit_file_name_operation
))
372 inhibited_handlers
= Vinhibit_file_name_handlers
;
374 inhibited_handlers
= Qnil
;
376 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
377 chain
= XCDR (chain
))
383 Lisp_Object string
= XCAR (elt
);
385 Lisp_Object handler
= XCDR (elt
);
386 Lisp_Object operations
= Qnil
;
388 if (SYMBOLP (handler
))
389 operations
= Fget (handler
, Qoperations
);
392 && (match_pos
= fast_string_match (string
, filename
)) > pos
393 && (NILP (operations
) || ! NILP (Fmemq (operation
, operations
))))
397 handler
= XCDR (elt
);
398 tem
= Fmemq (handler
, inhibited_handlers
);
412 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
414 doc
: /* Return the directory component in file name FILENAME.
415 Return nil if FILENAME does not include a directory.
416 Otherwise return a directory spec.
417 Given a Unix syntax file name, returns a string ending in slash;
418 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
420 Lisp_Object filename
;
423 register const unsigned char *beg
;
425 register unsigned char *beg
;
427 register const unsigned char *p
;
430 CHECK_STRING (filename
);
432 /* If the file name has special constructs in it,
433 call the corresponding file handler. */
434 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
436 return call2 (handler
, Qfile_name_directory
, filename
);
438 filename
= FILE_SYSTEM_CASE (filename
);
439 beg
= SDATA (filename
);
441 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
443 p
= beg
+ SBYTES (filename
);
445 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
447 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
450 /* only recognise drive specifier at the beginning */
452 /* handle the "/:d:foo" and "/:foo" cases correctly */
453 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
454 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
461 /* Expansion of "c:" to drive and default directory. */
464 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
465 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
466 unsigned char *r
= res
;
468 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
470 strncpy (res
, beg
, 2);
475 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
477 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
480 p
= beg
+ strlen (beg
);
483 CORRECT_DIR_SEPS (beg
);
486 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
489 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
490 Sfile_name_nondirectory
, 1, 1, 0,
491 doc
: /* Return file name FILENAME sans its directory.
492 For example, in a Unix-syntax file name,
493 this is everything after the last slash,
494 or the entire name if it contains no slash. */)
496 Lisp_Object filename
;
498 register const unsigned char *beg
, *p
, *end
;
501 CHECK_STRING (filename
);
503 /* If the file name has special constructs in it,
504 call the corresponding file handler. */
505 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
507 return call2 (handler
, Qfile_name_nondirectory
, filename
);
509 beg
= SDATA (filename
);
510 end
= p
= beg
+ SBYTES (filename
);
512 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
514 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
517 /* only recognise drive specifier at beginning */
519 /* handle the "/:d:foo" case correctly */
520 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
525 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
528 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
529 Sunhandled_file_name_directory
, 1, 1, 0,
530 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
531 A `directly usable' directory name is one that may be used without the
532 intervention of any file handler.
533 If FILENAME is a directly usable file itself, return
534 \(file-name-directory FILENAME).
535 The `call-process' and `start-process' functions use this function to
536 get a current directory to run processes in. */)
538 Lisp_Object filename
;
542 /* If the file name has special constructs in it,
543 call the corresponding file handler. */
544 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
546 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
548 return Ffile_name_directory (filename
);
553 file_name_as_directory (out
, in
)
556 int size
= strlen (in
) - 1;
569 /* Is it already a directory string? */
570 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
572 /* Is it a VMS directory file name? If so, hack VMS syntax. */
573 else if (! index (in
, '/')
574 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
575 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
576 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
577 || ! strncmp (&in
[size
- 5], ".dir", 4))
578 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
579 && in
[size
] == '1')))
581 register char *p
, *dot
;
585 dir:x.dir --> dir:[x]
586 dir:[x]y.dir --> dir:[x.y] */
588 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
591 strncpy (out
, in
, p
- in
);
610 dot
= index (p
, '.');
613 /* blindly remove any extension */
614 size
= strlen (out
) + (dot
- p
);
615 strncat (out
, p
, dot
- p
);
626 /* For Unix syntax, Append a slash if necessary */
627 if (!IS_DIRECTORY_SEP (out
[size
]))
629 /* Cannot use DIRECTORY_SEP, which could have any value */
631 out
[size
+ 2] = '\0';
634 CORRECT_DIR_SEPS (out
);
640 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
641 Sfile_name_as_directory
, 1, 1, 0,
642 doc
: /* Return a string representing the file name FILE interpreted as a directory.
643 This operation exists because a directory is also a file, but its name as
644 a directory is different from its name as a file.
645 The result can be used as the value of `default-directory'
646 or passed as second argument to `expand-file-name'.
647 For a Unix-syntax file name, just appends a slash.
648 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
659 /* If the file name has special constructs in it,
660 call the corresponding file handler. */
661 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
663 return call2 (handler
, Qfile_name_as_directory
, file
);
665 buf
= (char *) alloca (SBYTES (file
) + 10);
666 file_name_as_directory (buf
, SDATA (file
));
667 return make_specified_string (buf
, -1, strlen (buf
),
668 STRING_MULTIBYTE (file
));
672 * Convert from directory name to filename.
674 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
675 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
676 * On UNIX, it's simple: just make sure there isn't a terminating /
678 * Value is nonzero if the string output is different from the input.
682 directory_file_name (src
, dst
)
690 struct FAB fab
= cc$rms_fab
;
691 struct NAM nam
= cc$rms_nam
;
692 char esa
[NAM$C_MAXRSS
];
697 if (! index (src
, '/')
698 && (src
[slen
- 1] == ']'
699 || src
[slen
- 1] == ':'
700 || src
[slen
- 1] == '>'))
702 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
704 fab
.fab$b_fns
= slen
;
705 fab
.fab$l_nam
= &nam
;
706 fab
.fab$l_fop
= FAB$M_NAM
;
709 nam
.nam$b_ess
= sizeof esa
;
710 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
712 /* We call SYS$PARSE to handle such things as [--] for us. */
713 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
715 slen
= nam
.nam$b_esl
;
716 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
721 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
723 /* what about when we have logical_name:???? */
724 if (src
[slen
- 1] == ':')
725 { /* Xlate logical name and see what we get */
726 ptr
= strcpy (dst
, src
); /* upper case for getenv */
729 if ('a' <= *ptr
&& *ptr
<= 'z')
733 dst
[slen
- 1] = 0; /* remove colon */
734 if (!(src
= egetenv (dst
)))
736 /* should we jump to the beginning of this procedure?
737 Good points: allows us to use logical names that xlate
739 Bad points: can be a problem if we just translated to a device
741 For now, I'll punt and always expect VMS names, and hope for
744 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
745 { /* no recursion here! */
751 { /* not a directory spec */
756 bracket
= src
[slen
- 1];
758 /* If bracket is ']' or '>', bracket - 2 is the corresponding
760 ptr
= index (src
, bracket
- 2);
762 { /* no opening bracket */
766 if (!(rptr
= rindex (src
, '.')))
769 strncpy (dst
, src
, slen
);
773 dst
[slen
++] = bracket
;
778 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
779 then translate the device and recurse. */
780 if (dst
[slen
- 1] == ':'
781 && dst
[slen
- 2] != ':' /* skip decnet nodes */
782 && strcmp (src
+ slen
, "[000000]") == 0)
784 dst
[slen
- 1] = '\0';
785 if ((ptr
= egetenv (dst
))
786 && (rlen
= strlen (ptr
) - 1) > 0
787 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
788 && ptr
[rlen
- 1] == '.')
790 char * buf
= (char *) alloca (strlen (ptr
) + 1);
794 return directory_file_name (buf
, dst
);
799 strcat (dst
, "[000000]");
803 rlen
= strlen (rptr
) - 1;
804 strncat (dst
, rptr
, rlen
);
805 dst
[slen
+ rlen
] = '\0';
806 strcat (dst
, ".DIR.1");
810 /* Process as Unix format: just remove any final slash.
811 But leave "/" unchanged; do not change it to "". */
814 /* Handle // as root for apollo's. */
815 if ((slen
> 2 && dst
[slen
- 1] == '/')
816 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
820 && IS_DIRECTORY_SEP (dst
[slen
- 1])
822 && !IS_ANY_SEP (dst
[slen
- 2])
828 CORRECT_DIR_SEPS (dst
);
833 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
835 doc
: /* Returns the file name of the directory named DIRECTORY.
836 This is the name of the file that holds the data for the directory DIRECTORY.
837 This operation exists because a directory is also a file, but its name as
838 a directory is different from its name as a file.
839 In Unix-syntax, this function just removes the final slash.
840 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
841 it returns a file name such as \"[X]Y.DIR.1\". */)
843 Lisp_Object directory
;
848 CHECK_STRING (directory
);
850 if (NILP (directory
))
853 /* If the file name has special constructs in it,
854 call the corresponding file handler. */
855 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
857 return call2 (handler
, Qdirectory_file_name
, directory
);
860 /* 20 extra chars is insufficient for VMS, since we might perform a
861 logical name translation. an equivalence string can be up to 255
862 chars long, so grab that much extra space... - sss */
863 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
865 buf
= (char *) alloca (SBYTES (directory
) + 20);
867 directory_file_name (SDATA (directory
), buf
);
868 return make_specified_string (buf
, -1, strlen (buf
),
869 STRING_MULTIBYTE (directory
));
872 static char make_temp_name_tbl
[64] =
874 'A','B','C','D','E','F','G','H',
875 'I','J','K','L','M','N','O','P',
876 'Q','R','S','T','U','V','W','X',
877 'Y','Z','a','b','c','d','e','f',
878 'g','h','i','j','k','l','m','n',
879 'o','p','q','r','s','t','u','v',
880 'w','x','y','z','0','1','2','3',
881 '4','5','6','7','8','9','-','_'
884 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
886 /* Value is a temporary file name starting with PREFIX, a string.
888 The Emacs process number forms part of the result, so there is
889 no danger of generating a name being used by another process.
890 In addition, this function makes an attempt to choose a name
891 which has no existing file. To make this work, PREFIX should be
892 an absolute file name.
894 BASE64_P non-zero means add the pid as 3 characters in base64
895 encoding. In this case, 6 characters will be added to PREFIX to
896 form the file name. Otherwise, if Emacs is running on a system
897 with long file names, add the pid as a decimal number.
899 This function signals an error if no unique file name could be
903 make_temp_name (prefix
, base64_p
)
910 unsigned char *p
, *data
;
914 CHECK_STRING (prefix
);
916 /* VAL is created by adding 6 characters to PREFIX. The first
917 three are the PID of this process, in base 64, and the second
918 three are incremented if the file already exists. This ensures
919 262144 unique file names per PID per PREFIX. */
921 pid
= (int) getpid ();
925 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
926 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
927 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
932 #ifdef HAVE_LONG_FILE_NAMES
933 sprintf (pidbuf
, "%d", pid
);
934 pidlen
= strlen (pidbuf
);
936 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
937 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
938 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
943 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
944 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
945 if (!STRING_MULTIBYTE (prefix
))
946 STRING_SET_UNIBYTE (val
);
948 bcopy(SDATA (prefix
), data
, len
);
951 bcopy (pidbuf
, p
, pidlen
);
954 /* Here we try to minimize useless stat'ing when this function is
955 invoked many times successively with the same PREFIX. We achieve
956 this by initializing count to a random value, and incrementing it
959 We don't want make-temp-name to be called while dumping,
960 because then make_temp_name_count_initialized_p would get set
961 and then make_temp_name_count would not be set when Emacs starts. */
963 if (!make_temp_name_count_initialized_p
)
965 make_temp_name_count
= (unsigned) time (NULL
);
966 make_temp_name_count_initialized_p
= 1;
972 unsigned num
= make_temp_name_count
;
974 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
975 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
976 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
978 /* Poor man's congruential RN generator. Replace with
979 ++make_temp_name_count for debugging. */
980 make_temp_name_count
+= 25229;
981 make_temp_name_count
%= 225307;
983 if (stat (data
, &ignored
) < 0)
985 /* We want to return only if errno is ENOENT. */
989 /* The error here is dubious, but there is little else we
990 can do. The alternatives are to return nil, which is
991 as bad as (and in many cases worse than) throwing the
992 error, or to ignore the error, which will likely result
993 in looping through 225307 stat's, which is not only
994 dog-slow, but also useless since it will fallback to
995 the errow below, anyway. */
996 report_file_error ("Cannot create temporary name for prefix",
997 Fcons (prefix
, Qnil
));
1002 error ("Cannot create temporary name for prefix `%s'",
1008 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
1009 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
1010 The Emacs process number forms part of the result,
1011 so there is no danger of generating a name being used by another process.
1013 In addition, this function makes an attempt to choose a name
1014 which has no existing file. To make this work,
1015 PREFIX should be an absolute file name.
1017 There is a race condition between calling `make-temp-name' and creating the
1018 file which opens all kinds of security holes. For that reason, you should
1019 probably use `make-temp-file' instead, except in three circumstances:
1021 * If you are creating the file in the user's home directory.
1022 * If you are creating a directory rather than an ordinary file.
1023 * If you are taking special precautions as `make-temp-file' does. */)
1027 return make_temp_name (prefix
, 0);
1032 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1033 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1034 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1035 \(does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
1036 the current buffer's value of `default-directory' is used.
1037 File name components that are `.' are removed, and
1038 so are file name components followed by `..', along with the `..' itself;
1039 note that these simplifications are done without checking the resulting
1040 file names in the file system.
1041 An initial `~/' expands to your home directory.
1042 An initial `~USER/' expands to USER's home directory.
1043 See also the function `substitute-in-file-name'. */)
1044 (name
, default_directory
)
1045 Lisp_Object name
, default_directory
;
1049 register unsigned char *newdir
, *p
, *o
;
1051 unsigned char *target
;
1054 unsigned char * colon
= 0;
1055 unsigned char * close
= 0;
1056 unsigned char * slash
= 0;
1057 unsigned char * brack
= 0;
1058 int lbrack
= 0, rbrack
= 0;
1063 int collapse_newdir
= 1;
1067 Lisp_Object handler
, result
;
1070 CHECK_STRING (name
);
1072 /* If the file name has special constructs in it,
1073 call the corresponding file handler. */
1074 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1075 if (!NILP (handler
))
1076 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1078 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1079 if (NILP (default_directory
))
1080 default_directory
= current_buffer
->directory
;
1081 if (! STRINGP (default_directory
))
1084 /* "/" is not considered a root directory on DOS_NT, so using "/"
1085 here causes an infinite recursion in, e.g., the following:
1087 (let (default-directory)
1088 (expand-file-name "a"))
1090 To avoid this, we set default_directory to the root of the
1092 extern char *emacs_root_dir (void);
1094 default_directory
= build_string (emacs_root_dir ());
1096 default_directory
= build_string ("/");
1100 if (!NILP (default_directory
))
1102 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1103 if (!NILP (handler
))
1104 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1107 o
= SDATA (default_directory
);
1109 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1110 It would be better to do this down below where we actually use
1111 default_directory. Unfortunately, calling Fexpand_file_name recursively
1112 could invoke GC, and the strings might be relocated. This would
1113 be annoying because we have pointers into strings lying around
1114 that would need adjusting, and people would add new pointers to
1115 the code and forget to adjust them, resulting in intermittent bugs.
1116 Putting this call here avoids all that crud.
1118 The EQ test avoids infinite recursion. */
1119 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1120 /* Save time in some common cases - as long as default_directory
1121 is not relative, it can be canonicalized with name below (if it
1122 is needed at all) without requiring it to be expanded now. */
1124 /* Detect MSDOS file names with drive specifiers. */
1125 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1127 /* Detect Windows file names in UNC format. */
1128 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1130 #else /* not DOS_NT */
1131 /* Detect Unix absolute file names (/... alone is not absolute on
1133 && ! (IS_DIRECTORY_SEP (o
[0]))
1134 #endif /* not DOS_NT */
1137 struct gcpro gcpro1
;
1140 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1144 name
= FILE_SYSTEM_CASE (name
);
1146 multibyte
= STRING_MULTIBYTE (name
);
1149 /* We will force directory separators to be either all \ or /, so make
1150 a local copy to modify, even if there ends up being no change. */
1151 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1153 /* Note if special escape prefix is present, but remove for now. */
1154 if (nm
[0] == '/' && nm
[1] == ':')
1160 /* Find and remove drive specifier if present; this makes nm absolute
1161 even if the rest of the name appears to be relative. Only look for
1162 drive specifier at the beginning. */
1163 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1170 /* If we see "c://somedir", we want to strip the first slash after the
1171 colon when stripping the drive letter. Otherwise, this expands to
1173 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1175 #endif /* WINDOWSNT */
1179 /* Discard any previous drive specifier if nm is now in UNC format. */
1180 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1186 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1187 none are found, we can probably return right away. We will avoid
1188 allocating a new string if name is already fully expanded. */
1190 IS_DIRECTORY_SEP (nm
[0])
1192 && drive
&& !is_escaped
1195 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1202 /* If it turns out that the filename we want to return is just a
1203 suffix of FILENAME, we don't need to go through and edit
1204 things; we just need to construct a new string using data
1205 starting at the middle of FILENAME. If we set lose to a
1206 non-zero value, that means we've discovered that we can't do
1213 /* Since we know the name is absolute, we can assume that each
1214 element starts with a "/". */
1216 /* "." and ".." are hairy. */
1217 if (IS_DIRECTORY_SEP (p
[0])
1219 && (IS_DIRECTORY_SEP (p
[2])
1221 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1224 /* We want to replace multiple `/' in a row with a single
1227 && IS_DIRECTORY_SEP (p
[0])
1228 && IS_DIRECTORY_SEP (p
[1]))
1235 /* if dev:[dir]/, move nm to / */
1236 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1237 nm
= (brack
? brack
+ 1 : colon
+ 1);
1238 lbrack
= rbrack
= 0;
1245 #ifdef NO_HYPHENS_IN_FILENAMES
1246 if (lbrack
== rbrack
)
1248 /* Avoid clobbering negative version numbers. */
1253 #endif /* NO_HYPHENS_IN_FILENAMES */
1254 if (lbrack
> rbrack
&&
1255 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1256 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1258 #ifdef NO_HYPHENS_IN_FILENAMES
1261 #endif /* NO_HYPHENS_IN_FILENAMES */
1262 /* count open brackets, reset close bracket pointer */
1263 if (p
[0] == '[' || p
[0] == '<')
1264 lbrack
++, brack
= 0;
1265 /* count close brackets, set close bracket pointer */
1266 if (p
[0] == ']' || p
[0] == '>')
1267 rbrack
++, brack
= p
;
1268 /* detect ][ or >< */
1269 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1271 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1272 nm
= p
+ 1, lose
= 1;
1273 if (p
[0] == ':' && (colon
|| slash
))
1274 /* if dev1:[dir]dev2:, move nm to dev2: */
1280 /* if /name/dev:, move nm to dev: */
1283 /* if node::dev:, move colon following dev */
1284 else if (colon
&& colon
[-1] == ':')
1286 /* if dev1:dev2:, move nm to dev2: */
1287 else if (colon
&& colon
[-1] != ':')
1292 if (p
[0] == ':' && !colon
)
1298 if (lbrack
== rbrack
)
1301 else if (p
[0] == '.')
1309 if (index (nm
, '/'))
1311 nm
= sys_translate_unix (nm
);
1312 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1316 /* Make sure directories are all separated with / or \ as
1317 desired, but avoid allocation of a new string when not
1319 CORRECT_DIR_SEPS (nm
);
1321 if (IS_DIRECTORY_SEP (nm
[1]))
1323 if (strcmp (nm
, SDATA (name
)) != 0)
1324 name
= make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1328 /* drive must be set, so this is okay */
1329 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1333 name
= make_specified_string (nm
, -1, p
- nm
, multibyte
);
1334 temp
[0] = DRIVE_LETTER (drive
);
1335 name
= concat2 (build_string (temp
), name
);
1338 #else /* not DOS_NT */
1339 if (nm
== SDATA (name
))
1341 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1342 #endif /* not DOS_NT */
1346 /* At this point, nm might or might not be an absolute file name. We
1347 need to expand ~ or ~user if present, otherwise prefix nm with
1348 default_directory if nm is not absolute, and finally collapse /./
1349 and /foo/../ sequences.
1351 We set newdir to be the appropriate prefix if one is needed:
1352 - the relevant user directory if nm starts with ~ or ~user
1353 - the specified drive's working dir (DOS/NT only) if nm does not
1355 - the value of default_directory.
1357 Note that these prefixes are not guaranteed to be absolute (except
1358 for the working dir of a drive). Therefore, to ensure we always
1359 return an absolute name, if the final prefix is not absolute we
1360 append it to the current working directory. */
1364 if (nm
[0] == '~') /* prefix ~ */
1366 if (IS_DIRECTORY_SEP (nm
[1])
1370 || nm
[1] == 0) /* ~ by itself */
1372 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1373 newdir
= (unsigned char *) "";
1376 collapse_newdir
= 0;
1379 nm
++; /* Don't leave the slash in nm. */
1382 else /* ~user/filename */
1384 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1389 o
= (unsigned char *) alloca (p
- nm
+ 1);
1390 bcopy ((char *) nm
, o
, p
- nm
);
1393 pw
= (struct passwd
*) getpwnam (o
+ 1);
1396 newdir
= (unsigned char *) pw
-> pw_dir
;
1398 nm
= p
+ 1; /* skip the terminator */
1402 collapse_newdir
= 0;
1407 /* If we don't find a user of that name, leave the name
1408 unchanged; don't move nm forward to p. */
1413 /* On DOS and Windows, nm is absolute if a drive name was specified;
1414 use the drive's current directory as the prefix if needed. */
1415 if (!newdir
&& drive
)
1417 /* Get default directory if needed to make nm absolute. */
1418 if (!IS_DIRECTORY_SEP (nm
[0]))
1420 newdir
= alloca (MAXPATHLEN
+ 1);
1421 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1426 /* Either nm starts with /, or drive isn't mounted. */
1427 newdir
= alloca (4);
1428 newdir
[0] = DRIVE_LETTER (drive
);
1436 /* Finally, if no prefix has been specified and nm is not absolute,
1437 then it must be expanded relative to default_directory. */
1441 /* /... alone is not absolute on DOS and Windows. */
1442 && !IS_DIRECTORY_SEP (nm
[0])
1445 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1452 newdir
= SDATA (default_directory
);
1453 multibyte
|= STRING_MULTIBYTE (default_directory
);
1455 /* Note if special escape prefix is present, but remove for now. */
1456 if (newdir
[0] == '/' && newdir
[1] == ':')
1467 /* First ensure newdir is an absolute name. */
1469 /* Detect MSDOS file names with drive specifiers. */
1470 ! (IS_DRIVE (newdir
[0])
1471 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1473 /* Detect Windows file names in UNC format. */
1474 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1478 /* Effectively, let newdir be (expand-file-name newdir cwd).
1479 Because of the admonition against calling expand-file-name
1480 when we have pointers into lisp strings, we accomplish this
1481 indirectly by prepending newdir to nm if necessary, and using
1482 cwd (or the wd of newdir's drive) as the new newdir. */
1484 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1489 if (!IS_DIRECTORY_SEP (nm
[0]))
1491 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1492 file_name_as_directory (tmp
, newdir
);
1496 newdir
= alloca (MAXPATHLEN
+ 1);
1499 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1506 /* Strip off drive name from prefix, if present. */
1507 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1513 /* Keep only a prefix from newdir if nm starts with slash
1514 (//server/share for UNC, nothing otherwise). */
1515 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1518 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1520 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1522 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1524 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1536 /* Get rid of any slash at the end of newdir, unless newdir is
1537 just / or // (an incomplete UNC name). */
1538 length
= strlen (newdir
);
1539 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1541 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1545 unsigned char *temp
= (unsigned char *) alloca (length
);
1546 bcopy (newdir
, temp
, length
- 1);
1547 temp
[length
- 1] = 0;
1555 /* Now concatenate the directory and name to new space in the stack frame */
1556 tlen
+= strlen (nm
) + 1;
1558 /* Reserve space for drive specifier and escape prefix, since either
1559 or both may need to be inserted. (The Microsoft x86 compiler
1560 produces incorrect code if the following two lines are combined.) */
1561 target
= (unsigned char *) alloca (tlen
+ 4);
1563 #else /* not DOS_NT */
1564 target
= (unsigned char *) alloca (tlen
);
1565 #endif /* not DOS_NT */
1571 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1574 /* If newdir is effectively "C:/", then the drive letter will have
1575 been stripped and newdir will be "/". Concatenating with an
1576 absolute directory in nm produces "//", which will then be
1577 incorrectly treated as a network share. Ignore newdir in
1578 this case (keeping the drive letter). */
1579 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1580 && newdir
[1] == '\0'))
1582 strcpy (target
, newdir
);
1586 file_name_as_directory (target
, newdir
);
1589 strcat (target
, nm
);
1591 if (index (target
, '/'))
1592 strcpy (target
, sys_translate_unix (target
));
1595 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1597 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1606 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1612 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1613 /* brackets are offset from each other by 2 */
1616 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1617 /* convert [foo][bar] to [bar] */
1618 while (o
[-1] != '[' && o
[-1] != '<')
1620 else if (*p
== '-' && *o
!= '.')
1623 else if (p
[0] == '-' && o
[-1] == '.' &&
1624 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1625 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1629 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1630 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1632 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1634 /* else [foo.-] ==> [-] */
1638 #ifdef NO_HYPHENS_IN_FILENAMES
1640 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1641 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1643 #endif /* NO_HYPHENS_IN_FILENAMES */
1647 if (!IS_DIRECTORY_SEP (*p
))
1651 else if (IS_DIRECTORY_SEP (p
[0])
1653 && (IS_DIRECTORY_SEP (p
[2])
1656 /* If "/." is the entire filename, keep the "/". Otherwise,
1657 just delete the whole "/.". */
1658 if (o
== target
&& p
[2] == '\0')
1662 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1663 /* `/../' is the "superroot" on certain file systems.
1664 Turned off on DOS_NT systems because they have no
1665 "superroot" and because this causes us to produce
1666 file names like "d:/../foo" which fail file-related
1667 functions of the underlying OS. (To reproduce, try a
1668 long series of "../../" in default_directory, longer
1669 than the number of levels from the root.) */
1673 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1675 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1677 /* Keep initial / only if this is the whole name. */
1678 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1683 && IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1]))
1685 /* Collapse multiple `/' in a row. */
1687 while (IS_DIRECTORY_SEP (*p
))
1694 #endif /* not VMS */
1698 /* At last, set drive name. */
1700 /* Except for network file name. */
1701 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1702 #endif /* WINDOWSNT */
1704 if (!drive
) abort ();
1706 target
[0] = DRIVE_LETTER (drive
);
1709 /* Reinsert the escape prefix if required. */
1716 CORRECT_DIR_SEPS (target
);
1719 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1721 /* Again look to see if the file name has special constructs in it
1722 and perhaps call the corresponding file handler. This is needed
1723 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1724 the ".." component gives us "/user@host:/bar/../baz" which needs
1725 to be expanded again. */
1726 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1727 if (!NILP (handler
))
1728 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1734 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1735 This is the old version of expand-file-name, before it was thoroughly
1736 rewritten for Emacs 10.31. We leave this version here commented-out,
1737 because the code is very complex and likely to have subtle bugs. If
1738 bugs _are_ found, it might be of interest to look at the old code and
1739 see what did it do in the relevant situation.
1741 Don't remove this code: it's true that it will be accessible via CVS,
1742 but a few years from deletion, people will forget it is there. */
1744 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1745 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1746 "Convert FILENAME to absolute, and canonicalize it.\n\
1747 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1748 \(does not start with slash); if DEFAULT is nil or missing,\n\
1749 the current buffer's value of default-directory is used.\n\
1750 Filenames containing `.' or `..' as components are simplified;\n\
1751 initial `~/' expands to your home directory.\n\
1752 See also the function `substitute-in-file-name'.")
1754 Lisp_Object name
, defalt
;
1758 register unsigned char *newdir
, *p
, *o
;
1760 unsigned char *target
;
1764 unsigned char * colon
= 0;
1765 unsigned char * close
= 0;
1766 unsigned char * slash
= 0;
1767 unsigned char * brack
= 0;
1768 int lbrack
= 0, rbrack
= 0;
1772 CHECK_STRING (name
);
1775 /* Filenames on VMS are always upper case. */
1776 name
= Fupcase (name
);
1781 /* If nm is absolute, flush ...// and detect /./ and /../.
1782 If no /./ or /../ we can return right away. */
1794 if (p
[0] == '/' && p
[1] == '/'
1796 /* // at start of filename is meaningful on Apollo system. */
1801 if (p
[0] == '/' && p
[1] == '~')
1802 nm
= p
+ 1, lose
= 1;
1803 if (p
[0] == '/' && p
[1] == '.'
1804 && (p
[2] == '/' || p
[2] == 0
1805 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1811 /* if dev:[dir]/, move nm to / */
1812 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1813 nm
= (brack
? brack
+ 1 : colon
+ 1);
1814 lbrack
= rbrack
= 0;
1822 /* VMS pre V4.4,convert '-'s in filenames. */
1823 if (lbrack
== rbrack
)
1825 if (dots
< 2) /* this is to allow negative version numbers */
1830 if (lbrack
> rbrack
&&
1831 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1832 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1838 /* count open brackets, reset close bracket pointer */
1839 if (p
[0] == '[' || p
[0] == '<')
1840 lbrack
++, brack
= 0;
1841 /* count close brackets, set close bracket pointer */
1842 if (p
[0] == ']' || p
[0] == '>')
1843 rbrack
++, brack
= p
;
1844 /* detect ][ or >< */
1845 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1847 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1848 nm
= p
+ 1, lose
= 1;
1849 if (p
[0] == ':' && (colon
|| slash
))
1850 /* if dev1:[dir]dev2:, move nm to dev2: */
1856 /* If /name/dev:, move nm to dev: */
1859 /* If node::dev:, move colon following dev */
1860 else if (colon
&& colon
[-1] == ':')
1862 /* If dev1:dev2:, move nm to dev2: */
1863 else if (colon
&& colon
[-1] != ':')
1868 if (p
[0] == ':' && !colon
)
1874 if (lbrack
== rbrack
)
1877 else if (p
[0] == '.')
1885 if (index (nm
, '/'))
1886 return build_string (sys_translate_unix (nm
));
1888 if (nm
== SDATA (name
))
1890 return build_string (nm
);
1894 /* Now determine directory to start with and put it in NEWDIR */
1898 if (nm
[0] == '~') /* prefix ~ */
1903 || nm
[1] == 0)/* ~/filename */
1905 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1906 newdir
= (unsigned char *) "";
1909 nm
++; /* Don't leave the slash in nm. */
1912 else /* ~user/filename */
1914 /* Get past ~ to user */
1915 unsigned char *user
= nm
+ 1;
1916 /* Find end of name. */
1917 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1918 int len
= ptr
? ptr
- user
: strlen (user
);
1920 unsigned char *ptr1
= index (user
, ':');
1921 if (ptr1
!= 0 && ptr1
- user
< len
)
1924 /* Copy the user name into temp storage. */
1925 o
= (unsigned char *) alloca (len
+ 1);
1926 bcopy ((char *) user
, o
, len
);
1929 /* Look up the user name. */
1930 pw
= (struct passwd
*) getpwnam (o
+ 1);
1932 error ("\"%s\" isn't a registered user", o
+ 1);
1934 newdir
= (unsigned char *) pw
->pw_dir
;
1936 /* Discard the user name from NM. */
1943 #endif /* not VMS */
1947 defalt
= current_buffer
->directory
;
1948 CHECK_STRING (defalt
);
1949 newdir
= SDATA (defalt
);
1952 /* Now concatenate the directory and name to new space in the stack frame */
1954 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1955 target
= (unsigned char *) alloca (tlen
);
1961 if (nm
[0] == 0 || nm
[0] == '/')
1962 strcpy (target
, newdir
);
1965 file_name_as_directory (target
, newdir
);
1968 strcat (target
, nm
);
1970 if (index (target
, '/'))
1971 strcpy (target
, sys_translate_unix (target
));
1974 /* Now canonicalize by removing /. and /foo/.. if they appear */
1982 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1988 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1989 /* brackets are offset from each other by 2 */
1992 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1993 /* convert [foo][bar] to [bar] */
1994 while (o
[-1] != '[' && o
[-1] != '<')
1996 else if (*p
== '-' && *o
!= '.')
1999 else if (p
[0] == '-' && o
[-1] == '.' &&
2000 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
2001 /* flush .foo.- ; leave - if stopped by '[' or '<' */
2005 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
2006 if (p
[1] == '.') /* foo.-.bar ==> bar. */
2008 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
2010 /* else [foo.-] ==> [-] */
2016 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
2017 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2027 else if (!strncmp (p
, "//", 2)
2029 /* // at start of filename is meaningful in Apollo system. */
2037 else if (p
[0] == '/' && p
[1] == '.' &&
2038 (p
[2] == '/' || p
[2] == 0))
2040 else if (!strncmp (p
, "/..", 3)
2041 /* `/../' is the "superroot" on certain file systems. */
2043 && (p
[3] == '/' || p
[3] == 0))
2045 while (o
!= target
&& *--o
!= '/')
2048 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2052 if (o
== target
&& *o
== '/')
2060 #endif /* not VMS */
2063 return make_string (target
, o
- target
);
2067 /* If /~ or // appears, discard everything through first slash. */
2069 file_name_absolute_p (filename
)
2070 const unsigned char *filename
;
2073 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
2075 /* ??? This criterion is probably wrong for '<'. */
2076 || index (filename
, ':') || index (filename
, '<')
2077 || (*filename
== '[' && (filename
[1] != '-'
2078 || (filename
[2] != '.' && filename
[2] != ']'))
2079 && filename
[1] != '.')
2082 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
2083 && IS_DIRECTORY_SEP (filename
[2]))
2088 static unsigned char *
2089 search_embedded_absfilename (nm
, endp
)
2090 unsigned char *nm
, *endp
;
2092 unsigned char *p
, *s
;
2094 for (p
= nm
+ 1; p
< endp
; p
++)
2098 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2100 || IS_DIRECTORY_SEP (p
[-1]))
2101 && file_name_absolute_p (p
)
2102 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2103 /* // at start of file name is meaningful in Apollo,
2104 WindowsNT and Cygwin systems. */
2105 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
2106 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2109 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2114 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2116 unsigned char *o
= alloca (s
- p
+ 1);
2118 bcopy (p
, o
, s
- p
);
2121 /* If we have ~user and `user' exists, discard
2122 everything up to ~. But if `user' does not exist, leave
2123 ~user alone, it might be a literal file name. */
2124 if ((pw
= getpwnam (o
+ 1)))
2136 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2137 Ssubstitute_in_file_name
, 1, 1, 0,
2138 doc
: /* Substitute environment variables referred to in FILENAME.
2139 `$FOO' where FOO is an environment variable name means to substitute
2140 the value of that variable. The variable name should be terminated
2141 with a character not a letter, digit or underscore; otherwise, enclose
2142 the entire variable name in braces.
2143 If `/~' appears, all of FILENAME through that `/' is discarded.
2145 On VMS, `$' substitution is not done; this function does little and only
2146 duplicates what `expand-file-name' does. */)
2148 Lisp_Object filename
;
2152 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2153 unsigned char *target
= NULL
;
2155 int substituted
= 0;
2157 Lisp_Object handler
;
2159 CHECK_STRING (filename
);
2161 /* If the file name has special constructs in it,
2162 call the corresponding file handler. */
2163 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2164 if (!NILP (handler
))
2165 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2167 nm
= SDATA (filename
);
2169 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2170 CORRECT_DIR_SEPS (nm
);
2171 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2173 endp
= nm
+ SBYTES (filename
);
2175 /* If /~ or // appears, discard everything through first slash. */
2176 p
= search_embedded_absfilename (nm
, endp
);
2178 /* Start over with the new string, so we check the file-name-handler
2179 again. Important with filenames like "/home/foo//:/hello///there"
2180 which whould substitute to "/:/hello///there" rather than "/there". */
2181 return Fsubstitute_in_file_name
2182 (make_specified_string (p
, -1, endp
- p
,
2183 STRING_MULTIBYTE (filename
)));
2189 /* See if any variables are substituted into the string
2190 and find the total length of their values in `total' */
2192 for (p
= nm
; p
!= endp
;)
2202 /* "$$" means a single "$" */
2211 while (p
!= endp
&& *p
!= '}') p
++;
2212 if (*p
!= '}') goto missingclose
;
2218 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2222 /* Copy out the variable name */
2223 target
= (unsigned char *) alloca (s
- o
+ 1);
2224 strncpy (target
, o
, s
- o
);
2227 strupr (target
); /* $home == $HOME etc. */
2230 /* Get variable value */
2231 o
= (unsigned char *) egetenv (target
);
2234 total
+= strlen (o
);
2244 /* If substitution required, recopy the string and do it */
2245 /* Make space in stack frame for the new copy */
2246 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2249 /* Copy the rest of the name through, replacing $ constructs with values */
2266 while (p
!= endp
&& *p
!= '}') p
++;
2267 if (*p
!= '}') goto missingclose
;
2273 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2277 /* Copy out the variable name */
2278 target
= (unsigned char *) alloca (s
- o
+ 1);
2279 strncpy (target
, o
, s
- o
);
2282 strupr (target
); /* $home == $HOME etc. */
2285 /* Get variable value */
2286 o
= (unsigned char *) egetenv (target
);
2290 strcpy (x
, target
); x
+= strlen (target
);
2292 else if (STRING_MULTIBYTE (filename
))
2294 /* If the original string is multibyte,
2295 convert what we substitute into multibyte. */
2299 c
= unibyte_char_to_multibyte (c
);
2300 x
+= CHAR_STRING (c
, x
);
2312 /* If /~ or // appears, discard everything through first slash. */
2313 while ((p
= search_embedded_absfilename (xnm
, x
)))
2314 /* This time we do not start over because we've already expanded envvars
2315 and replaced $$ with $. Maybe we should start over as well, but we'd
2316 need to quote some $ to $$ first. */
2319 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2322 error ("Bad format environment-variable substitution");
2324 error ("Missing \"}\" in environment-variable substitution");
2326 error ("Substituting nonexistent environment variable \"%s\"", target
);
2329 #endif /* not VMS */
2333 /* A slightly faster and more convenient way to get
2334 (directory-file-name (expand-file-name FOO)). */
2337 expand_and_dir_to_file (filename
, defdir
)
2338 Lisp_Object filename
, defdir
;
2340 register Lisp_Object absname
;
2342 absname
= Fexpand_file_name (filename
, defdir
);
2345 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2346 if (c
== ':' || c
== ']' || c
== '>')
2347 absname
= Fdirectory_file_name (absname
);
2350 /* Remove final slash, if any (unless this is the root dir).
2351 stat behaves differently depending! */
2352 if (SCHARS (absname
) > 1
2353 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2354 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2355 /* We cannot take shortcuts; they might be wrong for magic file names. */
2356 absname
= Fdirectory_file_name (absname
);
2361 /* Signal an error if the file ABSNAME already exists.
2362 If INTERACTIVE is nonzero, ask the user whether to proceed,
2363 and bypass the error if the user says to go ahead.
2364 QUERYSTRING is a name for the action that is being considered
2367 *STATPTR is used to store the stat information if the file exists.
2368 If the file does not exist, STATPTR->st_mode is set to 0.
2369 If STATPTR is null, we don't store into it.
2371 If QUICK is nonzero, we ask for y or n, not yes or no. */
2374 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2375 Lisp_Object absname
;
2376 unsigned char *querystring
;
2378 struct stat
*statptr
;
2381 register Lisp_Object tem
, encoded_filename
;
2382 struct stat statbuf
;
2383 struct gcpro gcpro1
;
2385 encoded_filename
= ENCODE_FILE (absname
);
2387 /* stat is a good way to tell whether the file exists,
2388 regardless of what access permissions it has. */
2389 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
2392 Fsignal (Qfile_already_exists
,
2393 Fcons (build_string ("File already exists"),
2394 Fcons (absname
, Qnil
)));
2396 tem
= format2 ("File %s already exists; %s anyway? ",
2397 absname
, build_string (querystring
));
2399 tem
= Fy_or_n_p (tem
);
2401 tem
= do_yes_or_no_p (tem
);
2404 Fsignal (Qfile_already_exists
,
2405 Fcons (build_string ("File already exists"),
2406 Fcons (absname
, Qnil
)));
2413 statptr
->st_mode
= 0;
2418 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 6,
2419 "fCopy file: \nGCopy %s to file: \np\nP",
2420 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2421 If NEWNAME names a directory, copy FILE there.
2422 Signals a `file-already-exists' error if file NEWNAME already exists,
2423 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
2424 A number as third arg means request confirmation if NEWNAME already exists.
2425 This is what happens in interactive use with M-x.
2426 Always sets the file modes of the output file to match the input file.
2428 Fourth arg KEEP-TIME non-nil means give the output file the same
2429 last-modified time as the old one. (This works on only some systems.)
2431 A prefix arg makes KEEP-TIME non-nil.
2433 The optional fifth arg MUSTBENEW, if non-nil, insists on a check
2434 for an existing file with the same name. If MUSTBENEW is `excl',
2435 that means to get an error if the file already exists; never overwrite.
2436 If MUSTBENEW is neither nil nor `excl', that means ask for
2437 confirmation before overwriting, but do go ahead and overwrite the file
2438 if the user confirms.
2440 If PRESERVE-UID-GID is non-nil, we try to transfer the
2441 uid and gid of FILE to NEWNAME. */)
2442 (file
, newname
, ok_if_already_exists
, keep_time
, mustbenew
, preserve_uid_gid
)
2443 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
, mustbenew
;
2444 Lisp_Object preserve_uid_gid
;
2447 char buf
[16 * 1024];
2448 struct stat st
, out_st
;
2449 Lisp_Object handler
;
2450 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2451 int count
= SPECPDL_INDEX ();
2452 int input_file_statable_p
;
2453 Lisp_Object encoded_file
, encoded_newname
;
2455 encoded_file
= encoded_newname
= Qnil
;
2456 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2457 CHECK_STRING (file
);
2458 CHECK_STRING (newname
);
2460 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
2461 barf_or_query_if_file_exists (newname
, "overwrite", 1, 0, 1);
2463 if (!NILP (Ffile_directory_p (newname
)))
2464 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2466 newname
= Fexpand_file_name (newname
, Qnil
);
2468 file
= Fexpand_file_name (file
, Qnil
);
2470 /* If the input file name has special constructs in it,
2471 call the corresponding file handler. */
2472 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2473 /* Likewise for output file name. */
2475 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2476 if (!NILP (handler
))
2477 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2478 ok_if_already_exists
, keep_time
));
2480 encoded_file
= ENCODE_FILE (file
);
2481 encoded_newname
= ENCODE_FILE (newname
);
2483 if (NILP (ok_if_already_exists
)
2484 || INTEGERP (ok_if_already_exists
))
2485 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2486 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2487 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2491 if (!CopyFile (SDATA (encoded_file
),
2492 SDATA (encoded_newname
),
2494 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2495 /* CopyFile retains the timestamp by default. */
2496 else if (NILP (keep_time
))
2502 EMACS_GET_TIME (now
);
2503 filename
= SDATA (encoded_newname
);
2505 /* Ensure file is writable while its modified time is set. */
2506 attributes
= GetFileAttributes (filename
);
2507 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2508 if (set_file_times (filename
, now
, now
))
2510 /* Restore original attributes. */
2511 SetFileAttributes (filename
, attributes
);
2512 Fsignal (Qfile_date_error
,
2513 Fcons (build_string ("Cannot set file date"),
2514 Fcons (newname
, Qnil
)));
2516 /* Restore original attributes. */
2517 SetFileAttributes (filename
, attributes
);
2519 #else /* not WINDOWSNT */
2521 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2525 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2527 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2529 /* We can only copy regular files and symbolic links. Other files are not
2531 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2533 #if !defined (MSDOS) || __DJGPP__ > 1
2534 if (out_st
.st_mode
!= 0
2535 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2538 report_file_error ("Input and output files are the same",
2539 Fcons (file
, Fcons (newname
, Qnil
)));
2543 #if defined (S_ISREG) && defined (S_ISLNK)
2544 if (input_file_statable_p
)
2546 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2548 #if defined (EISDIR)
2549 /* Get a better looking error message. */
2552 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2555 #endif /* S_ISREG && S_ISLNK */
2558 /* Create the copy file with the same record format as the input file */
2559 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2562 /* System's default file type was set to binary by _fmode in emacs.c. */
2563 ofd
= emacs_open (SDATA (encoded_newname
),
2564 O_WRONLY
| O_TRUNC
| O_CREAT
2565 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
2566 S_IREAD
| S_IWRITE
);
2567 #else /* not MSDOS */
2568 ofd
= emacs_open (SDATA (encoded_newname
),
2569 O_WRONLY
| O_TRUNC
| O_CREAT
2570 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
2572 #endif /* not MSDOS */
2575 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2577 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2581 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2582 if (emacs_write (ofd
, buf
, n
) != n
)
2583 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2587 /* Preserve the original file modes, and if requested, also its
2589 if (input_file_statable_p
)
2591 if (! NILP (preserve_uid_gid
))
2592 fchown (ofd
, st
.st_uid
, st
.st_gid
);
2593 fchmod (ofd
, st
.st_mode
& 07777);
2595 #endif /* not MSDOS */
2597 /* Closing the output clobbers the file times on some systems. */
2598 if (emacs_close (ofd
) < 0)
2599 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2601 if (input_file_statable_p
)
2603 if (!NILP (keep_time
))
2605 EMACS_TIME atime
, mtime
;
2606 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2607 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2608 if (set_file_times (SDATA (encoded_newname
),
2610 Fsignal (Qfile_date_error
,
2611 Fcons (build_string ("Cannot set file date"),
2612 Fcons (newname
, Qnil
)));
2618 #if defined (__DJGPP__) && __DJGPP__ > 1
2619 if (input_file_statable_p
)
2621 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2622 and if it can't, it tells so. Otherwise, under MSDOS we usually
2623 get only the READ bit, which will make the copied file read-only,
2624 so it's better not to chmod at all. */
2625 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2626 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2628 #endif /* DJGPP version 2 or newer */
2629 #endif /* not WINDOWSNT */
2631 /* Discard the unwind protects. */
2632 specpdl_ptr
= specpdl
+ count
;
2638 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2639 Smake_directory_internal
, 1, 1, 0,
2640 doc
: /* Create a new directory named DIRECTORY. */)
2642 Lisp_Object directory
;
2644 const unsigned char *dir
;
2645 Lisp_Object handler
;
2646 Lisp_Object encoded_dir
;
2648 CHECK_STRING (directory
);
2649 directory
= Fexpand_file_name (directory
, Qnil
);
2651 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2652 if (!NILP (handler
))
2653 return call2 (handler
, Qmake_directory_internal
, directory
);
2655 encoded_dir
= ENCODE_FILE (directory
);
2657 dir
= SDATA (encoded_dir
);
2660 if (mkdir (dir
) != 0)
2662 if (mkdir (dir
, 0777) != 0)
2664 report_file_error ("Creating directory", Flist (1, &directory
));
2669 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2670 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2672 Lisp_Object directory
;
2674 const unsigned char *dir
;
2675 Lisp_Object handler
;
2676 Lisp_Object encoded_dir
;
2678 CHECK_STRING (directory
);
2679 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2681 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2682 if (!NILP (handler
))
2683 return call2 (handler
, Qdelete_directory
, directory
);
2685 encoded_dir
= ENCODE_FILE (directory
);
2687 dir
= SDATA (encoded_dir
);
2689 if (rmdir (dir
) != 0)
2690 report_file_error ("Removing directory", Flist (1, &directory
));
2695 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2696 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2697 If file has multiple names, it continues to exist with the other names. */)
2699 Lisp_Object filename
;
2701 Lisp_Object handler
;
2702 Lisp_Object encoded_file
;
2703 struct gcpro gcpro1
;
2706 if (!NILP (Ffile_directory_p (filename
))
2707 && NILP (Ffile_symlink_p (filename
)))
2708 Fsignal (Qfile_error
,
2709 Fcons (build_string ("Removing old name: is a directory"),
2710 Fcons (filename
, Qnil
)));
2712 filename
= Fexpand_file_name (filename
, Qnil
);
2714 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2715 if (!NILP (handler
))
2716 return call2 (handler
, Qdelete_file
, filename
);
2718 encoded_file
= ENCODE_FILE (filename
);
2720 if (0 > unlink (SDATA (encoded_file
)))
2721 report_file_error ("Removing old name", Flist (1, &filename
));
2726 internal_delete_file_1 (ignore
)
2732 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2735 internal_delete_file (filename
)
2736 Lisp_Object filename
;
2738 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2739 Qt
, internal_delete_file_1
));
2742 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2743 "fRename file: \nGRename %s to file: \np",
2744 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2745 If file has names other than FILE, it continues to have those names.
2746 Signals a `file-already-exists' error if a file NEWNAME already exists
2747 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2748 A number as third arg means request confirmation if NEWNAME already exists.
2749 This is what happens in interactive use with M-x. */)
2750 (file
, newname
, ok_if_already_exists
)
2751 Lisp_Object file
, newname
, ok_if_already_exists
;
2754 Lisp_Object args
[2];
2756 Lisp_Object handler
;
2757 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2758 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2760 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2761 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2762 CHECK_STRING (file
);
2763 CHECK_STRING (newname
);
2764 file
= Fexpand_file_name (file
, Qnil
);
2766 if (!NILP (Ffile_directory_p (newname
)))
2767 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2769 newname
= Fexpand_file_name (newname
, Qnil
);
2771 /* If the file name has special constructs in it,
2772 call the corresponding file handler. */
2773 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2775 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2776 if (!NILP (handler
))
2777 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2778 file
, newname
, ok_if_already_exists
));
2780 encoded_file
= ENCODE_FILE (file
);
2781 encoded_newname
= ENCODE_FILE (newname
);
2784 /* If the file names are identical but for the case, don't ask for
2785 confirmation: they simply want to change the letter-case of the
2787 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2789 if (NILP (ok_if_already_exists
)
2790 || INTEGERP (ok_if_already_exists
))
2791 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2792 INTEGERP (ok_if_already_exists
), 0, 0);
2794 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2796 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2797 || 0 > unlink (SDATA (encoded_file
)))
2803 symlink_target
= Ffile_symlink_p (file
);
2804 if (! NILP (symlink_target
))
2805 Fmake_symbolic_link (symlink_target
, newname
,
2806 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2809 Fcopy_file (file
, newname
,
2810 /* We have already prompted if it was an integer,
2811 so don't have copy-file prompt again. */
2812 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2815 Fdelete_file (file
);
2822 report_file_error ("Renaming", Flist (2, args
));
2825 report_file_error ("Renaming", Flist (2, &file
));
2832 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2833 "fAdd name to file: \nGName to add to %s: \np",
2834 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2835 Signals a `file-already-exists' error if a file NEWNAME already exists
2836 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2837 A number as third arg means request confirmation if NEWNAME already exists.
2838 This is what happens in interactive use with M-x. */)
2839 (file
, newname
, ok_if_already_exists
)
2840 Lisp_Object file
, newname
, ok_if_already_exists
;
2843 Lisp_Object args
[2];
2845 Lisp_Object handler
;
2846 Lisp_Object encoded_file
, encoded_newname
;
2847 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2849 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2850 encoded_file
= encoded_newname
= Qnil
;
2851 CHECK_STRING (file
);
2852 CHECK_STRING (newname
);
2853 file
= Fexpand_file_name (file
, Qnil
);
2855 if (!NILP (Ffile_directory_p (newname
)))
2856 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2858 newname
= Fexpand_file_name (newname
, Qnil
);
2860 /* If the file name has special constructs in it,
2861 call the corresponding file handler. */
2862 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2863 if (!NILP (handler
))
2864 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2865 newname
, ok_if_already_exists
));
2867 /* If the new name has special constructs in it,
2868 call the corresponding file handler. */
2869 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2870 if (!NILP (handler
))
2871 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2872 newname
, ok_if_already_exists
));
2874 encoded_file
= ENCODE_FILE (file
);
2875 encoded_newname
= ENCODE_FILE (newname
);
2877 if (NILP (ok_if_already_exists
)
2878 || INTEGERP (ok_if_already_exists
))
2879 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2880 INTEGERP (ok_if_already_exists
), 0, 0);
2882 unlink (SDATA (newname
));
2883 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2888 report_file_error ("Adding new name", Flist (2, args
));
2890 report_file_error ("Adding new name", Flist (2, &file
));
2899 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2900 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2901 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2902 Both args must be strings.
2903 Signals a `file-already-exists' error if a file LINKNAME already exists
2904 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2905 A number as third arg means request confirmation if LINKNAME already exists.
2906 This happens for interactive use with M-x. */)
2907 (filename
, linkname
, ok_if_already_exists
)
2908 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2911 Lisp_Object args
[2];
2913 Lisp_Object handler
;
2914 Lisp_Object encoded_filename
, encoded_linkname
;
2915 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2917 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2918 encoded_filename
= encoded_linkname
= Qnil
;
2919 CHECK_STRING (filename
);
2920 CHECK_STRING (linkname
);
2921 /* If the link target has a ~, we must expand it to get
2922 a truly valid file name. Otherwise, do not expand;
2923 we want to permit links to relative file names. */
2924 if (SREF (filename
, 0) == '~')
2925 filename
= Fexpand_file_name (filename
, Qnil
);
2927 if (!NILP (Ffile_directory_p (linkname
)))
2928 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2930 linkname
= Fexpand_file_name (linkname
, Qnil
);
2932 /* If the file name has special constructs in it,
2933 call the corresponding file handler. */
2934 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2935 if (!NILP (handler
))
2936 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2937 linkname
, ok_if_already_exists
));
2939 /* If the new link name has special constructs in it,
2940 call the corresponding file handler. */
2941 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2942 if (!NILP (handler
))
2943 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2944 linkname
, ok_if_already_exists
));
2946 encoded_filename
= ENCODE_FILE (filename
);
2947 encoded_linkname
= ENCODE_FILE (linkname
);
2949 if (NILP (ok_if_already_exists
)
2950 || INTEGERP (ok_if_already_exists
))
2951 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2952 INTEGERP (ok_if_already_exists
), 0, 0);
2953 if (0 > symlink (SDATA (encoded_filename
),
2954 SDATA (encoded_linkname
)))
2956 /* If we didn't complain already, silently delete existing file. */
2957 if (errno
== EEXIST
)
2959 unlink (SDATA (encoded_linkname
));
2960 if (0 <= symlink (SDATA (encoded_filename
),
2961 SDATA (encoded_linkname
)))
2971 report_file_error ("Making symbolic link", Flist (2, args
));
2973 report_file_error ("Making symbolic link", Flist (2, &filename
));
2979 #endif /* S_IFLNK */
2983 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2984 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2985 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2986 If STRING is nil or a null string, the logical name NAME is deleted. */)
2991 CHECK_STRING (name
);
2993 delete_logical_name (SDATA (name
));
2996 CHECK_STRING (string
);
2998 if (SCHARS (string
) == 0)
2999 delete_logical_name (SDATA (name
));
3001 define_logical_name (SDATA (name
), SDATA (string
));
3010 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
3011 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
3013 Lisp_Object path
, login
;
3017 CHECK_STRING (path
);
3018 CHECK_STRING (login
);
3020 netresult
= netunam (SDATA (path
), SDATA (login
));
3022 if (netresult
== -1)
3027 #endif /* HPUX_NET */
3029 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
3031 doc
: /* Return t if file FILENAME specifies an absolute file name.
3032 On Unix, this is a name starting with a `/' or a `~'. */)
3034 Lisp_Object filename
;
3036 CHECK_STRING (filename
);
3037 return file_name_absolute_p (SDATA (filename
)) ? Qt
: Qnil
;
3040 /* Return nonzero if file FILENAME exists and can be executed. */
3043 check_executable (filename
)
3047 int len
= strlen (filename
);
3050 if (stat (filename
, &st
) < 0)
3052 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
3053 return ((st
.st_mode
& S_IEXEC
) != 0);
3055 return (S_ISREG (st
.st_mode
)
3057 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
3058 || stricmp (suffix
, ".exe") == 0
3059 || stricmp (suffix
, ".bat") == 0)
3060 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3061 #endif /* not WINDOWSNT */
3062 #else /* not DOS_NT */
3063 #ifdef HAVE_EUIDACCESS
3064 return (euidaccess (filename
, 1) >= 0);
3066 /* Access isn't quite right because it uses the real uid
3067 and we really want to test with the effective uid.
3068 But Unix doesn't give us a right way to do it. */
3069 return (access (filename
, 1) >= 0);
3071 #endif /* not DOS_NT */
3074 /* Return nonzero if file FILENAME exists and can be written. */
3077 check_writable (filename
)
3082 if (stat (filename
, &st
) < 0)
3084 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3085 #else /* not MSDOS */
3086 #ifdef HAVE_EUIDACCESS
3087 return (euidaccess (filename
, 2) >= 0);
3089 /* Access isn't quite right because it uses the real uid
3090 and we really want to test with the effective uid.
3091 But Unix doesn't give us a right way to do it.
3092 Opening with O_WRONLY could work for an ordinary file,
3093 but would lose for directories. */
3094 return (access (filename
, 2) >= 0);
3096 #endif /* not MSDOS */
3099 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3100 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
3101 See also `file-readable-p' and `file-attributes'.
3102 This returns nil for a symlink to a nonexistent file.
3103 Use `file-symlink-p' to test for such links. */)
3105 Lisp_Object filename
;
3107 Lisp_Object absname
;
3108 Lisp_Object handler
;
3109 struct stat statbuf
;
3111 CHECK_STRING (filename
);
3112 absname
= Fexpand_file_name (filename
, Qnil
);
3114 /* If the file name has special constructs in it,
3115 call the corresponding file handler. */
3116 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3117 if (!NILP (handler
))
3118 return call2 (handler
, Qfile_exists_p
, absname
);
3120 absname
= ENCODE_FILE (absname
);
3122 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3125 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3126 doc
: /* Return t if FILENAME can be executed by you.
3127 For a directory, this means you can access files in that directory. */)
3129 Lisp_Object filename
;
3131 Lisp_Object absname
;
3132 Lisp_Object handler
;
3134 CHECK_STRING (filename
);
3135 absname
= Fexpand_file_name (filename
, Qnil
);
3137 /* If the file name has special constructs in it,
3138 call the corresponding file handler. */
3139 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3140 if (!NILP (handler
))
3141 return call2 (handler
, Qfile_executable_p
, absname
);
3143 absname
= ENCODE_FILE (absname
);
3145 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3148 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3149 doc
: /* Return t if file FILENAME exists and you can read it.
3150 See also `file-exists-p' and `file-attributes'. */)
3152 Lisp_Object filename
;
3154 Lisp_Object absname
;
3155 Lisp_Object handler
;
3158 struct stat statbuf
;
3160 CHECK_STRING (filename
);
3161 absname
= Fexpand_file_name (filename
, Qnil
);
3163 /* If the file name has special constructs in it,
3164 call the corresponding file handler. */
3165 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3166 if (!NILP (handler
))
3167 return call2 (handler
, Qfile_readable_p
, absname
);
3169 absname
= ENCODE_FILE (absname
);
3171 #if defined(DOS_NT) || defined(macintosh)
3172 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3174 if (access (SDATA (absname
), 0) == 0)
3177 #else /* not DOS_NT and not macintosh */
3179 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3180 /* Opening a fifo without O_NONBLOCK can wait.
3181 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3182 except in the case of a fifo, on a system which handles it. */
3183 desc
= stat (SDATA (absname
), &statbuf
);
3186 if (S_ISFIFO (statbuf
.st_mode
))
3187 flags
|= O_NONBLOCK
;
3189 desc
= emacs_open (SDATA (absname
), flags
, 0);
3194 #endif /* not DOS_NT and not macintosh */
3197 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3199 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3200 doc
: /* Return t if file FILENAME can be written or created by you. */)
3202 Lisp_Object filename
;
3204 Lisp_Object absname
, dir
, encoded
;
3205 Lisp_Object handler
;
3206 struct stat statbuf
;
3208 CHECK_STRING (filename
);
3209 absname
= Fexpand_file_name (filename
, Qnil
);
3211 /* If the file name has special constructs in it,
3212 call the corresponding file handler. */
3213 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3214 if (!NILP (handler
))
3215 return call2 (handler
, Qfile_writable_p
, absname
);
3217 encoded
= ENCODE_FILE (absname
);
3218 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3219 return (check_writable (SDATA (encoded
))
3222 dir
= Ffile_name_directory (absname
);
3225 dir
= Fdirectory_file_name (dir
);
3229 dir
= Fdirectory_file_name (dir
);
3232 dir
= ENCODE_FILE (dir
);
3234 /* The read-only attribute of the parent directory doesn't affect
3235 whether a file or directory can be created within it. Some day we
3236 should check ACLs though, which do affect this. */
3237 if (stat (SDATA (dir
), &statbuf
) < 0)
3239 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3241 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3246 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3247 doc
: /* Access file FILENAME, and get an error if that does not work.
3248 The second argument STRING is used in the error message.
3249 If there is no error, returns nil. */)
3251 Lisp_Object filename
, string
;
3253 Lisp_Object handler
, encoded_filename
, absname
;
3256 CHECK_STRING (filename
);
3257 absname
= Fexpand_file_name (filename
, Qnil
);
3259 CHECK_STRING (string
);
3261 /* If the file name has special constructs in it,
3262 call the corresponding file handler. */
3263 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3264 if (!NILP (handler
))
3265 return call3 (handler
, Qaccess_file
, absname
, string
);
3267 encoded_filename
= ENCODE_FILE (absname
);
3269 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3271 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3277 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3278 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3279 The value is the link target, as a string.
3280 Otherwise it returns nil.
3282 This function returns t when given the name of a symlink that
3283 points to a nonexistent file. */)
3285 Lisp_Object filename
;
3287 Lisp_Object handler
;
3289 CHECK_STRING (filename
);
3290 filename
= Fexpand_file_name (filename
, Qnil
);
3292 /* If the file name has special constructs in it,
3293 call the corresponding file handler. */
3294 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3295 if (!NILP (handler
))
3296 return call2 (handler
, Qfile_symlink_p
, filename
);
3305 filename
= ENCODE_FILE (filename
);
3312 buf
= (char *) xrealloc (buf
, bufsize
);
3313 bzero (buf
, bufsize
);
3316 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3320 /* HP-UX reports ERANGE if buffer is too small. */
3321 if (errno
== ERANGE
)
3331 while (valsize
>= bufsize
);
3333 val
= make_string (buf
, valsize
);
3334 if (buf
[0] == '/' && index (buf
, ':'))
3335 val
= concat2 (build_string ("/:"), val
);
3337 val
= DECODE_FILE (val
);
3340 #else /* not S_IFLNK */
3342 #endif /* not S_IFLNK */
3345 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3346 doc
: /* Return t if FILENAME names an existing directory.
3347 Symbolic links to directories count as directories.
3348 See `file-symlink-p' to distinguish symlinks. */)
3350 Lisp_Object filename
;
3352 register Lisp_Object absname
;
3354 Lisp_Object handler
;
3356 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3358 /* If the file name has special constructs in it,
3359 call the corresponding file handler. */
3360 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3361 if (!NILP (handler
))
3362 return call2 (handler
, Qfile_directory_p
, absname
);
3364 absname
= ENCODE_FILE (absname
);
3366 if (stat (SDATA (absname
), &st
) < 0)
3368 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3371 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3372 doc
: /* Return t if file FILENAME names a directory you can open.
3373 For the value to be t, FILENAME must specify the name of a directory as a file,
3374 and the directory must allow you to open files in it. In order to use a
3375 directory as a buffer's current directory, this predicate must return true.
3376 A directory name spec may be given instead; then the value is t
3377 if the directory so specified exists and really is a readable and
3378 searchable directory. */)
3380 Lisp_Object filename
;
3382 Lisp_Object handler
;
3384 struct gcpro gcpro1
;
3386 /* If the file name has special constructs in it,
3387 call the corresponding file handler. */
3388 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3389 if (!NILP (handler
))
3390 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3393 tem
= (NILP (Ffile_directory_p (filename
))
3394 || NILP (Ffile_executable_p (filename
)));
3396 return tem
? Qnil
: Qt
;
3399 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3400 doc
: /* Return t if file FILENAME is the name of a regular file.
3401 This is the sort of file that holds an ordinary stream of data bytes. */)
3403 Lisp_Object filename
;
3405 register Lisp_Object absname
;
3407 Lisp_Object handler
;
3409 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3411 /* If the file name has special constructs in it,
3412 call the corresponding file handler. */
3413 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3414 if (!NILP (handler
))
3415 return call2 (handler
, Qfile_regular_p
, absname
);
3417 absname
= ENCODE_FILE (absname
);
3422 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3424 /* Tell stat to use expensive method to get accurate info. */
3425 Vw32_get_true_file_attributes
= Qt
;
3426 result
= stat (SDATA (absname
), &st
);
3427 Vw32_get_true_file_attributes
= tem
;
3431 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3434 if (stat (SDATA (absname
), &st
) < 0)
3436 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3440 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3441 doc
: /* Return mode bits of file named FILENAME, as an integer.
3442 Return nil, if file does not exist or is not accessible. */)
3444 Lisp_Object filename
;
3446 Lisp_Object absname
;
3448 Lisp_Object handler
;
3450 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3452 /* If the file name has special constructs in it,
3453 call the corresponding file handler. */
3454 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3455 if (!NILP (handler
))
3456 return call2 (handler
, Qfile_modes
, absname
);
3458 absname
= ENCODE_FILE (absname
);
3460 if (stat (SDATA (absname
), &st
) < 0)
3462 #if defined (MSDOS) && __DJGPP__ < 2
3463 if (check_executable (SDATA (absname
)))
3464 st
.st_mode
|= S_IEXEC
;
3465 #endif /* MSDOS && __DJGPP__ < 2 */
3467 return make_number (st
.st_mode
& 07777);
3470 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3471 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3472 Only the 12 low bits of MODE are used. */)
3474 Lisp_Object filename
, mode
;
3476 Lisp_Object absname
, encoded_absname
;
3477 Lisp_Object handler
;
3479 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3480 CHECK_NUMBER (mode
);
3482 /* If the file name has special constructs in it,
3483 call the corresponding file handler. */
3484 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3485 if (!NILP (handler
))
3486 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3488 encoded_absname
= ENCODE_FILE (absname
);
3490 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3491 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3496 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3497 doc
: /* Set the file permission bits for newly created files.
3498 The argument MODE should be an integer; only the low 9 bits are used.
3499 This setting is inherited by subprocesses. */)
3503 CHECK_NUMBER (mode
);
3505 umask ((~ XINT (mode
)) & 0777);
3510 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3511 doc
: /* Return the default file protection for created files.
3512 The value is an integer. */)
3518 realmask
= umask (0);
3521 XSETINT (value
, (~ realmask
) & 0777);
3525 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3527 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3528 doc
: /* Set times of file FILENAME to TIME.
3529 Set both access and modification times.
3530 Return t on success, else nil.
3531 Use the current time if TIME is nil. TIME is in the format of
3534 Lisp_Object filename
, time
;
3536 Lisp_Object absname
, encoded_absname
;
3537 Lisp_Object handler
;
3541 if (! lisp_time_argument (time
, &sec
, &usec
))
3542 error ("Invalid time specification");
3544 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3546 /* If the file name has special constructs in it,
3547 call the corresponding file handler. */
3548 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3549 if (!NILP (handler
))
3550 return call3 (handler
, Qset_file_times
, absname
, time
);
3552 encoded_absname
= ENCODE_FILE (absname
);
3557 EMACS_SET_SECS (t
, sec
);
3558 EMACS_SET_USECS (t
, usec
);
3560 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3565 /* Setting times on a directory always fails. */
3566 if (stat (SDATA (encoded_absname
), &st
) == 0
3567 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3570 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3583 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3584 doc
: /* Tell Unix to finish all pending disk updates. */)
3593 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3594 doc
: /* Return t if file FILE1 is newer than file FILE2.
3595 If FILE1 does not exist, the answer is nil;
3596 otherwise, if FILE2 does not exist, the answer is t. */)
3598 Lisp_Object file1
, file2
;
3600 Lisp_Object absname1
, absname2
;
3603 Lisp_Object handler
;
3604 struct gcpro gcpro1
, gcpro2
;
3606 CHECK_STRING (file1
);
3607 CHECK_STRING (file2
);
3610 GCPRO2 (absname1
, file2
);
3611 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3612 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3615 /* If the file name has special constructs in it,
3616 call the corresponding file handler. */
3617 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3619 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3620 if (!NILP (handler
))
3621 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3623 GCPRO2 (absname1
, absname2
);
3624 absname1
= ENCODE_FILE (absname1
);
3625 absname2
= ENCODE_FILE (absname2
);
3628 if (stat (SDATA (absname1
), &st
) < 0)
3631 mtime1
= st
.st_mtime
;
3633 if (stat (SDATA (absname2
), &st
) < 0)
3636 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3640 Lisp_Object Qfind_buffer_file_type
;
3643 #ifndef READ_BUF_SIZE
3644 #define READ_BUF_SIZE (64 << 10)
3647 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3649 /* This function is called after Lisp functions to decide a coding
3650 system are called, or when they cause an error. Before they are
3651 called, the current buffer is set unibyte and it contains only a
3652 newly inserted text (thus the buffer was empty before the
3655 The functions may set markers, overlays, text properties, or even
3656 alter the buffer contents, change the current buffer.
3658 Here, we reset all those changes by:
3659 o set back the current buffer.
3660 o move all markers and overlays to BEG.
3661 o remove all text properties.
3662 o set back the buffer multibyteness. */
3665 decide_coding_unwind (unwind_data
)
3666 Lisp_Object unwind_data
;
3668 Lisp_Object multibyte
, undo_list
, buffer
;
3670 multibyte
= XCAR (unwind_data
);
3671 unwind_data
= XCDR (unwind_data
);
3672 undo_list
= XCAR (unwind_data
);
3673 buffer
= XCDR (unwind_data
);
3675 if (current_buffer
!= XBUFFER (buffer
))
3676 set_buffer_internal (XBUFFER (buffer
));
3677 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3678 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3679 BUF_INTERVALS (current_buffer
) = 0;
3680 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3682 /* Now we are safe to change the buffer's multibyteness directly. */
3683 current_buffer
->enable_multibyte_characters
= multibyte
;
3684 current_buffer
->undo_list
= undo_list
;
3690 /* Used to pass values from insert-file-contents to read_non_regular. */
3692 static int non_regular_fd
;
3693 static int non_regular_inserted
;
3694 static int non_regular_nbytes
;
3697 /* Read from a non-regular file.
3698 Read non_regular_trytry bytes max from non_regular_fd.
3699 Non_regular_inserted specifies where to put the read bytes.
3700 Value is the number of bytes read. */
3709 nbytes
= emacs_read (non_regular_fd
,
3710 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3711 non_regular_nbytes
);
3713 return make_number (nbytes
);
3717 /* Condition-case handler used when reading from non-regular files
3718 in insert-file-contents. */
3721 read_non_regular_quit ()
3727 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3729 doc
: /* Insert contents of file FILENAME after point.
3730 Returns list of absolute file name and number of characters inserted.
3731 If second argument VISIT is non-nil, the buffer's visited filename
3732 and last save file modtime are set, and it is marked unmodified.
3733 If visiting and the file does not exist, visiting is completed
3734 before the error is signaled.
3735 The optional third and fourth arguments BEG and END
3736 specify what portion of the file to insert.
3737 These arguments count bytes in the file, not characters in the buffer.
3738 If VISIT is non-nil, BEG and END must be nil.
3740 If optional fifth argument REPLACE is non-nil,
3741 it means replace the current buffer contents (in the accessible portion)
3742 with the file contents. This is better than simply deleting and inserting
3743 the whole thing because (1) it preserves some marker positions
3744 and (2) it puts less data in the undo list.
3745 When REPLACE is non-nil, the value is the number of characters actually read,
3746 which is often less than the number of characters to be read.
3748 This does code conversion according to the value of
3749 `coding-system-for-read' or `file-coding-system-alist',
3750 and sets the variable `last-coding-system-used' to the coding system
3752 (filename
, visit
, beg
, end
, replace
)
3753 Lisp_Object filename
, visit
, beg
, end
, replace
;
3758 register int how_much
;
3759 register int unprocessed
;
3760 int count
= SPECPDL_INDEX ();
3761 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3762 Lisp_Object handler
, val
, insval
, orig_filename
;
3765 int not_regular
= 0;
3766 unsigned char read_buf
[READ_BUF_SIZE
];
3767 struct coding_system coding
;
3768 unsigned char buffer
[1 << 14];
3769 int replace_handled
= 0;
3770 int set_coding_system
= 0;
3771 Lisp_Object coding_system
;
3773 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3774 int we_locked_file
= 0;
3776 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3777 error ("Cannot do file visiting in an indirect buffer");
3779 if (!NILP (current_buffer
->read_only
))
3780 Fbarf_if_buffer_read_only ();
3784 orig_filename
= Qnil
;
3786 GCPRO4 (filename
, val
, p
, orig_filename
);
3788 CHECK_STRING (filename
);
3789 filename
= Fexpand_file_name (filename
, Qnil
);
3791 /* The value Qnil means that the coding system is not yet
3793 coding_system
= Qnil
;
3795 /* If the file name has special constructs in it,
3796 call the corresponding file handler. */
3797 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3798 if (!NILP (handler
))
3800 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3801 visit
, beg
, end
, replace
);
3802 if (CONSP (val
) && CONSP (XCDR (val
)))
3803 inserted
= XINT (XCAR (XCDR (val
)));
3807 orig_filename
= filename
;
3808 filename
= ENCODE_FILE (filename
);
3814 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3816 /* Tell stat to use expensive method to get accurate info. */
3817 Vw32_get_true_file_attributes
= Qt
;
3818 total
= stat (SDATA (filename
), &st
);
3819 Vw32_get_true_file_attributes
= tem
;
3824 if (stat (SDATA (filename
), &st
) < 0)
3826 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3827 || fstat (fd
, &st
) < 0)
3828 #endif /* not APOLLO */
3829 #endif /* WINDOWSNT */
3831 if (fd
>= 0) emacs_close (fd
);
3834 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3837 if (!NILP (Vcoding_system_for_read
))
3838 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3843 /* This code will need to be changed in order to work on named
3844 pipes, and it's probably just not worth it. So we should at
3845 least signal an error. */
3846 if (!S_ISREG (st
.st_mode
))
3853 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3854 Fsignal (Qfile_error
,
3855 Fcons (build_string ("not a regular file"),
3856 Fcons (orig_filename
, Qnil
)));
3861 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3864 /* Replacement should preserve point as it preserves markers. */
3865 if (!NILP (replace
))
3866 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3868 record_unwind_protect (close_file_unwind
, make_number (fd
));
3870 /* Supposedly happens on VMS. */
3871 /* Can happen on any platform that uses long as type of off_t, but allows
3872 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3873 give a message suitable for the latter case. */
3874 if (! not_regular
&& st
.st_size
< 0)
3875 error ("Maximum buffer size exceeded");
3877 /* Prevent redisplay optimizations. */
3878 current_buffer
->clip_changed
= 1;
3882 if (!NILP (beg
) || !NILP (end
))
3883 error ("Attempt to visit less than an entire file");
3884 if (BEG
< Z
&& NILP (replace
))
3885 error ("Cannot do file visiting in a non-empty buffer");
3891 XSETFASTINT (beg
, 0);
3899 XSETINT (end
, st
.st_size
);
3901 /* Arithmetic overflow can occur if an Emacs integer cannot
3902 represent the file size, or if the calculations below
3903 overflow. The calculations below double the file size
3904 twice, so check that it can be multiplied by 4 safely. */
3905 if (XINT (end
) != st
.st_size
3906 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3907 error ("Maximum buffer size exceeded");
3909 /* The file size returned from stat may be zero, but data
3910 may be readable nonetheless, for example when this is a
3911 file in the /proc filesystem. */
3912 if (st
.st_size
== 0)
3913 XSETINT (end
, READ_BUF_SIZE
);
3917 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3919 coding_system
= Qutf_8_emacs
;
3920 setup_coding_system (coding_system
, &coding
);
3921 /* Ensure we set Vlast_coding_system_used. */
3922 set_coding_system
= 1;
3926 /* Decide the coding system to use for reading the file now
3927 because we can't use an optimized method for handling
3928 `coding:' tag if the current buffer is not empty. */
3929 if (!NILP (Vcoding_system_for_read
))
3930 coding_system
= Vcoding_system_for_read
;
3933 /* Don't try looking inside a file for a coding system
3934 specification if it is not seekable. */
3935 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3937 /* Find a coding system specified in the heading two
3938 lines or in the tailing several lines of the file.
3939 We assume that the 1K-byte and 3K-byte for heading
3940 and tailing respectively are sufficient for this
3944 if (st
.st_size
<= (1024 * 4))
3945 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3948 nread
= emacs_read (fd
, read_buf
, 1024);
3951 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3952 report_file_error ("Setting file position",
3953 Fcons (orig_filename
, Qnil
));
3954 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3959 error ("IO error reading %s: %s",
3960 SDATA (orig_filename
), emacs_strerror (errno
));
3963 struct buffer
*prev
= current_buffer
;
3967 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3969 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3970 buf
= XBUFFER (buffer
);
3972 delete_all_overlays (buf
);
3973 buf
->directory
= current_buffer
->directory
;
3974 buf
->read_only
= Qnil
;
3975 buf
->filename
= Qnil
;
3976 buf
->undo_list
= Qt
;
3977 eassert (buf
->overlays_before
== NULL
);
3978 eassert (buf
->overlays_after
== NULL
);
3980 set_buffer_internal (buf
);
3982 buf
->enable_multibyte_characters
= Qnil
;
3984 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3985 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3986 coding_system
= call2 (Vset_auto_coding_function
,
3987 filename
, make_number (nread
));
3988 set_buffer_internal (prev
);
3990 /* Discard the unwind protect for recovering the
3994 /* Rewind the file for the actual read done later. */
3995 if (lseek (fd
, 0, 0) < 0)
3996 report_file_error ("Setting file position",
3997 Fcons (orig_filename
, Qnil
));
4001 if (NILP (coding_system
))
4003 /* If we have not yet decided a coding system, check
4004 file-coding-system-alist. */
4005 Lisp_Object args
[6];
4007 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4008 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
4009 coding_system
= Ffind_operation_coding_system (6, args
);
4010 if (CONSP (coding_system
))
4011 coding_system
= XCAR (coding_system
);
4015 if (NILP (coding_system
))
4016 coding_system
= Qundecided
;
4018 CHECK_CODING_SYSTEM (coding_system
);
4020 if (NILP (current_buffer
->enable_multibyte_characters
))
4021 /* We must suppress all character code conversion except for
4022 end-of-line conversion. */
4023 coding_system
= raw_text_coding_system (coding_system
);
4025 setup_coding_system (coding_system
, &coding
);
4026 /* Ensure we set Vlast_coding_system_used. */
4027 set_coding_system
= 1;
4030 /* If requested, replace the accessible part of the buffer
4031 with the file contents. Avoid replacing text at the
4032 beginning or end of the buffer that matches the file contents;
4033 that preserves markers pointing to the unchanged parts.
4035 Here we implement this feature in an optimized way
4036 for the case where code conversion is NOT needed.
4037 The following if-statement handles the case of conversion
4038 in a less optimal way.
4040 If the code conversion is "automatic" then we try using this
4041 method and hope for the best.
4042 But if we discover the need for conversion, we give up on this method
4043 and let the following if-statement handle the replace job. */
4046 && (NILP (coding_system
)
4047 || ! CODING_REQUIRE_DECODING (&coding
)))
4049 /* same_at_start and same_at_end count bytes,
4050 because file access counts bytes
4051 and BEG and END count bytes. */
4052 int same_at_start
= BEGV_BYTE
;
4053 int same_at_end
= ZV_BYTE
;
4055 /* There is still a possibility we will find the need to do code
4056 conversion. If that happens, we set this variable to 1 to
4057 give up on handling REPLACE in the optimized way. */
4058 int giveup_match_end
= 0;
4060 if (XINT (beg
) != 0)
4062 if (lseek (fd
, XINT (beg
), 0) < 0)
4063 report_file_error ("Setting file position",
4064 Fcons (orig_filename
, Qnil
));
4069 /* Count how many chars at the start of the file
4070 match the text at the beginning of the buffer. */
4075 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4077 error ("IO error reading %s: %s",
4078 SDATA (orig_filename
), emacs_strerror (errno
));
4079 else if (nread
== 0)
4082 if (CODING_REQUIRE_DETECTION (&coding
))
4084 coding_system
= detect_coding_system (buffer
, nread
, nread
, 1, 0,
4086 setup_coding_system (coding_system
, &coding
);
4089 if (CODING_REQUIRE_DECODING (&coding
))
4090 /* We found that the file should be decoded somehow.
4091 Let's give up here. */
4093 giveup_match_end
= 1;
4098 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4099 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4100 same_at_start
++, bufpos
++;
4101 /* If we found a discrepancy, stop the scan.
4102 Otherwise loop around and scan the next bufferful. */
4103 if (bufpos
!= nread
)
4107 /* If the file matches the buffer completely,
4108 there's no need to replace anything. */
4109 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4113 /* Truncate the buffer to the size of the file. */
4114 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4119 /* Count how many chars at the end of the file
4120 match the text at the end of the buffer. But, if we have
4121 already found that decoding is necessary, don't waste time. */
4122 while (!giveup_match_end
)
4124 int total_read
, nread
, bufpos
, curpos
, trial
;
4126 /* At what file position are we now scanning? */
4127 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4128 /* If the entire file matches the buffer tail, stop the scan. */
4131 /* How much can we scan in the next step? */
4132 trial
= min (curpos
, sizeof buffer
);
4133 if (lseek (fd
, curpos
- trial
, 0) < 0)
4134 report_file_error ("Setting file position",
4135 Fcons (orig_filename
, Qnil
));
4137 total_read
= nread
= 0;
4138 while (total_read
< trial
)
4140 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4142 error ("IO error reading %s: %s",
4143 SDATA (orig_filename
), emacs_strerror (errno
));
4144 else if (nread
== 0)
4146 total_read
+= nread
;
4149 /* Scan this bufferful from the end, comparing with
4150 the Emacs buffer. */
4151 bufpos
= total_read
;
4153 /* Compare with same_at_start to avoid counting some buffer text
4154 as matching both at the file's beginning and at the end. */
4155 while (bufpos
> 0 && same_at_end
> same_at_start
4156 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4157 same_at_end
--, bufpos
--;
4159 /* If we found a discrepancy, stop the scan.
4160 Otherwise loop around and scan the preceding bufferful. */
4163 /* If this discrepancy is because of code conversion,
4164 we cannot use this method; giveup and try the other. */
4165 if (same_at_end
> same_at_start
4166 && FETCH_BYTE (same_at_end
- 1) >= 0200
4167 && ! NILP (current_buffer
->enable_multibyte_characters
)
4168 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4169 giveup_match_end
= 1;
4178 if (! giveup_match_end
)
4182 /* We win! We can handle REPLACE the optimized way. */
4184 /* Extend the start of non-matching text area to multibyte
4185 character boundary. */
4186 if (! NILP (current_buffer
->enable_multibyte_characters
))
4187 while (same_at_start
> BEGV_BYTE
4188 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4191 /* Extend the end of non-matching text area to multibyte
4192 character boundary. */
4193 if (! NILP (current_buffer
->enable_multibyte_characters
))
4194 while (same_at_end
< ZV_BYTE
4195 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4198 /* Don't try to reuse the same piece of text twice. */
4199 overlap
= (same_at_start
- BEGV_BYTE
4200 - (same_at_end
+ st
.st_size
- ZV
));
4202 same_at_end
+= overlap
;
4204 /* Arrange to read only the nonmatching middle part of the file. */
4205 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4206 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4208 del_range_byte (same_at_start
, same_at_end
, 0);
4209 /* Insert from the file at the proper position. */
4210 temp
= BYTE_TO_CHAR (same_at_start
);
4211 SET_PT_BOTH (temp
, same_at_start
);
4213 /* If display currently starts at beginning of line,
4214 keep it that way. */
4215 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4216 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4218 replace_handled
= 1;
4222 /* If requested, replace the accessible part of the buffer
4223 with the file contents. Avoid replacing text at the
4224 beginning or end of the buffer that matches the file contents;
4225 that preserves markers pointing to the unchanged parts.
4227 Here we implement this feature for the case where code conversion
4228 is needed, in a simple way that needs a lot of memory.
4229 The preceding if-statement handles the case of no conversion
4230 in a more optimized way. */
4231 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4233 int same_at_start
= BEGV_BYTE
;
4234 int same_at_end
= ZV_BYTE
;
4235 int same_at_start_charpos
;
4239 unsigned char *decoded
;
4241 int this_count
= SPECPDL_INDEX ();
4242 int multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
4243 Lisp_Object conversion_buffer
;
4245 conversion_buffer
= code_conversion_save (1, multibyte
);
4247 /* First read the whole file, performing code conversion into
4248 CONVERSION_BUFFER. */
4250 if (lseek (fd
, XINT (beg
), 0) < 0)
4251 report_file_error ("Setting file position",
4252 Fcons (orig_filename
, Qnil
));
4254 total
= st
.st_size
; /* Total bytes in the file. */
4255 how_much
= 0; /* Bytes read from file so far. */
4256 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4257 unprocessed
= 0; /* Bytes not processed in previous loop. */
4259 GCPRO1 (conversion_buffer
);
4260 while (how_much
< total
)
4262 /* We read one bunch by one (READ_BUF_SIZE bytes) to allow
4263 quitting while reading a huge while. */
4264 /* try is reserved in some compilers (Microsoft C) */
4265 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4268 /* Allow quitting out of the actual I/O. */
4271 this = emacs_read (fd
, read_buf
+ unprocessed
, trytry
);
4283 BUF_SET_PT (XBUFFER (conversion_buffer
),
4284 BUF_Z (XBUFFER (conversion_buffer
)));
4285 decode_coding_c_string (&coding
, read_buf
, unprocessed
+ this,
4287 unprocessed
= coding
.carryover_bytes
;
4288 if (coding
.carryover_bytes
> 0)
4289 bcopy (coding
.carryover
, read_buf
, unprocessed
);
4294 /* At this point, HOW_MUCH should equal TOTAL, or should be <= 0
4295 if we couldn't read the file. */
4300 error ("IO error reading %s: %s",
4301 SDATA (orig_filename
), emacs_strerror (errno
));
4302 else if (how_much
== -2)
4303 error ("maximum buffer size exceeded");
4306 if (unprocessed
> 0)
4308 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4309 decode_coding_c_string (&coding
, read_buf
, unprocessed
,
4311 coding
.mode
&= ~CODING_MODE_LAST_BLOCK
;
4314 decoded
= BUF_BEG_ADDR (XBUFFER (conversion_buffer
));
4315 inserted
= (BUF_Z_BYTE (XBUFFER (conversion_buffer
))
4316 - BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
4318 /* Compare the beginning of the converted string with the buffer
4322 while (bufpos
< inserted
&& same_at_start
< same_at_end
4323 && FETCH_BYTE (same_at_start
) == decoded
[bufpos
])
4324 same_at_start
++, bufpos
++;
4326 /* If the file matches the head of buffer completely,
4327 there's no need to replace anything. */
4329 if (bufpos
== inserted
)
4332 /* Truncate the buffer to the size of the file. */
4333 del_range_byte (same_at_start
, same_at_end
, 0);
4336 unbind_to (this_count
, Qnil
);
4340 /* Extend the start of non-matching text area to the previous
4341 multibyte character boundary. */
4342 if (! NILP (current_buffer
->enable_multibyte_characters
))
4343 while (same_at_start
> BEGV_BYTE
4344 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4347 /* Scan this bufferful from the end, comparing with
4348 the Emacs buffer. */
4351 /* Compare with same_at_start to avoid counting some buffer text
4352 as matching both at the file's beginning and at the end. */
4353 while (bufpos
> 0 && same_at_end
> same_at_start
4354 && FETCH_BYTE (same_at_end
- 1) == decoded
[bufpos
- 1])
4355 same_at_end
--, bufpos
--;
4357 /* Extend the end of non-matching text area to the next
4358 multibyte character boundary. */
4359 if (! NILP (current_buffer
->enable_multibyte_characters
))
4360 while (same_at_end
< ZV_BYTE
4361 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4364 /* Don't try to reuse the same piece of text twice. */
4365 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4367 same_at_end
+= overlap
;
4369 /* If display currently starts at beginning of line,
4370 keep it that way. */
4371 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4372 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4374 /* Replace the chars that we need to replace,
4375 and update INSERTED to equal the number of bytes
4376 we are taking from the decoded string. */
4377 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4379 if (same_at_end
!= same_at_start
)
4381 del_range_byte (same_at_start
, same_at_end
, 0);
4383 same_at_start
= GPT_BYTE
;
4387 temp
= BYTE_TO_CHAR (same_at_start
);
4389 /* Insert from the file at the proper position. */
4390 SET_PT_BOTH (temp
, same_at_start
);
4391 same_at_start_charpos
4392 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4395 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4396 same_at_start
+ inserted
)
4397 - same_at_start_charpos
);
4398 insert_from_buffer (XBUFFER (conversion_buffer
),
4399 same_at_start_charpos
, inserted_chars
, 0);
4400 /* Set `inserted' to the number of inserted characters. */
4401 inserted
= PT
- temp
;
4403 unbind_to (this_count
, Qnil
);
4410 register Lisp_Object temp
;
4412 total
= XINT (end
) - XINT (beg
);
4414 /* Make sure point-max won't overflow after this insertion. */
4415 XSETINT (temp
, total
);
4416 if (total
!= XINT (temp
))
4417 error ("Maximum buffer size exceeded");
4420 /* For a special file, all we can do is guess. */
4421 total
= READ_BUF_SIZE
;
4423 if (NILP (visit
) && inserted
> 0)
4425 #ifdef CLASH_DETECTION
4426 if (!NILP (current_buffer
->file_truename
)
4427 /* Make binding buffer-file-name to nil effective. */
4428 && !NILP (current_buffer
->filename
)
4429 && SAVE_MODIFF
>= MODIFF
)
4431 #endif /* CLASH_DETECTION */
4432 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
4436 if (GAP_SIZE
< total
)
4437 make_gap (total
- GAP_SIZE
);
4439 if (XINT (beg
) != 0 || !NILP (replace
))
4441 if (lseek (fd
, XINT (beg
), 0) < 0)
4442 report_file_error ("Setting file position",
4443 Fcons (orig_filename
, Qnil
));
4446 /* In the following loop, HOW_MUCH contains the total bytes read so
4447 far for a regular file, and not changed for a special file. But,
4448 before exiting the loop, it is set to a negative value if I/O
4452 /* Total bytes inserted. */
4455 /* Here, we don't do code conversion in the loop. It is done by
4456 decode_coding_gap after all data are read into the buffer. */
4458 int gap_size
= GAP_SIZE
;
4460 while (how_much
< total
)
4462 /* try is reserved in some compilers (Microsoft C) */
4463 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4470 /* Maybe make more room. */
4471 if (gap_size
< trytry
)
4473 make_gap (total
- gap_size
);
4474 gap_size
= GAP_SIZE
;
4477 /* Read from the file, capturing `quit'. When an
4478 error occurs, end the loop, and arrange for a quit
4479 to be signaled after decoding the text we read. */
4480 non_regular_fd
= fd
;
4481 non_regular_inserted
= inserted
;
4482 non_regular_nbytes
= trytry
;
4483 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4484 read_non_regular_quit
);
4495 /* Allow quitting out of the actual I/O. We don't make text
4496 part of the buffer until all the reading is done, so a C-g
4497 here doesn't do any harm. */
4500 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4512 /* For a regular file, where TOTAL is the real size,
4513 count HOW_MUCH to compare with it.
4514 For a special file, where TOTAL is just a buffer size,
4515 so don't bother counting in HOW_MUCH.
4516 (INSERTED is where we count the number of characters inserted.) */
4523 /* Now we have read all the file data into the gap.
4524 If it was empty, undo marking the buffer modified. */
4528 #ifdef CLASH_DETECTION
4530 unlock_file (current_buffer
->file_truename
);
4532 Vdeactivate_mark
= old_Vdeactivate_mark
;
4535 /* Make the text read part of the buffer. */
4536 GAP_SIZE
-= inserted
;
4538 GPT_BYTE
+= inserted
;
4540 ZV_BYTE
+= inserted
;
4545 /* Put an anchor to ensure multi-byte form ends at gap. */
4550 /* Discard the unwind protect for closing the file. */
4554 error ("IO error reading %s: %s",
4555 SDATA (orig_filename
), emacs_strerror (errno
));
4559 if (NILP (coding_system
))
4561 /* The coding system is not yet decided. Decide it by an
4562 optimized method for handling `coding:' tag.
4564 Note that we can get here only if the buffer was empty
4565 before the insertion. */
4567 if (!NILP (Vcoding_system_for_read
))
4568 coding_system
= Vcoding_system_for_read
;
4571 /* Since we are sure that the current buffer was empty
4572 before the insertion, we can toggle
4573 enable-multibyte-characters directly here without taking
4574 care of marker adjustment. By this way, we can run Lisp
4575 program safely before decoding the inserted text. */
4576 Lisp_Object unwind_data
;
4577 int count
= SPECPDL_INDEX ();
4579 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4580 Fcons (current_buffer
->undo_list
,
4581 Fcurrent_buffer ()));
4582 current_buffer
->enable_multibyte_characters
= Qnil
;
4583 current_buffer
->undo_list
= Qt
;
4584 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4586 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4588 coding_system
= call2 (Vset_auto_coding_function
,
4589 filename
, make_number (inserted
));
4592 if (NILP (coding_system
))
4594 /* If the coding system is not yet decided, check
4595 file-coding-system-alist. */
4596 Lisp_Object args
[6];
4598 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4599 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4600 coding_system
= Ffind_operation_coding_system (6, args
);
4601 if (CONSP (coding_system
))
4602 coding_system
= XCAR (coding_system
);
4604 unbind_to (count
, Qnil
);
4605 inserted
= Z_BYTE
- BEG_BYTE
;
4608 if (NILP (coding_system
))
4609 coding_system
= Qundecided
;
4611 CHECK_CODING_SYSTEM (coding_system
);
4613 if (NILP (current_buffer
->enable_multibyte_characters
))
4614 /* We must suppress all character code conversion except for
4615 end-of-line conversion. */
4616 coding_system
= raw_text_coding_system (coding_system
);
4617 setup_coding_system (coding_system
, &coding
);
4618 /* Ensure we set Vlast_coding_system_used. */
4619 set_coding_system
= 1;
4624 /* When we visit a file by raw-text, we change the buffer to
4626 if (CODING_FOR_UNIBYTE (&coding
)
4627 /* Can't do this if part of the buffer might be preserved. */
4629 /* Visiting a file with these coding system makes the buffer
4631 current_buffer
->enable_multibyte_characters
= Qnil
;
4634 coding
.dst_multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
4635 if (CODING_MAY_REQUIRE_DECODING (&coding
)
4636 && (inserted
> 0 || CODING_REQUIRE_FLUSHING (&coding
)))
4638 move_gap_both (PT
, PT_BYTE
);
4639 GAP_SIZE
+= inserted
;
4640 ZV_BYTE
-= inserted
;
4644 decode_coding_gap (&coding
, inserted
, inserted
);
4645 inserted
= coding
.produced_char
;
4646 coding_system
= CODING_ID_NAME (coding
.id
);
4648 else if (inserted
> 0)
4649 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4652 /* Now INSERTED is measured in characters. */
4655 /* Use the conversion type to determine buffer-file-type
4656 (find-buffer-file-type is now used to help determine the
4658 if ((VECTORP (CODING_ID_EOL_TYPE (coding
.id
))
4659 || EQ (CODING_ID_EOL_TYPE (coding
.id
), Qunix
))
4660 && ! CODING_REQUIRE_DECODING (&coding
))
4661 current_buffer
->buffer_file_type
= Qt
;
4663 current_buffer
->buffer_file_type
= Qnil
;
4670 if (!EQ (current_buffer
->undo_list
, Qt
))
4671 current_buffer
->undo_list
= Qnil
;
4673 stat (SDATA (filename
), &st
);
4678 current_buffer
->modtime
= st
.st_mtime
;
4679 current_buffer
->filename
= orig_filename
;
4682 SAVE_MODIFF
= MODIFF
;
4683 current_buffer
->auto_save_modified
= MODIFF
;
4684 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4685 #ifdef CLASH_DETECTION
4688 if (!NILP (current_buffer
->file_truename
))
4689 unlock_file (current_buffer
->file_truename
);
4690 unlock_file (filename
);
4692 #endif /* CLASH_DETECTION */
4694 Fsignal (Qfile_error
,
4695 Fcons (build_string ("not a regular file"),
4696 Fcons (orig_filename
, Qnil
)));
4699 if (set_coding_system
)
4700 Vlast_coding_system_used
= coding_system
;
4702 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4704 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4706 if (! NILP (insval
))
4708 CHECK_NUMBER (insval
);
4709 inserted
= XFASTINT (insval
);
4713 /* Decode file format */
4716 int empty_undo_list_p
= 0;
4718 /* If we're anyway going to discard undo information, don't
4719 record it in the first place. The buffer's undo list at this
4720 point is either nil or t when visiting a file. */
4723 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4724 current_buffer
->undo_list
= Qt
;
4727 insval
= call3 (Qformat_decode
,
4728 Qnil
, make_number (inserted
), visit
);
4729 CHECK_NUMBER (insval
);
4730 inserted
= XFASTINT (insval
);
4733 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4736 /* Call after-change hooks for the inserted text, aside from the case
4737 of normal visiting (not with REPLACE), which is done in a new buffer
4738 "before" the buffer is changed. */
4739 if (inserted
> 0 && total
> 0
4740 && (NILP (visit
) || !NILP (replace
)))
4742 signal_after_change (PT
, 0, inserted
);
4743 update_compositions (PT
, PT
, CHECK_BORDER
);
4746 p
= Vafter_insert_file_functions
;
4749 insval
= call1 (XCAR (p
), make_number (inserted
));
4752 CHECK_NUMBER (insval
);
4753 inserted
= XFASTINT (insval
);
4760 && current_buffer
->modtime
== -1)
4762 /* If visiting nonexistent file, return nil. */
4763 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4767 Fsignal (Qquit
, Qnil
);
4769 /* ??? Retval needs to be dealt with in all cases consistently. */
4771 val
= Fcons (orig_filename
,
4772 Fcons (make_number (inserted
),
4775 RETURN_UNGCPRO (unbind_to (count
, val
));
4778 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4780 /* If build_annotations switched buffers, switch back to BUF.
4781 Kill the temporary buffer that was selected in the meantime.
4783 Since this kill only the last temporary buffer, some buffers remain
4784 not killed if build_annotations switched buffers more than once.
4788 build_annotations_unwind (buf
)
4793 if (XBUFFER (buf
) == current_buffer
)
4795 tembuf
= Fcurrent_buffer ();
4797 Fkill_buffer (tembuf
);
4801 /* Decide the coding-system to encode the data with. */
4804 choose_write_coding_system (start
, end
, filename
,
4805 append
, visit
, lockname
, coding
)
4806 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4807 struct coding_system
*coding
;
4812 && NILP (Fstring_equal (current_buffer
->filename
,
4813 current_buffer
->auto_save_file_name
)))
4815 else if (!NILP (Vcoding_system_for_write
))
4817 val
= Vcoding_system_for_write
;
4818 if (coding_system_require_warning
4819 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4820 /* Confirm that VAL can surely encode the current region. */
4821 val
= call5 (Vselect_safe_coding_system_function
,
4822 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4827 /* If the variable `buffer-file-coding-system' is set locally,
4828 it means that the file was read with some kind of code
4829 conversion or the variable is explicitly set by users. We
4830 had better write it out with the same coding system even if
4831 `enable-multibyte-characters' is nil.
4833 If it is not set locally, we anyway have to convert EOL
4834 format if the default value of `buffer-file-coding-system'
4835 tells that it is not Unix-like (LF only) format. */
4836 int using_default_coding
= 0;
4837 int force_raw_text
= 0;
4839 val
= current_buffer
->buffer_file_coding_system
;
4841 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4844 if (NILP (current_buffer
->enable_multibyte_characters
))
4850 /* Check file-coding-system-alist. */
4851 Lisp_Object args
[7], coding_systems
;
4853 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4854 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4856 coding_systems
= Ffind_operation_coding_system (7, args
);
4857 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4858 val
= XCDR (coding_systems
);
4863 /* If we still have not decided a coding system, use the
4864 default value of buffer-file-coding-system. */
4865 val
= current_buffer
->buffer_file_coding_system
;
4866 using_default_coding
= 1;
4869 if (! NILP (val
) && ! force_raw_text
)
4871 Lisp_Object spec
, attrs
;
4873 CHECK_CODING_SYSTEM_GET_SPEC (val
, spec
);
4874 attrs
= AREF (spec
, 0);
4875 if (EQ (CODING_ATTR_TYPE (attrs
), Qraw_text
))
4880 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4881 /* Confirm that VAL can surely encode the current region. */
4882 val
= call5 (Vselect_safe_coding_system_function
,
4883 start
, end
, val
, Qnil
, filename
);
4885 /* If the decided coding-system doesn't specify end-of-line
4886 format, we use that of
4887 `default-buffer-file-coding-system'. */
4888 if (! using_default_coding
4889 && ! NILP (buffer_defaults
.buffer_file_coding_system
))
4890 val
= (coding_inherit_eol_type
4891 (val
, buffer_defaults
.buffer_file_coding_system
));
4893 /* If we decide not to encode text, use `raw-text' or one of its
4896 val
= raw_text_coding_system (val
);
4899 setup_coding_system (val
, coding
);
4901 && VECTORP (CODING_ID_EOL_TYPE (coding
->id
)))
4902 val
= AREF (CODING_ID_EOL_TYPE (coding
->id
), 0);
4904 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4905 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4909 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4910 "r\nFWrite region to file: \ni\ni\ni\np",
4911 doc
: /* Write current region into specified file.
4912 When called from a program, requires three arguments:
4913 START, END and FILENAME. START and END are normally buffer positions
4914 specifying the part of the buffer to write.
4915 If START is nil, that means to use the entire buffer contents.
4916 If START is a string, then output that string to the file
4917 instead of any buffer contents; END is ignored.
4919 Optional fourth argument APPEND if non-nil means
4920 append to existing file contents (if any). If it is an integer,
4921 seek to that offset in the file before writing.
4922 Optional fifth argument VISIT, if t or a string, means
4923 set the last-save-file-modtime of buffer to this file's modtime
4924 and mark buffer not modified.
4925 If VISIT is a string, it is a second file name;
4926 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4927 VISIT is also the file name to lock and unlock for clash detection.
4928 If VISIT is neither t nor nil nor a string,
4929 that means do not display the \"Wrote file\" message.
4930 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4931 use for locking and unlocking, overriding FILENAME and VISIT.
4932 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4933 for an existing file with the same name. If MUSTBENEW is `excl',
4934 that means to get an error if the file already exists; never overwrite.
4935 If MUSTBENEW is neither nil nor `excl', that means ask for
4936 confirmation before overwriting, but do go ahead and overwrite the file
4937 if the user confirms.
4939 This does code conversion according to the value of
4940 `coding-system-for-write', `buffer-file-coding-system', or
4941 `file-coding-system-alist', and sets the variable
4942 `last-coding-system-used' to the coding system actually used. */)
4943 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4944 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4949 const unsigned char *fn
;
4951 int count
= SPECPDL_INDEX ();
4954 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4956 Lisp_Object handler
;
4957 Lisp_Object visit_file
;
4958 Lisp_Object annotations
;
4959 Lisp_Object encoded_filename
;
4960 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4961 int quietly
= !NILP (visit
);
4962 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4963 struct buffer
*given_buffer
;
4965 int buffer_file_type
= O_BINARY
;
4967 struct coding_system coding
;
4969 if (current_buffer
->base_buffer
&& visiting
)
4970 error ("Cannot do file visiting in an indirect buffer");
4972 if (!NILP (start
) && !STRINGP (start
))
4973 validate_region (&start
, &end
);
4975 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4977 filename
= Fexpand_file_name (filename
, Qnil
);
4979 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4980 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4982 if (STRINGP (visit
))
4983 visit_file
= Fexpand_file_name (visit
, Qnil
);
4985 visit_file
= filename
;
4987 if (NILP (lockname
))
4988 lockname
= visit_file
;
4992 /* If the file name has special constructs in it,
4993 call the corresponding file handler. */
4994 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4995 /* If FILENAME has no handler, see if VISIT has one. */
4996 if (NILP (handler
) && STRINGP (visit
))
4997 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4999 if (!NILP (handler
))
5002 val
= call6 (handler
, Qwrite_region
, start
, end
,
5003 filename
, append
, visit
);
5007 SAVE_MODIFF
= MODIFF
;
5008 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5009 current_buffer
->filename
= visit_file
;
5015 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
5017 /* Special kludge to simplify auto-saving. */
5020 XSETFASTINT (start
, BEG
);
5021 XSETFASTINT (end
, Z
);
5025 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
5026 count1
= SPECPDL_INDEX ();
5028 given_buffer
= current_buffer
;
5030 if (!STRINGP (start
))
5032 annotations
= build_annotations (start
, end
);
5034 if (current_buffer
!= given_buffer
)
5036 XSETFASTINT (start
, BEGV
);
5037 XSETFASTINT (end
, ZV
);
5043 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
5045 /* Decide the coding-system to encode the data with.
5046 We used to make this choice before calling build_annotations, but that
5047 leads to problems when a write-annotate-function takes care of
5048 unsavable chars (as was the case with X-Symbol). */
5049 Vlast_coding_system_used
5050 = choose_write_coding_system (start
, end
, filename
,
5051 append
, visit
, lockname
, &coding
);
5053 #ifdef CLASH_DETECTION
5056 #if 0 /* This causes trouble for GNUS. */
5057 /* If we've locked this file for some other buffer,
5058 query before proceeding. */
5059 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5060 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5063 lock_file (lockname
);
5065 #endif /* CLASH_DETECTION */
5067 encoded_filename
= ENCODE_FILE (filename
);
5069 fn
= SDATA (encoded_filename
);
5073 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5074 #else /* not DOS_NT */
5075 desc
= emacs_open (fn
, O_WRONLY
, 0);
5076 #endif /* not DOS_NT */
5078 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5080 if (auto_saving
) /* Overwrite any previous version of autosave file */
5082 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5083 desc
= emacs_open (fn
, O_RDWR
, 0);
5085 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5086 ? SDATA (current_buffer
->filename
) : 0,
5089 else /* Write to temporary name and rename if no errors */
5091 Lisp_Object temp_name
;
5092 temp_name
= Ffile_name_directory (filename
);
5094 if (!NILP (temp_name
))
5096 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5097 build_string ("$$SAVE$$")));
5098 fname
= SDATA (filename
);
5099 fn
= SDATA (temp_name
);
5100 desc
= creat_copy_attrs (fname
, fn
);
5103 /* If we can't open the temporary file, try creating a new
5104 version of the original file. VMS "creat" creates a
5105 new version rather than truncating an existing file. */
5108 desc
= creat (fn
, 0666);
5109 #if 0 /* This can clobber an existing file and fail to replace it,
5110 if the user runs out of space. */
5113 /* We can't make a new version;
5114 try to truncate and rewrite existing version if any. */
5116 desc
= emacs_open (fn
, O_RDWR
, 0);
5122 desc
= creat (fn
, 0666);
5126 desc
= emacs_open (fn
,
5127 O_WRONLY
| O_CREAT
| buffer_file_type
5128 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5129 S_IREAD
| S_IWRITE
);
5130 #else /* not DOS_NT */
5131 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5132 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5133 auto_saving
? auto_save_mode_bits
: 0666);
5134 #endif /* not DOS_NT */
5135 #endif /* not VMS */
5139 #ifdef CLASH_DETECTION
5141 if (!auto_saving
) unlock_file (lockname
);
5143 #endif /* CLASH_DETECTION */
5145 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5148 record_unwind_protect (close_file_unwind
, make_number (desc
));
5150 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5154 if (NUMBERP (append
))
5155 ret
= lseek (desc
, XINT (append
), 1);
5157 ret
= lseek (desc
, 0, 2);
5160 #ifdef CLASH_DETECTION
5161 if (!auto_saving
) unlock_file (lockname
);
5162 #endif /* CLASH_DETECTION */
5164 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5172 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5173 * if we do writes that don't end with a carriage return. Furthermore
5174 * it cannot handle writes of more then 16K. The modified
5175 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5176 * this EXCEPT for the last record (iff it doesn't end with a carriage
5177 * return). This implies that if your buffer doesn't end with a carriage
5178 * return, you get one free... tough. However it also means that if
5179 * we make two calls to sys_write (a la the following code) you can
5180 * get one at the gap as well. The easiest way to fix this (honest)
5181 * is to move the gap to the next newline (or the end of the buffer).
5186 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5187 move_gap (find_next_newline (GPT
, 1));
5190 /* The new encoding routine doesn't require the following. */
5192 /* Whether VMS or not, we must move the gap to the next of newline
5193 when we must put designation sequences at beginning of line. */
5194 if (INTEGERP (start
)
5195 && coding
.type
== coding_type_iso2022
5196 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5197 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5199 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5200 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5201 move_gap_both (PT
, PT_BYTE
);
5202 SET_PT_BOTH (opoint
, opoint_byte
);
5210 if (STRINGP (start
))
5212 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5213 &annotations
, &coding
);
5216 else if (XINT (start
) != XINT (end
))
5218 failure
= 0 > a_write (desc
, Qnil
,
5219 XINT (start
), XINT (end
) - XINT (start
),
5220 &annotations
, &coding
);
5225 /* If file was empty, still need to write the annotations */
5226 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5227 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5231 if (CODING_REQUIRE_FLUSHING (&coding
)
5232 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5235 /* We have to flush out a data. */
5236 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5237 failure
= 0 > e_write (desc
, Qnil
, 1, 1, &coding
);
5244 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5245 Disk full in NFS may be reported here. */
5246 /* mib says that closing the file will try to write as fast as NFS can do
5247 it, and that means the fsync here is not crucial for autosave files. */
5248 if (!auto_saving
&& !write_region_inhibit_fsync
&& fsync (desc
) < 0)
5250 /* If fsync fails with EINTR, don't treat that as serious. */
5252 failure
= 1, save_errno
= errno
;
5256 /* Spurious "file has changed on disk" warnings have been
5257 observed on Suns as well.
5258 It seems that `close' can change the modtime, under nfs.
5260 (This has supposedly been fixed in Sunos 4,
5261 but who knows about all the other machines with NFS?) */
5264 /* On VMS and APOLLO, must do the stat after the close
5265 since closing changes the modtime. */
5268 /* Recall that #if defined does not work on VMS. */
5275 /* NFS can report a write failure now. */
5276 if (emacs_close (desc
) < 0)
5277 failure
= 1, save_errno
= errno
;
5280 /* If we wrote to a temporary name and had no errors, rename to real name. */
5284 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5292 /* Discard the unwind protect for close_file_unwind. */
5293 specpdl_ptr
= specpdl
+ count1
;
5294 /* Restore the original current buffer. */
5295 visit_file
= unbind_to (count
, visit_file
);
5297 #ifdef CLASH_DETECTION
5299 unlock_file (lockname
);
5300 #endif /* CLASH_DETECTION */
5302 /* Do this before reporting IO error
5303 to avoid a "file has changed on disk" warning on
5304 next attempt to save. */
5306 current_buffer
->modtime
= st
.st_mtime
;
5309 error ("IO error writing %s: %s", SDATA (filename
),
5310 emacs_strerror (save_errno
));
5314 SAVE_MODIFF
= MODIFF
;
5315 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5316 current_buffer
->filename
= visit_file
;
5317 update_mode_lines
++;
5322 && ! NILP (Fstring_equal (current_buffer
->filename
,
5323 current_buffer
->auto_save_file_name
)))
5324 SAVE_MODIFF
= MODIFF
;
5330 message_with_string ((INTEGERP (append
)
5340 Lisp_Object
merge ();
5342 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5343 doc
: /* Return t if (car A) is numerically less than (car B). */)
5347 return Flss (Fcar (a
), Fcar (b
));
5350 /* Build the complete list of annotations appropriate for writing out
5351 the text between START and END, by calling all the functions in
5352 write-region-annotate-functions and merging the lists they return.
5353 If one of these functions switches to a different buffer, we assume
5354 that buffer contains altered text. Therefore, the caller must
5355 make sure to restore the current buffer in all cases,
5356 as save-excursion would do. */
5359 build_annotations (start
, end
)
5360 Lisp_Object start
, end
;
5362 Lisp_Object annotations
;
5364 struct gcpro gcpro1
, gcpro2
;
5365 Lisp_Object original_buffer
;
5366 int i
, used_global
= 0;
5368 XSETBUFFER (original_buffer
, current_buffer
);
5371 p
= Vwrite_region_annotate_functions
;
5372 GCPRO2 (annotations
, p
);
5375 struct buffer
*given_buffer
= current_buffer
;
5376 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5377 { /* Use the global value of the hook. */
5380 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5382 p
= Fappend (2, arg
);
5385 Vwrite_region_annotations_so_far
= annotations
;
5386 res
= call2 (XCAR (p
), start
, end
);
5387 /* If the function makes a different buffer current,
5388 assume that means this buffer contains altered text to be output.
5389 Reset START and END from the buffer bounds
5390 and discard all previous annotations because they should have
5391 been dealt with by this function. */
5392 if (current_buffer
!= given_buffer
)
5394 XSETFASTINT (start
, BEGV
);
5395 XSETFASTINT (end
, ZV
);
5398 Flength (res
); /* Check basic validity of return value */
5399 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5403 /* Now do the same for annotation functions implied by the file-format */
5404 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
5405 p
= current_buffer
->auto_save_file_format
;
5407 p
= current_buffer
->file_format
;
5408 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5410 struct buffer
*given_buffer
= current_buffer
;
5412 Vwrite_region_annotations_so_far
= annotations
;
5414 /* Value is either a list of annotations or nil if the function
5415 has written annotations to a temporary buffer, which is now
5417 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5418 original_buffer
, make_number (i
));
5419 if (current_buffer
!= given_buffer
)
5421 XSETFASTINT (start
, BEGV
);
5422 XSETFASTINT (end
, ZV
);
5427 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5435 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5436 If STRING is nil, POS is the character position in the current buffer.
5437 Intersperse with them the annotations from *ANNOT
5438 which fall within the range of POS to POS + NCHARS,
5439 each at its appropriate position.
5441 We modify *ANNOT by discarding elements as we use them up.
5443 The return value is negative in case of system call failure. */
5446 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5449 register int nchars
;
5452 struct coding_system
*coding
;
5456 int lastpos
= pos
+ nchars
;
5458 while (NILP (*annot
) || CONSP (*annot
))
5460 tem
= Fcar_safe (Fcar (*annot
));
5463 nextpos
= XFASTINT (tem
);
5465 /* If there are no more annotations in this range,
5466 output the rest of the range all at once. */
5467 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5468 return e_write (desc
, string
, pos
, lastpos
, coding
);
5470 /* Output buffer text up to the next annotation's position. */
5473 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5477 /* Output the annotation. */
5478 tem
= Fcdr (Fcar (*annot
));
5481 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5484 *annot
= Fcdr (*annot
);
5490 /* Write text in the range START and END into descriptor DESC,
5491 encoding them with coding system CODING. If STRING is nil, START
5492 and END are character positions of the current buffer, else they
5493 are indexes to the string STRING. */
5496 e_write (desc
, string
, start
, end
, coding
)
5500 struct coding_system
*coding
;
5502 if (STRINGP (string
))
5505 end
= SCHARS (string
);
5508 /* We used to have a code for handling selective display here. But,
5509 now it is handled within encode_coding. */
5513 if (STRINGP (string
))
5515 coding
->src_multibyte
= SCHARS (string
) < SBYTES (string
);
5516 if (CODING_REQUIRE_ENCODING (coding
))
5518 encode_coding_object (coding
, string
,
5519 start
, string_char_to_byte (string
, start
),
5520 end
, string_char_to_byte (string
, end
), Qt
);
5524 coding
->dst_object
= string
;
5525 coding
->consumed_char
= SCHARS (string
);
5526 coding
->produced
= SBYTES (string
);
5531 int start_byte
= CHAR_TO_BYTE (start
);
5532 int end_byte
= CHAR_TO_BYTE (end
);
5534 coding
->src_multibyte
= (end
- start
) < (end_byte
- start_byte
);
5535 if (CODING_REQUIRE_ENCODING (coding
))
5537 encode_coding_object (coding
, Fcurrent_buffer (),
5538 start
, start_byte
, end
, end_byte
, Qt
);
5542 coding
->dst_object
= Qnil
;
5543 coding
->dst_pos_byte
= start_byte
;
5544 if (start
>= GPT
|| end
<= GPT
)
5546 coding
->consumed_char
= end
- start
;
5547 coding
->produced
= end_byte
- start_byte
;
5551 coding
->consumed_char
= GPT
- start
;
5552 coding
->produced
= GPT_BYTE
- start_byte
;
5557 if (coding
->produced
> 0)
5561 STRINGP (coding
->dst_object
)
5562 ? SDATA (coding
->dst_object
)
5563 : BYTE_POS_ADDR (coding
->dst_pos_byte
),
5566 if (coding
->produced
)
5569 start
+= coding
->consumed_char
;
5575 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5576 Sverify_visited_file_modtime
, 1, 1, 0,
5577 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5578 This means that the file has not been changed since it was visited or saved.
5579 See Info node `(elisp)Modification Time' for more details. */)
5585 Lisp_Object handler
;
5586 Lisp_Object filename
;
5591 if (!STRINGP (b
->filename
)) return Qt
;
5592 if (b
->modtime
== 0) return Qt
;
5594 /* If the file name has special constructs in it,
5595 call the corresponding file handler. */
5596 handler
= Ffind_file_name_handler (b
->filename
,
5597 Qverify_visited_file_modtime
);
5598 if (!NILP (handler
))
5599 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5601 filename
= ENCODE_FILE (b
->filename
);
5603 if (stat (SDATA (filename
), &st
) < 0)
5605 /* If the file doesn't exist now and didn't exist before,
5606 we say that it isn't modified, provided the error is a tame one. */
5607 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5612 if (st
.st_mtime
== b
->modtime
5613 /* If both are positive, accept them if they are off by one second. */
5614 || (st
.st_mtime
> 0 && b
->modtime
> 0
5615 && (st
.st_mtime
== b
->modtime
+ 1
5616 || st
.st_mtime
== b
->modtime
- 1)))
5621 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5622 Sclear_visited_file_modtime
, 0, 0, 0,
5623 doc
: /* Clear out records of last mod time of visited file.
5624 Next attempt to save will certainly not complain of a discrepancy. */)
5627 current_buffer
->modtime
= 0;
5631 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5632 Svisited_file_modtime
, 0, 0, 0,
5633 doc
: /* Return the current buffer's recorded visited file modification time.
5634 The value is a list of the form (HIGH LOW), like the time values
5635 that `file-attributes' returns. If the current buffer has no recorded
5636 file modification time, this function returns 0.
5637 See Info node `(elisp)Modification Time' for more details. */)
5641 tcons
= long_to_cons ((unsigned long) current_buffer
->modtime
);
5643 return list2 (XCAR (tcons
), XCDR (tcons
));
5647 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5648 Sset_visited_file_modtime
, 0, 1, 0,
5649 doc
: /* Update buffer's recorded modification time from the visited file's time.
5650 Useful if the buffer was not read from the file normally
5651 or if the file itself has been changed for some known benign reason.
5652 An argument specifies the modification time value to use
5653 \(instead of that of the visited file), in the form of a list
5654 \(HIGH . LOW) or (HIGH LOW). */)
5656 Lisp_Object time_list
;
5658 if (!NILP (time_list
))
5659 current_buffer
->modtime
= cons_to_long (time_list
);
5662 register Lisp_Object filename
;
5664 Lisp_Object handler
;
5666 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5668 /* If the file name has special constructs in it,
5669 call the corresponding file handler. */
5670 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5671 if (!NILP (handler
))
5672 /* The handler can find the file name the same way we did. */
5673 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5675 filename
= ENCODE_FILE (filename
);
5677 if (stat (SDATA (filename
), &st
) >= 0)
5678 current_buffer
->modtime
= st
.st_mtime
;
5685 auto_save_error (error
)
5688 Lisp_Object args
[3], msg
;
5690 struct gcpro gcpro1
;
5696 args
[0] = build_string ("Auto-saving %s: %s");
5697 args
[1] = current_buffer
->name
;
5698 args
[2] = Ferror_message_string (error
);
5699 msg
= Fformat (3, args
);
5701 nbytes
= SBYTES (msg
);
5702 SAFE_ALLOCA (msgbuf
, char *, nbytes
);
5703 bcopy (SDATA (msg
), msgbuf
, nbytes
);
5705 for (i
= 0; i
< 3; ++i
)
5708 message2 (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5710 message2_nolog (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5711 Fsleep_for (make_number (1), Qnil
);
5725 auto_save_mode_bits
= 0666;
5727 /* Get visited file's mode to become the auto save file's mode. */
5728 if (! NILP (current_buffer
->filename
))
5730 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5731 /* But make sure we can overwrite it later! */
5732 auto_save_mode_bits
= st
.st_mode
| 0600;
5733 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5735 /* Remote files don't cooperate with stat. */
5736 auto_save_mode_bits
= XINT (modes
) | 0600;
5740 Fwrite_region (Qnil
, Qnil
,
5741 current_buffer
->auto_save_file_name
,
5742 Qnil
, Qlambda
, Qnil
, Qnil
);
5746 do_auto_save_unwind (arg
) /* used as unwind-protect function */
5749 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
5757 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5760 minibuffer_auto_raise
= XINT (value
);
5765 do_auto_save_make_dir (dir
)
5768 return call2 (Qmake_directory
, dir
, Qt
);
5772 do_auto_save_eh (ignore
)
5778 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5779 doc
: /* Auto-save all buffers that need it.
5780 This is all buffers that have auto-saving enabled
5781 and are changed since last auto-saved.
5782 Auto-saving writes the buffer into a file
5783 so that your editing is not lost if the system crashes.
5784 This file is not the file you visited; that changes only when you save.
5785 Normally we run the normal hook `auto-save-hook' before saving.
5787 A non-nil NO-MESSAGE argument means do not print any message if successful.
5788 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5789 (no_message
, current_only
)
5790 Lisp_Object no_message
, current_only
;
5792 struct buffer
*old
= current_buffer
, *b
;
5793 Lisp_Object tail
, buf
;
5795 int do_handled_files
;
5797 FILE *stream
= NULL
;
5798 int count
= SPECPDL_INDEX ();
5799 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5800 int old_message_p
= 0;
5801 struct gcpro gcpro1
, gcpro2
;
5803 if (max_specpdl_size
< specpdl_size
+ 40)
5804 max_specpdl_size
= specpdl_size
+ 40;
5809 if (NILP (no_message
))
5811 old_message_p
= push_message ();
5812 record_unwind_protect (pop_message_unwind
, Qnil
);
5815 /* Ordinarily don't quit within this function,
5816 but don't make it impossible to quit (in case we get hung in I/O). */
5820 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5821 point to non-strings reached from Vbuffer_alist. */
5823 if (!NILP (Vrun_hooks
))
5824 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5826 if (STRINGP (Vauto_save_list_file_name
))
5828 Lisp_Object listfile
;
5830 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5832 /* Don't try to create the directory when shutting down Emacs,
5833 because creating the directory might signal an error, and
5834 that would leave Emacs in a strange state. */
5835 if (!NILP (Vrun_hooks
))
5839 GCPRO2 (dir
, listfile
);
5840 dir
= Ffile_name_directory (listfile
);
5841 if (NILP (Ffile_directory_p (dir
)))
5842 internal_condition_case_1 (do_auto_save_make_dir
,
5843 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5848 stream
= fopen (SDATA (listfile
), "w");
5851 record_unwind_protect (do_auto_save_unwind
,
5852 make_save_value (stream
, 0));
5853 record_unwind_protect (do_auto_save_unwind_1
,
5854 make_number (minibuffer_auto_raise
));
5855 minibuffer_auto_raise
= 0;
5858 /* On first pass, save all files that don't have handlers.
5859 On second pass, save all files that do have handlers.
5861 If Emacs is crashing, the handlers may tweak what is causing
5862 Emacs to crash in the first place, and it would be a shame if
5863 Emacs failed to autosave perfectly ordinary files because it
5864 couldn't handle some ange-ftp'd file. */
5866 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5867 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5869 buf
= XCDR (XCAR (tail
));
5872 /* Record all the buffers that have auto save mode
5873 in the special file that lists them. For each of these buffers,
5874 Record visited name (if any) and auto save name. */
5875 if (STRINGP (b
->auto_save_file_name
)
5876 && stream
!= NULL
&& do_handled_files
== 0)
5878 if (!NILP (b
->filename
))
5880 fwrite (SDATA (b
->filename
), 1,
5881 SBYTES (b
->filename
), stream
);
5883 putc ('\n', stream
);
5884 fwrite (SDATA (b
->auto_save_file_name
), 1,
5885 SBYTES (b
->auto_save_file_name
), stream
);
5886 putc ('\n', stream
);
5889 if (!NILP (current_only
)
5890 && b
!= current_buffer
)
5893 /* Don't auto-save indirect buffers.
5894 The base buffer takes care of it. */
5898 /* Check for auto save enabled
5899 and file changed since last auto save
5900 and file changed since last real save. */
5901 if (STRINGP (b
->auto_save_file_name
)
5902 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5903 && b
->auto_save_modified
< BUF_MODIFF (b
)
5904 /* -1 means we've turned off autosaving for a while--see below. */
5905 && XINT (b
->save_length
) >= 0
5906 && (do_handled_files
5907 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5910 EMACS_TIME before_time
, after_time
;
5912 EMACS_GET_TIME (before_time
);
5914 /* If we had a failure, don't try again for 20 minutes. */
5915 if (b
->auto_save_failure_time
>= 0
5916 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5919 if ((XFASTINT (b
->save_length
) * 10
5920 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5921 /* A short file is likely to change a large fraction;
5922 spare the user annoying messages. */
5923 && XFASTINT (b
->save_length
) > 5000
5924 /* These messages are frequent and annoying for `*mail*'. */
5925 && !EQ (b
->filename
, Qnil
)
5926 && NILP (no_message
))
5928 /* It has shrunk too much; turn off auto-saving here. */
5929 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5930 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5932 minibuffer_auto_raise
= 0;
5933 /* Turn off auto-saving until there's a real save,
5934 and prevent any more warnings. */
5935 XSETINT (b
->save_length
, -1);
5936 Fsleep_for (make_number (1), Qnil
);
5939 set_buffer_internal (b
);
5940 if (!auto_saved
&& NILP (no_message
))
5941 message1 ("Auto-saving...");
5942 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5944 b
->auto_save_modified
= BUF_MODIFF (b
);
5945 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5946 set_buffer_internal (old
);
5948 EMACS_GET_TIME (after_time
);
5950 /* If auto-save took more than 60 seconds,
5951 assume it was an NFS failure that got a timeout. */
5952 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5953 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5957 /* Prevent another auto save till enough input events come in. */
5958 record_auto_save ();
5960 if (auto_saved
&& NILP (no_message
))
5964 /* If we are going to restore an old message,
5965 give time to read ours. */
5966 sit_for (1, 0, 0, 0, 0);
5970 /* If we displayed a message and then restored a state
5971 with no message, leave a "done" message on the screen. */
5972 message1 ("Auto-saving...done");
5977 /* This restores the message-stack status. */
5978 unbind_to (count
, Qnil
);
5982 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5983 Sset_buffer_auto_saved
, 0, 0, 0,
5984 doc
: /* Mark current buffer as auto-saved with its current text.
5985 No auto-save file will be written until the buffer changes again. */)
5988 current_buffer
->auto_save_modified
= MODIFF
;
5989 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5990 current_buffer
->auto_save_failure_time
= -1;
5994 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5995 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5996 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5999 current_buffer
->auto_save_failure_time
= -1;
6003 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6005 doc
: /* Return t if current buffer has been auto-saved recently.
6006 More precisely, if it has been auto-saved since last read from or saved
6007 in the visited file. If the buffer has no visited file,
6008 then any auto-save counts as "recent". */)
6011 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6014 /* Reading and completing file names */
6015 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
6017 /* In the string VAL, change each $ to $$ and return the result. */
6020 double_dollars (val
)
6023 register const unsigned char *old
;
6024 register unsigned char *new;
6028 osize
= SBYTES (val
);
6030 /* Count the number of $ characters. */
6031 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
6032 if (*old
++ == '$') count
++;
6036 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
6039 for (n
= osize
; n
> 0; n
--)
6053 read_file_name_cleanup (arg
)
6056 return (current_buffer
->directory
= arg
);
6059 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
6061 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
6062 (string
, dir
, action
)
6063 Lisp_Object string
, dir
, action
;
6064 /* action is nil for complete, t for return list of completions,
6065 lambda for verify final value */
6067 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
6069 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
6071 CHECK_STRING (string
);
6078 /* No need to protect ACTION--we only compare it with t and nil. */
6079 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6081 if (SCHARS (string
) == 0)
6083 if (EQ (action
, Qlambda
))
6091 orig_string
= string
;
6092 string
= Fsubstitute_in_file_name (string
);
6093 changed
= NILP (Fstring_equal (string
, orig_string
));
6094 name
= Ffile_name_nondirectory (string
);
6095 val
= Ffile_name_directory (string
);
6097 realdir
= Fexpand_file_name (val
, realdir
);
6102 specdir
= Ffile_name_directory (string
);
6103 val
= Ffile_name_completion (name
, realdir
);
6108 return double_dollars (string
);
6112 if (!NILP (specdir
))
6113 val
= concat2 (specdir
, val
);
6115 return double_dollars (val
);
6118 #endif /* not VMS */
6122 if (EQ (action
, Qt
))
6124 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6128 if (NILP (Vread_file_name_predicate
)
6129 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6133 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6135 /* Brute-force speed up for directory checking:
6136 Discard strings which don't end in a slash. */
6137 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6139 Lisp_Object tem
= XCAR (all
);
6141 if (STRINGP (tem
) &&
6142 (len
= SCHARS (tem
), len
> 0) &&
6143 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6144 comp
= Fcons (tem
, comp
);
6150 /* Must do it the hard (and slow) way. */
6151 GCPRO3 (all
, comp
, specdir
);
6152 count
= SPECPDL_INDEX ();
6153 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6154 current_buffer
->directory
= realdir
;
6155 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6156 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
6157 comp
= Fcons (XCAR (all
), comp
);
6158 unbind_to (count
, Qnil
);
6161 return Fnreverse (comp
);
6164 /* Only other case actually used is ACTION = lambda */
6166 /* Supposedly this helps commands such as `cd' that read directory names,
6167 but can someone explain how it helps them? -- RMS */
6168 if (SCHARS (name
) == 0)
6171 string
= Fexpand_file_name (string
, dir
);
6172 if (!NILP (Vread_file_name_predicate
))
6173 return call1 (Vread_file_name_predicate
, string
);
6174 return Ffile_exists_p (string
);
6177 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
6178 Snext_read_file_uses_dialog_p
, 0, 0, 0,
6179 doc
: /* Return t if a call to `read-file-name' will use a dialog.
6180 The return value is only relevant for a call to `read-file-name' that happens
6181 before any other event (mouse or keypress) is handeled. */)
6184 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6185 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6194 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6195 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6196 Value is not expanded---you must call `expand-file-name' yourself.
6197 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6198 the same non-empty string that was inserted by this function.
6199 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6200 except that if INITIAL is specified, that combined with DIR is used.)
6201 If the user exits with an empty minibuffer, this function returns
6202 an empty string. (This can only happen if the user erased the
6203 pre-inserted contents or if `insert-default-directory' is nil.)
6204 Fourth arg MUSTMATCH non-nil means require existing file's name.
6205 Non-nil and non-t means also require confirmation after completion.
6206 Fifth arg INITIAL specifies text to start with.
6207 If optional sixth arg PREDICATE is non-nil, possible completions and
6208 the resulting file name must satisfy (funcall PREDICATE NAME).
6209 DIR should be an absolute directory name. It defaults to the value of
6210 `default-directory'.
6212 If this command was invoked with the mouse, use a file dialog box if
6213 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6214 provides a file dialog box.
6216 See also `read-file-name-completion-ignore-case'
6217 and `read-file-name-function'. */)
6218 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6219 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6221 Lisp_Object val
, insdef
, tem
;
6222 struct gcpro gcpro1
, gcpro2
;
6223 register char *homedir
;
6224 Lisp_Object decoded_homedir
;
6225 int replace_in_history
= 0;
6226 int add_to_history
= 0;
6230 dir
= current_buffer
->directory
;
6231 if (NILP (Ffile_name_absolute_p (dir
)))
6232 dir
= Fexpand_file_name (dir
, Qnil
);
6233 if (NILP (default_filename
))
6236 ? Fexpand_file_name (initial
, dir
)
6237 : current_buffer
->filename
);
6239 /* If dir starts with user's homedir, change that to ~. */
6240 homedir
= (char *) egetenv ("HOME");
6242 /* homedir can be NULL in temacs, since Vprocess_environment is not
6243 yet set up. We shouldn't crash in that case. */
6246 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6247 CORRECT_DIR_SEPS (homedir
);
6252 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6255 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6256 SBYTES (decoded_homedir
))
6257 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6259 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6260 dir
= concat2 (build_string ("~"), dir
);
6262 /* Likewise for default_filename. */
6264 && STRINGP (default_filename
)
6265 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6266 SBYTES (decoded_homedir
))
6267 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6270 = Fsubstring (default_filename
,
6271 make_number (SCHARS (decoded_homedir
)), Qnil
);
6272 default_filename
= concat2 (build_string ("~"), default_filename
);
6274 if (!NILP (default_filename
))
6276 CHECK_STRING (default_filename
);
6277 default_filename
= double_dollars (default_filename
);
6280 if (insert_default_directory
&& STRINGP (dir
))
6283 if (!NILP (initial
))
6285 Lisp_Object args
[2], pos
;
6289 insdef
= Fconcat (2, args
);
6290 pos
= make_number (SCHARS (double_dollars (dir
)));
6291 insdef
= Fcons (double_dollars (insdef
), pos
);
6294 insdef
= double_dollars (insdef
);
6296 else if (STRINGP (initial
))
6297 insdef
= Fcons (double_dollars (initial
), make_number (0));
6301 if (!NILP (Vread_file_name_function
))
6303 Lisp_Object args
[7];
6305 GCPRO2 (insdef
, default_filename
);
6306 args
[0] = Vread_file_name_function
;
6309 args
[3] = default_filename
;
6310 args
[4] = mustmatch
;
6312 args
[6] = predicate
;
6313 RETURN_UNGCPRO (Ffuncall (7, args
));
6316 count
= SPECPDL_INDEX ();
6317 specbind (intern ("completion-ignore-case"),
6318 read_file_name_completion_ignore_case
? Qt
: Qnil
);
6319 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6320 specbind (intern ("read-file-name-predicate"),
6321 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6323 GCPRO2 (insdef
, default_filename
);
6325 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6326 if (! NILP (Fnext_read_file_uses_dialog_p ()))
6328 /* If DIR contains a file name, split it. */
6330 file
= Ffile_name_nondirectory (dir
);
6331 if (SCHARS (file
) && NILP (default_filename
))
6333 default_filename
= file
;
6334 dir
= Ffile_name_directory (dir
);
6336 if (!NILP(default_filename
))
6337 default_filename
= Fexpand_file_name (default_filename
, dir
);
6338 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
,
6339 EQ (predicate
, Qfile_directory_p
) ? Qt
: Qnil
);
6344 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6345 dir
, mustmatch
, insdef
,
6346 Qfile_name_history
, default_filename
, Qnil
);
6348 tem
= Fsymbol_value (Qfile_name_history
);
6349 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6350 replace_in_history
= 1;
6352 /* If Fcompleting_read returned the inserted default string itself
6353 (rather than a new string with the same contents),
6354 it has to mean that the user typed RET with the minibuffer empty.
6355 In that case, we really want to return ""
6356 so that commands such as set-visited-file-name can distinguish. */
6357 if (EQ (val
, default_filename
))
6359 /* In this case, Fcompleting_read has not added an element
6360 to the history. Maybe we should. */
6361 if (! replace_in_history
)
6367 unbind_to (count
, Qnil
);
6370 error ("No file name specified");
6372 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6374 if (!NILP (tem
) && !NILP (default_filename
))
6375 val
= default_filename
;
6376 val
= Fsubstitute_in_file_name (val
);
6378 if (replace_in_history
)
6379 /* Replace what Fcompleting_read added to the history
6380 with what we will actually return. */
6382 Lisp_Object val1
= double_dollars (val
);
6383 tem
= Fsymbol_value (Qfile_name_history
);
6384 if (history_delete_duplicates
)
6385 XSETCDR (tem
, Fdelete (val1
, XCDR(tem
)));
6386 XSETCAR (tem
, val1
);
6388 else if (add_to_history
)
6390 /* Add the value to the history--but not if it matches
6391 the last value already there. */
6392 Lisp_Object val1
= double_dollars (val
);
6393 tem
= Fsymbol_value (Qfile_name_history
);
6394 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6396 if (history_delete_duplicates
) tem
= Fdelete (val1
, tem
);
6397 Fset (Qfile_name_history
, Fcons (val1
, tem
));
6408 /* Must be set before any path manipulation is performed. */
6409 XSETFASTINT (Vdirectory_sep_char
, '/');
6416 Qoperations
= intern ("operations");
6417 Qexpand_file_name
= intern ("expand-file-name");
6418 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6419 Qdirectory_file_name
= intern ("directory-file-name");
6420 Qfile_name_directory
= intern ("file-name-directory");
6421 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6422 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6423 Qfile_name_as_directory
= intern ("file-name-as-directory");
6424 Qcopy_file
= intern ("copy-file");
6425 Qmake_directory_internal
= intern ("make-directory-internal");
6426 Qmake_directory
= intern ("make-directory");
6427 Qdelete_directory
= intern ("delete-directory");
6428 Qdelete_file
= intern ("delete-file");
6429 Qrename_file
= intern ("rename-file");
6430 Qadd_name_to_file
= intern ("add-name-to-file");
6431 Qmake_symbolic_link
= intern ("make-symbolic-link");
6432 Qfile_exists_p
= intern ("file-exists-p");
6433 Qfile_executable_p
= intern ("file-executable-p");
6434 Qfile_readable_p
= intern ("file-readable-p");
6435 Qfile_writable_p
= intern ("file-writable-p");
6436 Qfile_symlink_p
= intern ("file-symlink-p");
6437 Qaccess_file
= intern ("access-file");
6438 Qfile_directory_p
= intern ("file-directory-p");
6439 Qfile_regular_p
= intern ("file-regular-p");
6440 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6441 Qfile_modes
= intern ("file-modes");
6442 Qset_file_modes
= intern ("set-file-modes");
6443 Qset_file_times
= intern ("set-file-times");
6444 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6445 Qinsert_file_contents
= intern ("insert-file-contents");
6446 Qwrite_region
= intern ("write-region");
6447 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6448 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6449 Qauto_save_coding
= intern ("auto-save-coding");
6451 staticpro (&Qoperations
);
6452 staticpro (&Qexpand_file_name
);
6453 staticpro (&Qsubstitute_in_file_name
);
6454 staticpro (&Qdirectory_file_name
);
6455 staticpro (&Qfile_name_directory
);
6456 staticpro (&Qfile_name_nondirectory
);
6457 staticpro (&Qunhandled_file_name_directory
);
6458 staticpro (&Qfile_name_as_directory
);
6459 staticpro (&Qcopy_file
);
6460 staticpro (&Qmake_directory_internal
);
6461 staticpro (&Qmake_directory
);
6462 staticpro (&Qdelete_directory
);
6463 staticpro (&Qdelete_file
);
6464 staticpro (&Qrename_file
);
6465 staticpro (&Qadd_name_to_file
);
6466 staticpro (&Qmake_symbolic_link
);
6467 staticpro (&Qfile_exists_p
);
6468 staticpro (&Qfile_executable_p
);
6469 staticpro (&Qfile_readable_p
);
6470 staticpro (&Qfile_writable_p
);
6471 staticpro (&Qaccess_file
);
6472 staticpro (&Qfile_symlink_p
);
6473 staticpro (&Qfile_directory_p
);
6474 staticpro (&Qfile_regular_p
);
6475 staticpro (&Qfile_accessible_directory_p
);
6476 staticpro (&Qfile_modes
);
6477 staticpro (&Qset_file_modes
);
6478 staticpro (&Qset_file_times
);
6479 staticpro (&Qfile_newer_than_file_p
);
6480 staticpro (&Qinsert_file_contents
);
6481 staticpro (&Qwrite_region
);
6482 staticpro (&Qverify_visited_file_modtime
);
6483 staticpro (&Qset_visited_file_modtime
);
6484 staticpro (&Qauto_save_coding
);
6486 Qfile_name_history
= intern ("file-name-history");
6487 Fset (Qfile_name_history
, Qnil
);
6488 staticpro (&Qfile_name_history
);
6490 Qfile_error
= intern ("file-error");
6491 staticpro (&Qfile_error
);
6492 Qfile_already_exists
= intern ("file-already-exists");
6493 staticpro (&Qfile_already_exists
);
6494 Qfile_date_error
= intern ("file-date-error");
6495 staticpro (&Qfile_date_error
);
6496 Qexcl
= intern ("excl");
6500 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6501 staticpro (&Qfind_buffer_file_type
);
6504 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6505 doc
: /* *Coding system for encoding file names.
6506 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6507 Vfile_name_coding_system
= Qnil
;
6509 DEFVAR_LISP ("default-file-name-coding-system",
6510 &Vdefault_file_name_coding_system
,
6511 doc
: /* Default coding system for encoding file names.
6512 This variable is used only when `file-name-coding-system' is nil.
6514 This variable is set/changed by the command `set-language-environment'.
6515 User should not set this variable manually,
6516 instead use `file-name-coding-system' to get a constant encoding
6517 of file names regardless of the current language environment. */);
6518 Vdefault_file_name_coding_system
= Qnil
;
6520 Qformat_decode
= intern ("format-decode");
6521 staticpro (&Qformat_decode
);
6522 Qformat_annotate_function
= intern ("format-annotate-function");
6523 staticpro (&Qformat_annotate_function
);
6524 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6525 staticpro (&Qafter_insert_file_set_coding
);
6527 Qcar_less_than_car
= intern ("car-less-than-car");
6528 staticpro (&Qcar_less_than_car
);
6530 Fput (Qfile_error
, Qerror_conditions
,
6531 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6532 Fput (Qfile_error
, Qerror_message
,
6533 build_string ("File error"));
6535 Fput (Qfile_already_exists
, Qerror_conditions
,
6536 Fcons (Qfile_already_exists
,
6537 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6538 Fput (Qfile_already_exists
, Qerror_message
,
6539 build_string ("File already exists"));
6541 Fput (Qfile_date_error
, Qerror_conditions
,
6542 Fcons (Qfile_date_error
,
6543 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6544 Fput (Qfile_date_error
, Qerror_message
,
6545 build_string ("Cannot set file date"));
6547 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6548 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6549 Vread_file_name_function
= Qnil
;
6551 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6552 doc
: /* Current predicate used by `read-file-name-internal'. */);
6553 Vread_file_name_predicate
= Qnil
;
6555 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case
,
6556 doc
: /* *Non-nil means when reading a file name completion ignores case. */);
6557 #if defined VMS || defined DOS_NT || defined MAC_OS
6558 read_file_name_completion_ignore_case
= 1;
6560 read_file_name_completion_ignore_case
= 0;
6563 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6564 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6565 If the initial minibuffer contents are non-empty, you can usually
6566 request a default filename by typing RETURN without editing. For some
6567 commands, exiting with an empty minibuffer has a special meaning,
6568 such as making the current buffer visit no file in the case of
6569 `set-visited-file-name'.
6570 If this variable is non-nil, the minibuffer contents are always
6571 initially non-empty and typing RETURN without editing will fetch the
6572 default name, if one is provided. Note however that this default name
6573 is not necessarily the name originally inserted in the minibuffer, if
6574 that is just the default directory.
6575 If this variable is nil, the minibuffer often starts out empty. In
6576 that case you may have to explicitly fetch the next history element to
6577 request the default name. */);
6578 insert_default_directory
= 1;
6580 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6581 doc
: /* *Non-nil means write new files with record format `stmlf'.
6582 nil means use format `var'. This variable is meaningful only on VMS. */);
6583 vms_stmlf_recfm
= 0;
6585 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6586 doc
: /* Directory separator character for built-in functions that return file names.
6587 The value is always ?/. Don't use this variable, just use `/'. */);
6589 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6590 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6591 If a file name matches REGEXP, then all I/O on that file is done by calling
6594 The first argument given to HANDLER is the name of the I/O primitive
6595 to be handled; the remaining arguments are the arguments that were
6596 passed to that primitive. For example, if you do
6597 (file-exists-p FILENAME)
6598 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6599 (funcall HANDLER 'file-exists-p FILENAME)
6600 The function `find-file-name-handler' checks this list for a handler
6601 for its argument. */);
6602 Vfile_name_handler_alist
= Qnil
;
6604 DEFVAR_LISP ("set-auto-coding-function",
6605 &Vset_auto_coding_function
,
6606 doc
: /* If non-nil, a function to call to decide a coding system of file.
6607 Two arguments are passed to this function: the file name
6608 and the length of a file contents following the point.
6609 This function should return a coding system to decode the file contents.
6610 It should check the file name against `auto-coding-alist'.
6611 If no coding system is decided, it should check a coding system
6612 specified in the heading lines with the format:
6613 -*- ... coding: CODING-SYSTEM; ... -*-
6614 or local variable spec of the tailing lines with `coding:' tag. */);
6615 Vset_auto_coding_function
= Qnil
;
6617 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6618 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6619 Each is passed one argument, the number of characters inserted.
6620 It should return the new character count, and leave point the same.
6621 If `insert-file-contents' is intercepted by a handler from
6622 `file-name-handler-alist', that handler is responsible for calling the
6623 functions in `after-insert-file-functions' if appropriate. */);
6624 Vafter_insert_file_functions
= Qnil
;
6626 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6627 doc
: /* A list of functions to be called at the start of `write-region'.
6628 Each is passed two arguments, START and END as for `write-region'.
6629 These are usually two numbers but not always; see the documentation
6630 for `write-region'. The function should return a list of pairs
6631 of the form (POSITION . STRING), consisting of strings to be effectively
6632 inserted at the specified positions of the file being written (1 means to
6633 insert before the first byte written). The POSITIONs must be sorted into
6634 increasing order. If there are several functions in the list, the several
6635 lists are merged destructively. Alternatively, the function can return
6636 with a different buffer current; in that case it should pay attention
6637 to the annotations returned by previous functions and listed in
6638 `write-region-annotations-so-far'.*/);
6639 Vwrite_region_annotate_functions
= Qnil
;
6640 staticpro (&Qwrite_region_annotate_functions
);
6641 Qwrite_region_annotate_functions
6642 = intern ("write-region-annotate-functions");
6644 DEFVAR_LISP ("write-region-annotations-so-far",
6645 &Vwrite_region_annotations_so_far
,
6646 doc
: /* When an annotation function is called, this holds the previous annotations.
6647 These are the annotations made by other annotation functions
6648 that were already called. See also `write-region-annotate-functions'. */);
6649 Vwrite_region_annotations_so_far
= Qnil
;
6651 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6652 doc
: /* A list of file name handlers that temporarily should not be used.
6653 This applies only to the operation `inhibit-file-name-operation'. */);
6654 Vinhibit_file_name_handlers
= Qnil
;
6656 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6657 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6658 Vinhibit_file_name_operation
= Qnil
;
6660 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6661 doc
: /* File name in which we write a list of all auto save file names.
6662 This variable is initialized automatically from `auto-save-list-file-prefix'
6663 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6664 a non-nil value. */);
6665 Vauto_save_list_file_name
= Qnil
;
6668 DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync
,
6669 doc
: /* *Non-nil means don't call fsync in `write-region'.
6670 This variable affects calls to `write-region' as well as save commands.
6671 A non-nil value may result in data loss! */);
6672 write_region_inhibit_fsync
= 0;
6675 defsubr (&Sfind_file_name_handler
);
6676 defsubr (&Sfile_name_directory
);
6677 defsubr (&Sfile_name_nondirectory
);
6678 defsubr (&Sunhandled_file_name_directory
);
6679 defsubr (&Sfile_name_as_directory
);
6680 defsubr (&Sdirectory_file_name
);
6681 defsubr (&Smake_temp_name
);
6682 defsubr (&Sexpand_file_name
);
6683 defsubr (&Ssubstitute_in_file_name
);
6684 defsubr (&Scopy_file
);
6685 defsubr (&Smake_directory_internal
);
6686 defsubr (&Sdelete_directory
);
6687 defsubr (&Sdelete_file
);
6688 defsubr (&Srename_file
);
6689 defsubr (&Sadd_name_to_file
);
6691 defsubr (&Smake_symbolic_link
);
6692 #endif /* S_IFLNK */
6694 defsubr (&Sdefine_logical_name
);
6697 defsubr (&Ssysnetunam
);
6698 #endif /* HPUX_NET */
6699 defsubr (&Sfile_name_absolute_p
);
6700 defsubr (&Sfile_exists_p
);
6701 defsubr (&Sfile_executable_p
);
6702 defsubr (&Sfile_readable_p
);
6703 defsubr (&Sfile_writable_p
);
6704 defsubr (&Saccess_file
);
6705 defsubr (&Sfile_symlink_p
);
6706 defsubr (&Sfile_directory_p
);
6707 defsubr (&Sfile_accessible_directory_p
);
6708 defsubr (&Sfile_regular_p
);
6709 defsubr (&Sfile_modes
);
6710 defsubr (&Sset_file_modes
);
6711 defsubr (&Sset_file_times
);
6712 defsubr (&Sset_default_file_modes
);
6713 defsubr (&Sdefault_file_modes
);
6714 defsubr (&Sfile_newer_than_file_p
);
6715 defsubr (&Sinsert_file_contents
);
6716 defsubr (&Swrite_region
);
6717 defsubr (&Scar_less_than_car
);
6718 defsubr (&Sverify_visited_file_modtime
);
6719 defsubr (&Sclear_visited_file_modtime
);
6720 defsubr (&Svisited_file_modtime
);
6721 defsubr (&Sset_visited_file_modtime
);
6722 defsubr (&Sdo_auto_save
);
6723 defsubr (&Sset_buffer_auto_saved
);
6724 defsubr (&Sclear_buffer_auto_save_failure
);
6725 defsubr (&Srecent_auto_save_p
);
6727 defsubr (&Sread_file_name_internal
);
6728 defsubr (&Sread_file_name
);
6729 defsubr (&Snext_read_file_uses_dialog_p
);
6732 defsubr (&Sunix_sync
);
6736 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6737 (do not change this comment) */