1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996,
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3, 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"
80 #include "blockinput.h"
87 #endif /* not WINDOWSNT */
91 #include <sys/param.h>
99 #define CORRECT_DIR_SEPS(s) \
100 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
101 else unixtodos_filename (s); \
103 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
104 redirector allows the six letters between 'Z' and 'a' as well. */
106 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
109 #define IS_DRIVE(x) isalpha (x)
111 /* Need to lower-case the drive letter, or else expanded
112 filenames will sometimes compare inequal, because
113 `expand-file-name' doesn't always down-case the drive letter. */
114 #define DRIVE_LETTER(x) (tolower (x))
135 #include "commands.h"
136 extern int use_dialog_box
;
137 extern int use_file_dialog
;
151 #ifndef FILE_SYSTEM_CASE
152 #define FILE_SYSTEM_CASE(filename) (filename)
155 /* Nonzero during writing of auto-save files */
158 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
159 a new file with the same mode as the original */
160 int auto_save_mode_bits
;
162 /* Set by auto_save_1 if an error occurred during the last auto-save. */
163 int auto_save_error_occurred
;
165 /* The symbol bound to coding-system-for-read when
166 insert-file-contents is called for recovering a file. This is not
167 an actual coding system name, but just an indicator to tell
168 insert-file-contents to use `emacs-mule' with a special flag for
169 auto saving and recovering a file. */
170 Lisp_Object Qauto_save_coding
;
172 /* Coding system for file names, or nil if none. */
173 Lisp_Object Vfile_name_coding_system
;
175 /* Coding system for file names used only when
176 Vfile_name_coding_system is nil. */
177 Lisp_Object Vdefault_file_name_coding_system
;
179 /* Alist of elements (REGEXP . HANDLER) for file names
180 whose I/O is done with a special handler. */
181 Lisp_Object Vfile_name_handler_alist
;
183 /* Property name of a file name handler,
184 which gives a list of operations it handles.. */
185 Lisp_Object Qoperations
;
187 /* Lisp functions for translating file formats */
188 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
190 /* Function to be called to decide a coding system of a reading file. */
191 Lisp_Object Vset_auto_coding_function
;
193 /* Functions to be called to process text properties in inserted file. */
194 Lisp_Object Vafter_insert_file_functions
;
196 /* Lisp function for setting buffer-file-coding-system and the
197 multibyteness of the current buffer after inserting a file. */
198 Lisp_Object Qafter_insert_file_set_coding
;
200 /* Functions to be called to create text property annotations for file. */
201 Lisp_Object Vwrite_region_annotate_functions
;
202 Lisp_Object Qwrite_region_annotate_functions
;
204 /* During build_annotations, each time an annotation function is called,
205 this holds the annotations made by the previous functions. */
206 Lisp_Object Vwrite_region_annotations_so_far
;
208 /* File name in which we write a list of all our auto save files. */
209 Lisp_Object Vauto_save_list_file_name
;
211 /* Function to call to read a file name. */
212 Lisp_Object Vread_file_name_function
;
214 /* Current predicate used by read_file_name_internal. */
215 Lisp_Object Vread_file_name_predicate
;
217 /* Nonzero means completion ignores case when reading file name. */
218 int read_file_name_completion_ignore_case
;
220 /* Nonzero means, when reading a filename in the minibuffer,
221 start out by inserting the default directory into the minibuffer. */
222 int insert_default_directory
;
224 /* On VMS, nonzero means write new files with record format stmlf.
225 Zero means use var format. */
228 /* On NT, specifies the directory separator character, used (eg.) when
229 expanding file names. This can be bound to / or \. */
230 Lisp_Object Vdirectory_sep_char
;
233 /* Nonzero means skip the call to fsync in Fwrite-region. */
234 int write_region_inhibit_fsync
;
237 extern Lisp_Object Vuser_login_name
;
240 extern Lisp_Object Vw32_get_true_file_attributes
;
243 extern int minibuf_level
;
245 extern int minibuffer_auto_raise
;
247 extern int history_delete_duplicates
;
249 /* These variables describe handlers that have "already" had a chance
250 to handle the current operation.
252 Vinhibit_file_name_handlers is a list of file name handlers.
253 Vinhibit_file_name_operation is the operation being handled.
254 If we try to handle that operation, we ignore those handlers. */
256 static Lisp_Object Vinhibit_file_name_handlers
;
257 static Lisp_Object Vinhibit_file_name_operation
;
259 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
261 Lisp_Object Qfile_name_history
;
263 Lisp_Object Qcar_less_than_car
;
265 static int a_write
P_ ((int, Lisp_Object
, int, int,
266 Lisp_Object
*, struct coding_system
*));
267 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
271 report_file_error (string
, data
)
275 Lisp_Object errstring
;
278 synchronize_system_messages_locale ();
279 errstring
= code_convert_string_norecord (build_string (strerror (errorno
)),
280 Vlocale_coding_system
, 0);
286 xsignal (Qfile_already_exists
, Fcons (errstring
, data
));
289 /* System error messages are capitalized. Downcase the initial
290 unless it is followed by a slash. */
291 if (SREF (errstring
, 1) != '/')
292 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
294 xsignal (Qfile_error
,
295 Fcons (build_string (string
), Fcons (errstring
, data
)));
300 close_file_unwind (fd
)
303 emacs_close (XFASTINT (fd
));
307 /* Restore point, having saved it as a marker. */
310 restore_point_unwind (location
)
311 Lisp_Object location
;
313 Fgoto_char (location
);
314 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 name.
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 or tilde); 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 */
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
);
1394 pw
= (struct passwd
*) getpwnam (o
+ 1);
1398 newdir
= (unsigned char *) pw
-> pw_dir
;
1400 nm
= p
+ 1; /* skip the terminator */
1404 collapse_newdir
= 0;
1409 /* If we don't find a user of that name, leave the name
1410 unchanged; don't move nm forward to p. */
1415 /* On DOS and Windows, nm is absolute if a drive name was specified;
1416 use the drive's current directory as the prefix if needed. */
1417 if (!newdir
&& drive
)
1419 /* Get default directory if needed to make nm absolute. */
1420 if (!IS_DIRECTORY_SEP (nm
[0]))
1422 newdir
= alloca (MAXPATHLEN
+ 1);
1423 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1428 /* Either nm starts with /, or drive isn't mounted. */
1429 newdir
= alloca (4);
1430 newdir
[0] = DRIVE_LETTER (drive
);
1438 /* Finally, if no prefix has been specified and nm is not absolute,
1439 then it must be expanded relative to default_directory. */
1443 /* /... alone is not absolute on DOS and Windows. */
1444 && !IS_DIRECTORY_SEP (nm
[0])
1447 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1454 newdir
= SDATA (default_directory
);
1455 multibyte
|= STRING_MULTIBYTE (default_directory
);
1457 /* Note if special escape prefix is present, but remove for now. */
1458 if (newdir
[0] == '/' && newdir
[1] == ':')
1469 /* First ensure newdir is an absolute name. */
1471 /* Detect MSDOS file names with drive specifiers. */
1472 ! (IS_DRIVE (newdir
[0])
1473 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1475 /* Detect Windows file names in UNC format. */
1476 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1480 /* Effectively, let newdir be (expand-file-name newdir cwd).
1481 Because of the admonition against calling expand-file-name
1482 when we have pointers into lisp strings, we accomplish this
1483 indirectly by prepending newdir to nm if necessary, and using
1484 cwd (or the wd of newdir's drive) as the new newdir. */
1486 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1491 if (!IS_DIRECTORY_SEP (nm
[0]))
1493 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1494 file_name_as_directory (tmp
, newdir
);
1498 newdir
= alloca (MAXPATHLEN
+ 1);
1501 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1508 /* Strip off drive name from prefix, if present. */
1509 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1515 /* Keep only a prefix from newdir if nm starts with slash
1516 (//server/share for UNC, nothing otherwise). */
1517 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1520 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1522 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1524 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1526 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1538 /* Get rid of any slash at the end of newdir, unless newdir is
1539 just / or // (an incomplete UNC name). */
1540 length
= strlen (newdir
);
1541 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1543 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1547 unsigned char *temp
= (unsigned char *) alloca (length
);
1548 bcopy (newdir
, temp
, length
- 1);
1549 temp
[length
- 1] = 0;
1557 /* Now concatenate the directory and name to new space in the stack frame */
1558 tlen
+= strlen (nm
) + 1;
1560 /* Reserve space for drive specifier and escape prefix, since either
1561 or both may need to be inserted. (The Microsoft x86 compiler
1562 produces incorrect code if the following two lines are combined.) */
1563 target
= (unsigned char *) alloca (tlen
+ 4);
1565 #else /* not DOS_NT */
1566 target
= (unsigned char *) alloca (tlen
);
1567 #endif /* not DOS_NT */
1573 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1576 /* If newdir is effectively "C:/", then the drive letter will have
1577 been stripped and newdir will be "/". Concatenating with an
1578 absolute directory in nm produces "//", which will then be
1579 incorrectly treated as a network share. Ignore newdir in
1580 this case (keeping the drive letter). */
1581 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1582 && newdir
[1] == '\0'))
1584 strcpy (target
, newdir
);
1588 file_name_as_directory (target
, newdir
);
1591 strcat (target
, nm
);
1593 if (index (target
, '/'))
1594 strcpy (target
, sys_translate_unix (target
));
1597 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1599 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1608 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1614 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1615 /* brackets are offset from each other by 2 */
1618 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1619 /* convert [foo][bar] to [bar] */
1620 while (o
[-1] != '[' && o
[-1] != '<')
1622 else if (*p
== '-' && *o
!= '.')
1625 else if (p
[0] == '-' && o
[-1] == '.'
1626 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1627 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1631 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1632 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1634 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1636 /* else [foo.-] ==> [-] */
1640 #ifdef NO_HYPHENS_IN_FILENAMES
1642 && o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.'
1643 && p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1645 #endif /* NO_HYPHENS_IN_FILENAMES */
1649 if (!IS_DIRECTORY_SEP (*p
))
1653 else if (p
[1] == '.'
1654 && (IS_DIRECTORY_SEP (p
[2])
1657 /* If "/." is the entire filename, keep the "/". Otherwise,
1658 just delete the whole "/.". */
1659 if (o
== target
&& p
[2] == '\0')
1663 else if (p
[1] == '.' && p
[2] == '.'
1664 /* `/../' is the "superroot" on certain file systems.
1665 Turned off on DOS_NT systems because they have no
1666 "superroot" and because this causes us to produce
1667 file names like "d:/../foo" which fail file-related
1668 functions of the underlying OS. (To reproduce, try a
1669 long series of "../../" in default_directory, longer
1670 than the number of levels from the root.) */
1674 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1676 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1678 /* Keep initial / only if this is the whole name. */
1679 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1683 else if (p
> target
&& IS_DIRECTORY_SEP (p
[1]))
1684 /* Collapse multiple `/' in a row. */
1690 #endif /* not VMS */
1694 /* At last, set drive name. */
1696 /* Except for network file name. */
1697 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1698 #endif /* WINDOWSNT */
1700 if (!drive
) abort ();
1702 target
[0] = DRIVE_LETTER (drive
);
1705 /* Reinsert the escape prefix if required. */
1712 CORRECT_DIR_SEPS (target
);
1715 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1717 /* Again look to see if the file name has special constructs in it
1718 and perhaps call the corresponding file handler. This is needed
1719 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1720 the ".." component gives us "/user@host:/bar/../baz" which needs
1721 to be expanded again. */
1722 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1723 if (!NILP (handler
))
1724 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1730 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1731 This is the old version of expand-file-name, before it was thoroughly
1732 rewritten for Emacs 10.31. We leave this version here commented-out,
1733 because the code is very complex and likely to have subtle bugs. If
1734 bugs _are_ found, it might be of interest to look at the old code and
1735 see what did it do in the relevant situation.
1737 Don't remove this code: it's true that it will be accessible via CVS,
1738 but a few years from deletion, people will forget it is there. */
1740 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1741 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1742 "Convert FILENAME to absolute, and canonicalize it.\n\
1743 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1744 \(does not start with slash); if DEFAULT is nil or missing,\n\
1745 the current buffer's value of default-directory is used.\n\
1746 Filenames containing `.' or `..' as components are simplified;\n\
1747 initial `~/' expands to your home directory.\n\
1748 See also the function `substitute-in-file-name'.")
1750 Lisp_Object name
, defalt
;
1754 register unsigned char *newdir
, *p
, *o
;
1756 unsigned char *target
;
1760 unsigned char * colon
= 0;
1761 unsigned char * close
= 0;
1762 unsigned char * slash
= 0;
1763 unsigned char * brack
= 0;
1764 int lbrack
= 0, rbrack
= 0;
1768 CHECK_STRING (name
);
1771 /* Filenames on VMS are always upper case. */
1772 name
= Fupcase (name
);
1777 /* If nm is absolute, flush ...// and detect /./ and /../.
1778 If no /./ or /../ we can return right away. */
1790 if (p
[0] == '/' && p
[1] == '/'
1792 /* // at start of filename is meaningful on Apollo system. */
1797 if (p
[0] == '/' && p
[1] == '~')
1798 nm
= p
+ 1, lose
= 1;
1799 if (p
[0] == '/' && p
[1] == '.'
1800 && (p
[2] == '/' || p
[2] == 0
1801 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1807 /* if dev:[dir]/, move nm to / */
1808 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1809 nm
= (brack
? brack
+ 1 : colon
+ 1);
1810 lbrack
= rbrack
= 0;
1818 /* VMS pre V4.4,convert '-'s in filenames. */
1819 if (lbrack
== rbrack
)
1821 if (dots
< 2) /* this is to allow negative version numbers */
1827 && ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<')
1828 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1834 /* count open brackets, reset close bracket pointer */
1835 if (p
[0] == '[' || p
[0] == '<')
1836 lbrack
++, brack
= 0;
1837 /* count close brackets, set close bracket pointer */
1838 if (p
[0] == ']' || p
[0] == '>')
1839 rbrack
++, brack
= p
;
1840 /* detect ][ or >< */
1841 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1843 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1844 nm
= p
+ 1, lose
= 1;
1845 if (p
[0] == ':' && (colon
|| slash
))
1846 /* if dev1:[dir]dev2:, move nm to dev2: */
1852 /* If /name/dev:, move nm to dev: */
1855 /* If node::dev:, move colon following dev */
1856 else if (colon
&& colon
[-1] == ':')
1858 /* If dev1:dev2:, move nm to dev2: */
1859 else if (colon
&& colon
[-1] != ':')
1864 if (p
[0] == ':' && !colon
)
1870 if (lbrack
== rbrack
)
1873 else if (p
[0] == '.')
1881 if (index (nm
, '/'))
1882 return build_string (sys_translate_unix (nm
));
1884 if (nm
== SDATA (name
))
1886 return build_string (nm
);
1890 /* Now determine directory to start with and put it in NEWDIR */
1894 if (nm
[0] == '~') /* prefix ~ */
1899 || nm
[1] == 0)/* ~/filename */
1901 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1902 newdir
= (unsigned char *) "";
1905 nm
++; /* Don't leave the slash in nm. */
1908 else /* ~user/filename */
1910 /* Get past ~ to user */
1911 unsigned char *user
= nm
+ 1;
1912 /* Find end of name. */
1913 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1914 int len
= ptr
? ptr
- user
: strlen (user
);
1916 unsigned char *ptr1
= index (user
, ':');
1917 if (ptr1
!= 0 && ptr1
- user
< len
)
1920 /* Copy the user name into temp storage. */
1921 o
= (unsigned char *) alloca (len
+ 1);
1922 bcopy ((char *) user
, o
, len
);
1925 /* Look up the user name. */
1927 pw
= (struct passwd
*) getpwnam (o
+ 1);
1930 error ("\"%s\" isn't a registered user", o
+ 1);
1932 newdir
= (unsigned char *) pw
->pw_dir
;
1934 /* Discard the user name from NM. */
1941 #endif /* not VMS */
1945 defalt
= current_buffer
->directory
;
1946 CHECK_STRING (defalt
);
1947 newdir
= SDATA (defalt
);
1950 /* Now concatenate the directory and name to new space in the stack frame */
1952 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1953 target
= (unsigned char *) alloca (tlen
);
1959 if (nm
[0] == 0 || nm
[0] == '/')
1960 strcpy (target
, newdir
);
1963 file_name_as_directory (target
, newdir
);
1966 strcat (target
, nm
);
1968 if (index (target
, '/'))
1969 strcpy (target
, sys_translate_unix (target
));
1972 /* Now canonicalize by removing /. and /foo/.. if they appear */
1980 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1986 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1987 /* brackets are offset from each other by 2 */
1990 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1991 /* convert [foo][bar] to [bar] */
1992 while (o
[-1] != '[' && o
[-1] != '<')
1994 else if (*p
== '-' && *o
!= '.')
1997 else if (p
[0] == '-' && o
[-1] == '.'
1998 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1999 /* flush .foo.- ; leave - if stopped by '[' or '<' */
2003 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
2004 if (p
[1] == '.') /* foo.-.bar ==> bar. */
2006 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
2008 /* else [foo.-] ==> [-] */
2014 && o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.'
2015 && p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2025 else if (!strncmp (p
, "//", 2)
2027 /* // at start of filename is meaningful in Apollo system. */
2035 else if (p
[0] == '/' && p
[1] == '.'
2036 && (p
[2] == '/' || p
[2] == 0))
2038 else if (!strncmp (p
, "/..", 3)
2039 /* `/../' is the "superroot" on certain file systems. */
2041 && (p
[3] == '/' || p
[3] == 0))
2043 while (o
!= target
&& *--o
!= '/')
2046 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2050 if (o
== target
&& *o
== '/')
2058 #endif /* not VMS */
2061 return make_string (target
, o
- target
);
2065 /* If /~ or // appears, discard everything through first slash. */
2067 file_name_absolute_p (filename
)
2068 const unsigned char *filename
;
2071 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
2073 /* ??? This criterion is probably wrong for '<'. */
2074 || index (filename
, ':') || index (filename
, '<')
2075 || (*filename
== '[' && (filename
[1] != '-'
2076 || (filename
[2] != '.' && filename
[2] != ']'))
2077 && filename
[1] != '.')
2080 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
2081 && IS_DIRECTORY_SEP (filename
[2]))
2086 static unsigned char *
2087 search_embedded_absfilename (nm
, endp
)
2088 unsigned char *nm
, *endp
;
2090 unsigned char *p
, *s
;
2092 for (p
= nm
+ 1; p
< endp
; p
++)
2096 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2098 || IS_DIRECTORY_SEP (p
[-1]))
2099 && file_name_absolute_p (p
)
2100 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2101 /* // at start of file name is meaningful in Apollo,
2102 WindowsNT and Cygwin systems. */
2103 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
2104 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2107 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2112 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2114 unsigned char *o
= alloca (s
- p
+ 1);
2116 bcopy (p
, o
, s
- p
);
2119 /* If we have ~user and `user' exists, discard
2120 everything up to ~. But if `user' does not exist, leave
2121 ~user alone, it might be a literal file name. */
2123 pw
= getpwnam (o
+ 1);
2135 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2136 Ssubstitute_in_file_name
, 1, 1, 0,
2137 doc
: /* Substitute environment variables referred to in FILENAME.
2138 `$FOO' where FOO is an environment variable name means to substitute
2139 the value of that variable. The variable name should be terminated
2140 with a character not a letter, digit or underscore; otherwise, enclose
2141 the entire variable name in braces.
2142 If `/~' appears, all of FILENAME through that `/' is discarded.
2144 On VMS, `$' substitution is not done; this function does little and only
2145 duplicates what `expand-file-name' does. */)
2147 Lisp_Object filename
;
2151 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2152 unsigned char *target
= NULL
;
2154 int substituted
= 0;
2156 Lisp_Object handler
;
2158 CHECK_STRING (filename
);
2160 /* If the file name has special constructs in it,
2161 call the corresponding file handler. */
2162 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2163 if (!NILP (handler
))
2164 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2166 nm
= SDATA (filename
);
2168 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2169 CORRECT_DIR_SEPS (nm
);
2170 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2172 endp
= nm
+ SBYTES (filename
);
2174 /* If /~ or // appears, discard everything through first slash. */
2175 p
= search_embedded_absfilename (nm
, endp
);
2177 /* Start over with the new string, so we check the file-name-handler
2178 again. Important with filenames like "/home/foo//:/hello///there"
2179 which whould substitute to "/:/hello///there" rather than "/there". */
2180 return Fsubstitute_in_file_name
2181 (make_specified_string (p
, -1, endp
- p
,
2182 STRING_MULTIBYTE (filename
)));
2188 /* See if any variables are substituted into the string
2189 and find the total length of their values in `total' */
2191 for (p
= nm
; p
!= endp
;)
2201 /* "$$" means a single "$" */
2210 while (p
!= endp
&& *p
!= '}') p
++;
2211 if (*p
!= '}') goto missingclose
;
2217 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2221 /* Copy out the variable name */
2222 target
= (unsigned char *) alloca (s
- o
+ 1);
2223 strncpy (target
, o
, s
- o
);
2226 strupr (target
); /* $home == $HOME etc. */
2229 /* Get variable value */
2230 o
= (unsigned char *) egetenv (target
);
2232 { /* Eight-bit chars occupy upto 2 bytes in multibyte. */
2233 total
+= strlen (o
) * (STRING_MULTIBYTE (filename
) ? 2 : 1);
2243 /* If substitution required, recopy the string and do it */
2244 /* Make space in stack frame for the new copy */
2245 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2248 /* Copy the rest of the name through, replacing $ constructs with values */
2265 while (p
!= endp
&& *p
!= '}') p
++;
2266 if (*p
!= '}') goto missingclose
;
2272 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2276 /* Copy out the variable name */
2277 target
= (unsigned char *) alloca (s
- o
+ 1);
2278 strncpy (target
, o
, s
- o
);
2281 strupr (target
); /* $home == $HOME etc. */
2284 /* Get variable value */
2285 o
= (unsigned char *) egetenv (target
);
2289 strcpy (x
, target
); x
+= strlen (target
);
2291 else if (STRING_MULTIBYTE (filename
))
2293 /* If the original string is multibyte,
2294 convert what we substitute into multibyte. */
2297 int c
= unibyte_char_to_multibyte (*o
++);
2298 x
+= CHAR_STRING (c
, x
);
2310 /* If /~ or // appears, discard everything through first slash. */
2311 while ((p
= search_embedded_absfilename (xnm
, x
)))
2312 /* This time we do not start over because we've already expanded envvars
2313 and replaced $$ with $. Maybe we should start over as well, but we'd
2314 need to quote some $ to $$ first. */
2317 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2320 error ("Bad format environment-variable substitution");
2322 error ("Missing \"}\" in environment-variable substitution");
2324 error ("Substituting nonexistent environment variable \"%s\"", target
);
2327 #endif /* not VMS */
2331 /* A slightly faster and more convenient way to get
2332 (directory-file-name (expand-file-name FOO)). */
2335 expand_and_dir_to_file (filename
, defdir
)
2336 Lisp_Object filename
, defdir
;
2338 register Lisp_Object absname
;
2340 absname
= Fexpand_file_name (filename
, defdir
);
2343 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2344 if (c
== ':' || c
== ']' || c
== '>')
2345 absname
= Fdirectory_file_name (absname
);
2348 /* Remove final slash, if any (unless this is the root dir).
2349 stat behaves differently depending! */
2350 if (SCHARS (absname
) > 1
2351 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2352 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2353 /* We cannot take shortcuts; they might be wrong for magic file names. */
2354 absname
= Fdirectory_file_name (absname
);
2359 /* Signal an error if the file ABSNAME already exists.
2360 If INTERACTIVE is nonzero, ask the user whether to proceed,
2361 and bypass the error if the user says to go ahead.
2362 QUERYSTRING is a name for the action that is being considered
2365 *STATPTR is used to store the stat information if the file exists.
2366 If the file does not exist, STATPTR->st_mode is set to 0.
2367 If STATPTR is null, we don't store into it.
2369 If QUICK is nonzero, we ask for y or n, not yes or no. */
2372 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2373 Lisp_Object absname
;
2374 unsigned char *querystring
;
2376 struct stat
*statptr
;
2379 register Lisp_Object tem
, encoded_filename
;
2380 struct stat statbuf
;
2381 struct gcpro gcpro1
;
2383 encoded_filename
= ENCODE_FILE (absname
);
2385 /* stat is a good way to tell whether the file exists,
2386 regardless of what access permissions it has. */
2387 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
2390 xsignal2 (Qfile_already_exists
,
2391 build_string ("File already exists"), absname
);
2393 tem
= format2 ("File %s already exists; %s anyway? ",
2394 absname
, build_string (querystring
));
2396 tem
= Fy_or_n_p (tem
);
2398 tem
= do_yes_or_no_p (tem
);
2401 xsignal2 (Qfile_already_exists
,
2402 build_string ("File already exists"), absname
);
2409 statptr
->st_mode
= 0;
2414 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 5,
2415 "fCopy file: \nGCopy %s to file: \np\nP",
2416 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2417 If NEWNAME names a directory, copy FILE there.
2419 This function always sets the file modes of the output file to match
2422 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
2423 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
2424 signal a `file-already-exists' error without overwriting. If
2425 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
2426 about overwriting; this is what happens in interactive use with M-x.
2427 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
2430 Fourth arg KEEP-TIME non-nil means give the output file the same
2431 last-modified time as the old one. (This works on only some systems.)
2433 A prefix arg makes KEEP-TIME non-nil.
2435 If PRESERVE-UID-GID is non-nil, we try to transfer the
2436 uid and gid of FILE to NEWNAME. */)
2437 (file
, newname
, ok_if_already_exists
, keep_time
, preserve_uid_gid
)
2438 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2439 Lisp_Object preserve_uid_gid
;
2442 char buf
[16 * 1024];
2443 struct stat st
, out_st
;
2444 Lisp_Object handler
;
2445 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2446 int count
= SPECPDL_INDEX ();
2447 int input_file_statable_p
;
2448 Lisp_Object encoded_file
, encoded_newname
;
2450 encoded_file
= encoded_newname
= Qnil
;
2451 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2452 CHECK_STRING (file
);
2453 CHECK_STRING (newname
);
2455 if (!NILP (Ffile_directory_p (newname
)))
2456 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2458 newname
= Fexpand_file_name (newname
, Qnil
);
2460 file
= Fexpand_file_name (file
, Qnil
);
2462 /* If the input file name has special constructs in it,
2463 call the corresponding file handler. */
2464 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2465 /* Likewise for output file name. */
2467 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2468 if (!NILP (handler
))
2469 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2470 ok_if_already_exists
, keep_time
));
2472 encoded_file
= ENCODE_FILE (file
);
2473 encoded_newname
= ENCODE_FILE (newname
);
2475 if (NILP (ok_if_already_exists
)
2476 || INTEGERP (ok_if_already_exists
))
2477 barf_or_query_if_file_exists (newname
, "copy to it",
2478 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2479 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2483 if (!CopyFile (SDATA (encoded_file
),
2484 SDATA (encoded_newname
),
2486 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2487 /* CopyFile retains the timestamp by default. */
2488 else if (NILP (keep_time
))
2494 EMACS_GET_TIME (now
);
2495 filename
= SDATA (encoded_newname
);
2497 /* Ensure file is writable while its modified time is set. */
2498 attributes
= GetFileAttributes (filename
);
2499 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2500 if (set_file_times (filename
, now
, now
))
2502 /* Restore original attributes. */
2503 SetFileAttributes (filename
, attributes
);
2504 xsignal2 (Qfile_date_error
,
2505 build_string ("Cannot set file date"), newname
);
2507 /* Restore original attributes. */
2508 SetFileAttributes (filename
, attributes
);
2510 #else /* not WINDOWSNT */
2512 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2516 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2518 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2520 /* We can only copy regular files and symbolic links. Other files are not
2522 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2524 #if !defined (MSDOS) || __DJGPP__ > 1
2525 if (out_st
.st_mode
!= 0
2526 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2529 report_file_error ("Input and output files are the same",
2530 Fcons (file
, Fcons (newname
, Qnil
)));
2534 #if defined (S_ISREG) && defined (S_ISLNK)
2535 if (input_file_statable_p
)
2537 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2539 #if defined (EISDIR)
2540 /* Get a better looking error message. */
2543 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2546 #endif /* S_ISREG && S_ISLNK */
2549 /* Create the copy file with the same record format as the input file */
2550 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2553 /* System's default file type was set to binary by _fmode in emacs.c. */
2554 ofd
= emacs_open (SDATA (encoded_newname
),
2555 O_WRONLY
| O_TRUNC
| O_CREAT
2556 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2557 S_IREAD
| S_IWRITE
);
2558 #else /* not MSDOS */
2559 ofd
= emacs_open (SDATA (encoded_newname
),
2560 O_WRONLY
| O_TRUNC
| O_CREAT
2561 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2563 #endif /* not MSDOS */
2566 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2568 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2572 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2573 if (emacs_write (ofd
, buf
, n
) != n
)
2574 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2578 /* Preserve the original file modes, and if requested, also its
2580 if (input_file_statable_p
)
2582 if (! NILP (preserve_uid_gid
))
2583 fchown (ofd
, st
.st_uid
, st
.st_gid
);
2584 fchmod (ofd
, st
.st_mode
& 07777);
2586 #endif /* not MSDOS */
2588 /* Closing the output clobbers the file times on some systems. */
2589 if (emacs_close (ofd
) < 0)
2590 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2592 if (input_file_statable_p
)
2594 if (!NILP (keep_time
))
2596 EMACS_TIME atime
, mtime
;
2597 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2598 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2599 if (set_file_times (SDATA (encoded_newname
),
2601 xsignal2 (Qfile_date_error
,
2602 build_string ("Cannot set file date"), newname
);
2608 #if defined (__DJGPP__) && __DJGPP__ > 1
2609 if (input_file_statable_p
)
2611 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2612 and if it can't, it tells so. Otherwise, under MSDOS we usually
2613 get only the READ bit, which will make the copied file read-only,
2614 so it's better not to chmod at all. */
2615 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2616 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2618 #endif /* DJGPP version 2 or newer */
2619 #endif /* not WINDOWSNT */
2621 /* Discard the unwind protects. */
2622 specpdl_ptr
= specpdl
+ count
;
2628 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2629 Smake_directory_internal
, 1, 1, 0,
2630 doc
: /* Create a new directory named DIRECTORY. */)
2632 Lisp_Object directory
;
2634 const unsigned char *dir
;
2635 Lisp_Object handler
;
2636 Lisp_Object encoded_dir
;
2638 CHECK_STRING (directory
);
2639 directory
= Fexpand_file_name (directory
, Qnil
);
2641 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2642 if (!NILP (handler
))
2643 return call2 (handler
, Qmake_directory_internal
, directory
);
2645 encoded_dir
= ENCODE_FILE (directory
);
2647 dir
= SDATA (encoded_dir
);
2650 if (mkdir (dir
) != 0)
2652 if (mkdir (dir
, 0777) != 0)
2654 report_file_error ("Creating directory", list1 (directory
));
2659 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2660 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2662 Lisp_Object directory
;
2664 const unsigned char *dir
;
2665 Lisp_Object handler
;
2666 Lisp_Object encoded_dir
;
2668 CHECK_STRING (directory
);
2669 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2671 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2672 if (!NILP (handler
))
2673 return call2 (handler
, Qdelete_directory
, directory
);
2675 encoded_dir
= ENCODE_FILE (directory
);
2677 dir
= SDATA (encoded_dir
);
2679 if (rmdir (dir
) != 0)
2680 report_file_error ("Removing directory", list1 (directory
));
2685 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2686 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2687 If file has multiple names, it continues to exist with the other names. */)
2689 Lisp_Object filename
;
2691 Lisp_Object handler
;
2692 Lisp_Object encoded_file
;
2693 struct gcpro gcpro1
;
2696 if (!NILP (Ffile_directory_p (filename
))
2697 && NILP (Ffile_symlink_p (filename
)))
2698 xsignal2 (Qfile_error
,
2699 build_string ("Removing old name: is a directory"),
2702 filename
= Fexpand_file_name (filename
, Qnil
);
2704 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2705 if (!NILP (handler
))
2706 return call2 (handler
, Qdelete_file
, filename
);
2708 encoded_file
= ENCODE_FILE (filename
);
2710 if (0 > unlink (SDATA (encoded_file
)))
2711 report_file_error ("Removing old name", list1 (filename
));
2716 internal_delete_file_1 (ignore
)
2722 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2725 internal_delete_file (filename
)
2726 Lisp_Object filename
;
2729 tem
= internal_condition_case_1 (Fdelete_file
, filename
,
2730 Qt
, internal_delete_file_1
);
2734 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2735 "fRename file: \nGRename %s to file: \np",
2736 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2737 If file has names other than FILE, it continues to have those names.
2738 Signals a `file-already-exists' error if a file NEWNAME already exists
2739 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2740 A number as third arg means request confirmation if NEWNAME already exists.
2741 This is what happens in interactive use with M-x. */)
2742 (file
, newname
, ok_if_already_exists
)
2743 Lisp_Object file
, newname
, ok_if_already_exists
;
2745 Lisp_Object handler
;
2746 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2747 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2749 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2750 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2751 CHECK_STRING (file
);
2752 CHECK_STRING (newname
);
2753 file
= Fexpand_file_name (file
, Qnil
);
2755 if ((!NILP (Ffile_directory_p (newname
)))
2757 /* If the file names are identical but for the case,
2758 don't attempt to move directory to itself. */
2759 && (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2762 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2764 newname
= Fexpand_file_name (newname
, Qnil
);
2766 /* If the file name has special constructs in it,
2767 call the corresponding file handler. */
2768 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2770 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2771 if (!NILP (handler
))
2772 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2773 file
, newname
, ok_if_already_exists
));
2775 encoded_file
= ENCODE_FILE (file
);
2776 encoded_newname
= ENCODE_FILE (newname
);
2779 /* If the file names are identical but for the case, don't ask for
2780 confirmation: they simply want to change the letter-case of the
2782 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2784 if (NILP (ok_if_already_exists
)
2785 || INTEGERP (ok_if_already_exists
))
2786 barf_or_query_if_file_exists (newname
, "rename to it",
2787 INTEGERP (ok_if_already_exists
), 0, 0);
2789 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2791 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2792 || 0 > unlink (SDATA (encoded_file
)))
2798 symlink_target
= Ffile_symlink_p (file
);
2799 if (! NILP (symlink_target
))
2800 Fmake_symbolic_link (symlink_target
, newname
,
2801 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2804 Fcopy_file (file
, newname
,
2805 /* We have already prompted if it was an integer,
2806 so don't have copy-file prompt again. */
2807 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2810 Fdelete_file (file
);
2813 report_file_error ("Renaming", list2 (file
, newname
));
2819 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2820 "fAdd name to file: \nGName to add to %s: \np",
2821 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2822 Signals a `file-already-exists' error if a file NEWNAME already exists
2823 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2824 A number as third arg means request confirmation if NEWNAME already exists.
2825 This is what happens in interactive use with M-x. */)
2826 (file
, newname
, ok_if_already_exists
)
2827 Lisp_Object file
, newname
, ok_if_already_exists
;
2829 Lisp_Object handler
;
2830 Lisp_Object encoded_file
, encoded_newname
;
2831 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2833 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2834 encoded_file
= encoded_newname
= Qnil
;
2835 CHECK_STRING (file
);
2836 CHECK_STRING (newname
);
2837 file
= Fexpand_file_name (file
, Qnil
);
2839 if (!NILP (Ffile_directory_p (newname
)))
2840 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2842 newname
= Fexpand_file_name (newname
, Qnil
);
2844 /* If the file name has special constructs in it,
2845 call the corresponding file handler. */
2846 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2847 if (!NILP (handler
))
2848 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2849 newname
, ok_if_already_exists
));
2851 /* If the new name has special constructs in it,
2852 call the corresponding file handler. */
2853 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2854 if (!NILP (handler
))
2855 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2856 newname
, ok_if_already_exists
));
2858 encoded_file
= ENCODE_FILE (file
);
2859 encoded_newname
= ENCODE_FILE (newname
);
2861 if (NILP (ok_if_already_exists
)
2862 || INTEGERP (ok_if_already_exists
))
2863 barf_or_query_if_file_exists (newname
, "make it a new name",
2864 INTEGERP (ok_if_already_exists
), 0, 0);
2866 unlink (SDATA (newname
));
2867 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2868 report_file_error ("Adding new name", list2 (file
, newname
));
2874 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2875 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2876 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2877 Both args must be strings.
2878 Signals a `file-already-exists' error if a file LINKNAME already exists
2879 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2880 A number as third arg means request confirmation if LINKNAME already exists.
2881 This happens for interactive use with M-x. */)
2882 (filename
, linkname
, ok_if_already_exists
)
2883 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2885 Lisp_Object handler
;
2886 Lisp_Object encoded_filename
, encoded_linkname
;
2887 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2889 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2890 encoded_filename
= encoded_linkname
= Qnil
;
2891 CHECK_STRING (filename
);
2892 CHECK_STRING (linkname
);
2893 /* If the link target has a ~, we must expand it to get
2894 a truly valid file name. Otherwise, do not expand;
2895 we want to permit links to relative file names. */
2896 if (SREF (filename
, 0) == '~')
2897 filename
= Fexpand_file_name (filename
, Qnil
);
2899 if (!NILP (Ffile_directory_p (linkname
)))
2900 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2902 linkname
= Fexpand_file_name (linkname
, Qnil
);
2904 /* If the file name has special constructs in it,
2905 call the corresponding file handler. */
2906 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2907 if (!NILP (handler
))
2908 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2909 linkname
, ok_if_already_exists
));
2911 /* If the new link name has special constructs in it,
2912 call the corresponding file handler. */
2913 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2914 if (!NILP (handler
))
2915 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2916 linkname
, ok_if_already_exists
));
2919 encoded_filename
= ENCODE_FILE (filename
);
2920 encoded_linkname
= ENCODE_FILE (linkname
);
2922 if (NILP (ok_if_already_exists
)
2923 || INTEGERP (ok_if_already_exists
))
2924 barf_or_query_if_file_exists (linkname
, "make it a link",
2925 INTEGERP (ok_if_already_exists
), 0, 0);
2926 if (0 > symlink (SDATA (encoded_filename
),
2927 SDATA (encoded_linkname
)))
2929 /* If we didn't complain already, silently delete existing file. */
2930 if (errno
== EEXIST
)
2932 unlink (SDATA (encoded_linkname
));
2933 if (0 <= symlink (SDATA (encoded_filename
),
2934 SDATA (encoded_linkname
)))
2941 report_file_error ("Making symbolic link", list2 (filename
, linkname
));
2948 xsignal1 (Qfile_error
, build_string ("Symbolic links are not supported"));
2950 #endif /* S_IFLNK */
2955 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2956 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2957 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2958 If STRING is nil or a null string, the logical name NAME is deleted. */)
2963 CHECK_STRING (name
);
2965 delete_logical_name (SDATA (name
));
2968 CHECK_STRING (string
);
2970 if (SCHARS (string
) == 0)
2971 delete_logical_name (SDATA (name
));
2973 define_logical_name (SDATA (name
), SDATA (string
));
2982 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2983 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2985 Lisp_Object path
, login
;
2989 CHECK_STRING (path
);
2990 CHECK_STRING (login
);
2992 netresult
= netunam (SDATA (path
), SDATA (login
));
2994 if (netresult
== -1)
2999 #endif /* HPUX_NET */
3001 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
3003 doc
: /* Return t if file FILENAME specifies an absolute file name.
3004 On Unix, this is a name starting with a `/' or a `~'. */)
3006 Lisp_Object filename
;
3008 CHECK_STRING (filename
);
3009 return file_name_absolute_p (SDATA (filename
)) ? Qt
: Qnil
;
3012 /* Return nonzero if file FILENAME exists and can be executed. */
3015 check_executable (filename
)
3019 int len
= strlen (filename
);
3022 if (stat (filename
, &st
) < 0)
3024 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
3025 return ((st
.st_mode
& S_IEXEC
) != 0);
3027 return (S_ISREG (st
.st_mode
)
3029 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
3030 || stricmp (suffix
, ".exe") == 0
3031 || stricmp (suffix
, ".bat") == 0)
3032 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3033 #endif /* not WINDOWSNT */
3034 #else /* not DOS_NT */
3035 #ifdef HAVE_EUIDACCESS
3036 return (euidaccess (filename
, 1) >= 0);
3038 /* Access isn't quite right because it uses the real uid
3039 and we really want to test with the effective uid.
3040 But Unix doesn't give us a right way to do it. */
3041 return (access (filename
, 1) >= 0);
3043 #endif /* not DOS_NT */
3046 /* Return nonzero if file FILENAME exists and can be written. */
3049 check_writable (filename
)
3054 if (stat (filename
, &st
) < 0)
3056 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3057 #else /* not MSDOS */
3058 #ifdef HAVE_EUIDACCESS
3059 return (euidaccess (filename
, 2) >= 0);
3061 /* Access isn't quite right because it uses the real uid
3062 and we really want to test with the effective uid.
3063 But Unix doesn't give us a right way to do it.
3064 Opening with O_WRONLY could work for an ordinary file,
3065 but would lose for directories. */
3066 return (access (filename
, 2) >= 0);
3068 #endif /* not MSDOS */
3071 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3072 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
3073 See also `file-readable-p' and `file-attributes'.
3074 This returns nil for a symlink to a nonexistent file.
3075 Use `file-symlink-p' to test for such links. */)
3077 Lisp_Object filename
;
3079 Lisp_Object absname
;
3080 Lisp_Object handler
;
3081 struct stat statbuf
;
3083 CHECK_STRING (filename
);
3084 absname
= Fexpand_file_name (filename
, Qnil
);
3086 /* If the file name has special constructs in it,
3087 call the corresponding file handler. */
3088 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3089 if (!NILP (handler
))
3090 return call2 (handler
, Qfile_exists_p
, absname
);
3092 absname
= ENCODE_FILE (absname
);
3094 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3097 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3098 doc
: /* Return t if FILENAME can be executed by you.
3099 For a directory, this means you can access files in that directory. */)
3101 Lisp_Object filename
;
3103 Lisp_Object absname
;
3104 Lisp_Object handler
;
3106 CHECK_STRING (filename
);
3107 absname
= Fexpand_file_name (filename
, Qnil
);
3109 /* If the file name has special constructs in it,
3110 call the corresponding file handler. */
3111 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3112 if (!NILP (handler
))
3113 return call2 (handler
, Qfile_executable_p
, absname
);
3115 absname
= ENCODE_FILE (absname
);
3117 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3120 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3121 doc
: /* Return t if file FILENAME exists and you can read it.
3122 See also `file-exists-p' and `file-attributes'. */)
3124 Lisp_Object filename
;
3126 Lisp_Object absname
;
3127 Lisp_Object handler
;
3130 struct stat statbuf
;
3132 CHECK_STRING (filename
);
3133 absname
= Fexpand_file_name (filename
, Qnil
);
3135 /* If the file name has special constructs in it,
3136 call the corresponding file handler. */
3137 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3138 if (!NILP (handler
))
3139 return call2 (handler
, Qfile_readable_p
, absname
);
3141 absname
= ENCODE_FILE (absname
);
3143 #if defined(DOS_NT) || defined(macintosh)
3144 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3146 if (access (SDATA (absname
), 0) == 0)
3149 #else /* not DOS_NT and not macintosh */
3151 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3152 /* Opening a fifo without O_NONBLOCK can wait.
3153 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3154 except in the case of a fifo, on a system which handles it. */
3155 desc
= stat (SDATA (absname
), &statbuf
);
3158 if (S_ISFIFO (statbuf
.st_mode
))
3159 flags
|= O_NONBLOCK
;
3161 desc
= emacs_open (SDATA (absname
), flags
, 0);
3166 #endif /* not DOS_NT and not macintosh */
3169 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3171 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3172 doc
: /* Return t if file FILENAME can be written or created by you. */)
3174 Lisp_Object filename
;
3176 Lisp_Object absname
, dir
, encoded
;
3177 Lisp_Object handler
;
3178 struct stat statbuf
;
3180 CHECK_STRING (filename
);
3181 absname
= Fexpand_file_name (filename
, Qnil
);
3183 /* If the file name has special constructs in it,
3184 call the corresponding file handler. */
3185 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3186 if (!NILP (handler
))
3187 return call2 (handler
, Qfile_writable_p
, absname
);
3189 encoded
= ENCODE_FILE (absname
);
3190 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3191 return (check_writable (SDATA (encoded
))
3194 dir
= Ffile_name_directory (absname
);
3197 dir
= Fdirectory_file_name (dir
);
3201 dir
= Fdirectory_file_name (dir
);
3204 dir
= ENCODE_FILE (dir
);
3206 /* The read-only attribute of the parent directory doesn't affect
3207 whether a file or directory can be created within it. Some day we
3208 should check ACLs though, which do affect this. */
3209 if (stat (SDATA (dir
), &statbuf
) < 0)
3211 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3213 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3218 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3219 doc
: /* Access file FILENAME, and get an error if that does not work.
3220 The second argument STRING is used in the error message.
3221 If there is no error, returns nil. */)
3223 Lisp_Object filename
, string
;
3225 Lisp_Object handler
, encoded_filename
, absname
;
3228 CHECK_STRING (filename
);
3229 absname
= Fexpand_file_name (filename
, Qnil
);
3231 CHECK_STRING (string
);
3233 /* If the file name has special constructs in it,
3234 call the corresponding file handler. */
3235 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3236 if (!NILP (handler
))
3237 return call3 (handler
, Qaccess_file
, absname
, string
);
3239 encoded_filename
= ENCODE_FILE (absname
);
3241 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3243 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3249 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3250 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3251 The value is the link target, as a string.
3252 Otherwise it returns nil.
3254 This function returns t when given the name of a symlink that
3255 points to a nonexistent file. */)
3257 Lisp_Object filename
;
3259 Lisp_Object handler
;
3261 CHECK_STRING (filename
);
3262 filename
= Fexpand_file_name (filename
, Qnil
);
3264 /* If the file name has special constructs in it,
3265 call the corresponding file handler. */
3266 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3267 if (!NILP (handler
))
3268 return call2 (handler
, Qfile_symlink_p
, filename
);
3277 filename
= ENCODE_FILE (filename
);
3284 buf
= (char *) xrealloc (buf
, bufsize
);
3285 bzero (buf
, bufsize
);
3288 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3292 /* HP-UX reports ERANGE if buffer is too small. */
3293 if (errno
== ERANGE
)
3303 while (valsize
>= bufsize
);
3305 val
= make_string (buf
, valsize
);
3306 if (buf
[0] == '/' && index (buf
, ':'))
3307 val
= concat2 (build_string ("/:"), val
);
3309 val
= DECODE_FILE (val
);
3312 #else /* not S_IFLNK */
3314 #endif /* not S_IFLNK */
3317 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3318 doc
: /* Return t if FILENAME names an existing directory.
3319 Symbolic links to directories count as directories.
3320 See `file-symlink-p' to distinguish symlinks. */)
3322 Lisp_Object filename
;
3324 register Lisp_Object absname
;
3326 Lisp_Object handler
;
3328 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3330 /* If the file name has special constructs in it,
3331 call the corresponding file handler. */
3332 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3333 if (!NILP (handler
))
3334 return call2 (handler
, Qfile_directory_p
, absname
);
3336 absname
= ENCODE_FILE (absname
);
3338 if (stat (SDATA (absname
), &st
) < 0)
3340 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3343 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3344 doc
: /* Return t if file FILENAME names a directory you can open.
3345 For the value to be t, FILENAME must specify the name of a directory as a file,
3346 and the directory must allow you to open files in it. In order to use a
3347 directory as a buffer's current directory, this predicate must return true.
3348 A directory name spec may be given instead; then the value is t
3349 if the directory so specified exists and really is a readable and
3350 searchable directory. */)
3352 Lisp_Object filename
;
3354 Lisp_Object handler
;
3356 struct gcpro gcpro1
;
3358 /* If the file name has special constructs in it,
3359 call the corresponding file handler. */
3360 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3361 if (!NILP (handler
))
3362 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3365 tem
= (NILP (Ffile_directory_p (filename
))
3366 || NILP (Ffile_executable_p (filename
)));
3368 return tem
? Qnil
: Qt
;
3371 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3372 doc
: /* Return t if FILENAME names a regular file.
3373 This is the sort of file that holds an ordinary stream of data bytes.
3374 Symbolic links to regular files count as regular files.
3375 See `file-symlink-p' to distinguish symlinks. */)
3377 Lisp_Object filename
;
3379 register Lisp_Object absname
;
3381 Lisp_Object handler
;
3383 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3385 /* If the file name has special constructs in it,
3386 call the corresponding file handler. */
3387 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3388 if (!NILP (handler
))
3389 return call2 (handler
, Qfile_regular_p
, absname
);
3391 absname
= ENCODE_FILE (absname
);
3396 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3398 /* Tell stat to use expensive method to get accurate info. */
3399 Vw32_get_true_file_attributes
= Qt
;
3400 result
= stat (SDATA (absname
), &st
);
3401 Vw32_get_true_file_attributes
= tem
;
3405 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3408 if (stat (SDATA (absname
), &st
) < 0)
3410 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3414 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3415 doc
: /* Return mode bits of file named FILENAME, as an integer.
3416 Return nil, if file does not exist or is not accessible. */)
3418 Lisp_Object filename
;
3420 Lisp_Object absname
;
3422 Lisp_Object handler
;
3424 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3426 /* If the file name has special constructs in it,
3427 call the corresponding file handler. */
3428 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3429 if (!NILP (handler
))
3430 return call2 (handler
, Qfile_modes
, absname
);
3432 absname
= ENCODE_FILE (absname
);
3434 if (stat (SDATA (absname
), &st
) < 0)
3436 #if defined (MSDOS) && __DJGPP__ < 2
3437 if (check_executable (SDATA (absname
)))
3438 st
.st_mode
|= S_IEXEC
;
3439 #endif /* MSDOS && __DJGPP__ < 2 */
3441 return make_number (st
.st_mode
& 07777);
3444 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3445 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3446 Only the 12 low bits of MODE are used. */)
3448 Lisp_Object filename
, mode
;
3450 Lisp_Object absname
, encoded_absname
;
3451 Lisp_Object handler
;
3453 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3454 CHECK_NUMBER (mode
);
3456 /* If the file name has special constructs in it,
3457 call the corresponding file handler. */
3458 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3459 if (!NILP (handler
))
3460 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3462 encoded_absname
= ENCODE_FILE (absname
);
3464 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3465 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3470 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3471 doc
: /* Set the file permission bits for newly created files.
3472 The argument MODE should be an integer; only the low 9 bits are used.
3473 This setting is inherited by subprocesses. */)
3477 CHECK_NUMBER (mode
);
3479 umask ((~ XINT (mode
)) & 0777);
3484 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3485 doc
: /* Return the default file protection for created files.
3486 The value is an integer. */)
3492 realmask
= umask (0);
3495 XSETINT (value
, (~ realmask
) & 0777);
3499 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3501 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3502 doc
: /* Set times of file FILENAME to TIME.
3503 Set both access and modification times.
3504 Return t on success, else nil.
3505 Use the current time if TIME is nil. TIME is in the format of
3508 Lisp_Object filename
, time
;
3510 Lisp_Object absname
, encoded_absname
;
3511 Lisp_Object handler
;
3515 if (! lisp_time_argument (time
, &sec
, &usec
))
3516 error ("Invalid time specification");
3518 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3520 /* If the file name has special constructs in it,
3521 call the corresponding file handler. */
3522 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3523 if (!NILP (handler
))
3524 return call3 (handler
, Qset_file_times
, absname
, time
);
3526 encoded_absname
= ENCODE_FILE (absname
);
3531 EMACS_SET_SECS (t
, sec
);
3532 EMACS_SET_USECS (t
, usec
);
3534 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3539 /* Setting times on a directory always fails. */
3540 if (stat (SDATA (encoded_absname
), &st
) == 0
3541 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3544 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3553 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3554 doc
: /* Tell Unix to finish all pending disk updates. */)
3561 #endif /* HAVE_SYNC */
3563 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3564 doc
: /* Return t if file FILE1 is newer than file FILE2.
3565 If FILE1 does not exist, the answer is nil;
3566 otherwise, if FILE2 does not exist, the answer is t. */)
3568 Lisp_Object file1
, file2
;
3570 Lisp_Object absname1
, absname2
;
3573 Lisp_Object handler
;
3574 struct gcpro gcpro1
, gcpro2
;
3576 CHECK_STRING (file1
);
3577 CHECK_STRING (file2
);
3580 GCPRO2 (absname1
, file2
);
3581 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3582 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3585 /* If the file name has special constructs in it,
3586 call the corresponding file handler. */
3587 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3589 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3590 if (!NILP (handler
))
3591 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3593 GCPRO2 (absname1
, absname2
);
3594 absname1
= ENCODE_FILE (absname1
);
3595 absname2
= ENCODE_FILE (absname2
);
3598 if (stat (SDATA (absname1
), &st
) < 0)
3601 mtime1
= st
.st_mtime
;
3603 if (stat (SDATA (absname2
), &st
) < 0)
3606 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3610 Lisp_Object Qfind_buffer_file_type
;
3613 #ifndef READ_BUF_SIZE
3614 #define READ_BUF_SIZE (64 << 10)
3617 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3619 /* This function is called after Lisp functions to decide a coding
3620 system are called, or when they cause an error. Before they are
3621 called, the current buffer is set unibyte and it contains only a
3622 newly inserted text (thus the buffer was empty before the
3625 The functions may set markers, overlays, text properties, or even
3626 alter the buffer contents, change the current buffer.
3628 Here, we reset all those changes by:
3629 o set back the current buffer.
3630 o move all markers and overlays to BEG.
3631 o remove all text properties.
3632 o set back the buffer multibyteness. */
3635 decide_coding_unwind (unwind_data
)
3636 Lisp_Object unwind_data
;
3638 Lisp_Object multibyte
, undo_list
, buffer
;
3640 multibyte
= XCAR (unwind_data
);
3641 unwind_data
= XCDR (unwind_data
);
3642 undo_list
= XCAR (unwind_data
);
3643 buffer
= XCDR (unwind_data
);
3645 if (current_buffer
!= XBUFFER (buffer
))
3646 set_buffer_internal (XBUFFER (buffer
));
3647 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3648 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3649 BUF_INTERVALS (current_buffer
) = 0;
3650 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3652 /* Now we are safe to change the buffer's multibyteness directly. */
3653 current_buffer
->enable_multibyte_characters
= multibyte
;
3654 current_buffer
->undo_list
= undo_list
;
3660 /* Used to pass values from insert-file-contents to read_non_regular. */
3662 static int non_regular_fd
;
3663 static int non_regular_inserted
;
3664 static int non_regular_nbytes
;
3667 /* Read from a non-regular file.
3668 Read non_regular_trytry bytes max from non_regular_fd.
3669 Non_regular_inserted specifies where to put the read bytes.
3670 Value is the number of bytes read. */
3679 nbytes
= emacs_read (non_regular_fd
,
3680 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3681 non_regular_nbytes
);
3683 return make_number (nbytes
);
3687 /* Condition-case handler used when reading from non-regular files
3688 in insert-file-contents. */
3691 read_non_regular_quit ()
3697 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3699 doc
: /* Insert contents of file FILENAME after point.
3700 Returns list of absolute file name and number of characters inserted.
3701 If second argument VISIT is non-nil, the buffer's visited filename
3702 and last save file modtime are set, and it is marked unmodified.
3703 If visiting and the file does not exist, visiting is completed
3704 before the error is signaled.
3705 The optional third and fourth arguments BEG and END
3706 specify what portion of the file to insert.
3707 These arguments count bytes in the file, not characters in the buffer.
3708 If VISIT is non-nil, BEG and END must be nil.
3710 If optional fifth argument REPLACE is non-nil,
3711 it means replace the current buffer contents (in the accessible portion)
3712 with the file contents. This is better than simply deleting and inserting
3713 the whole thing because (1) it preserves some marker positions
3714 and (2) it puts less data in the undo list.
3715 When REPLACE is non-nil, the value is the number of characters actually read,
3716 which is often less than the number of characters to be read.
3718 This does code conversion according to the value of
3719 `coding-system-for-read' or `file-coding-system-alist',
3720 and sets the variable `last-coding-system-used' to the coding system
3722 (filename
, visit
, beg
, end
, replace
)
3723 Lisp_Object filename
, visit
, beg
, end
, replace
;
3728 register int how_much
;
3729 register int unprocessed
;
3730 int count
= SPECPDL_INDEX ();
3731 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3732 Lisp_Object handler
, val
, insval
, orig_filename
;
3735 int not_regular
= 0;
3736 unsigned char read_buf
[READ_BUF_SIZE
];
3737 struct coding_system coding
;
3738 unsigned char buffer
[1 << 14];
3739 int replace_handled
= 0;
3740 int set_coding_system
= 0;
3741 int coding_system_decided
= 0;
3743 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3744 int we_locked_file
= 0;
3746 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3747 error ("Cannot do file visiting in an indirect buffer");
3749 if (!NILP (current_buffer
->read_only
))
3750 Fbarf_if_buffer_read_only ();
3754 orig_filename
= Qnil
;
3756 GCPRO4 (filename
, val
, p
, orig_filename
);
3758 CHECK_STRING (filename
);
3759 filename
= Fexpand_file_name (filename
, Qnil
);
3761 /* If the file name has special constructs in it,
3762 call the corresponding file handler. */
3763 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3764 if (!NILP (handler
))
3766 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3767 visit
, beg
, end
, replace
);
3768 if (CONSP (val
) && CONSP (XCDR (val
)))
3769 inserted
= XINT (XCAR (XCDR (val
)));
3773 orig_filename
= filename
;
3774 filename
= ENCODE_FILE (filename
);
3780 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3782 /* Tell stat to use expensive method to get accurate info. */
3783 Vw32_get_true_file_attributes
= Qt
;
3784 total
= stat (SDATA (filename
), &st
);
3785 Vw32_get_true_file_attributes
= tem
;
3790 if (stat (SDATA (filename
), &st
) < 0)
3792 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3793 || fstat (fd
, &st
) < 0)
3794 #endif /* not APOLLO */
3795 #endif /* WINDOWSNT */
3797 if (fd
>= 0) emacs_close (fd
);
3800 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3803 if (!NILP (Vcoding_system_for_read
))
3804 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3809 /* This code will need to be changed in order to work on named
3810 pipes, and it's probably just not worth it. So we should at
3811 least signal an error. */
3812 if (!S_ISREG (st
.st_mode
))
3819 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3820 xsignal2 (Qfile_error
,
3821 build_string ("not a regular file"), orig_filename
);
3826 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3829 /* Replacement should preserve point as it preserves markers. */
3830 if (!NILP (replace
))
3831 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3833 record_unwind_protect (close_file_unwind
, make_number (fd
));
3835 /* Supposedly happens on VMS. */
3836 /* Can happen on any platform that uses long as type of off_t, but allows
3837 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3838 give a message suitable for the latter case. */
3839 if (! not_regular
&& st
.st_size
< 0)
3840 error ("Maximum buffer size exceeded");
3842 /* Prevent redisplay optimizations. */
3843 current_buffer
->clip_changed
= 1;
3847 if (!NILP (beg
) || !NILP (end
))
3848 error ("Attempt to visit less than an entire file");
3849 if (BEG
< Z
&& NILP (replace
))
3850 error ("Cannot do file visiting in a non-empty buffer");
3856 XSETFASTINT (beg
, 0);
3864 XSETINT (end
, st
.st_size
);
3866 /* Arithmetic overflow can occur if an Emacs integer cannot
3867 represent the file size, or if the calculations below
3868 overflow. The calculations below double the file size
3869 twice, so check that it can be multiplied by 4 safely. */
3870 if (XINT (end
) != st
.st_size
3871 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3872 error ("Maximum buffer size exceeded");
3874 /* The file size returned from stat may be zero, but data
3875 may be readable nonetheless, for example when this is a
3876 file in the /proc filesystem. */
3877 if (st
.st_size
== 0)
3878 XSETINT (end
, READ_BUF_SIZE
);
3882 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3884 /* We use emacs-mule for auto saving... */
3885 setup_coding_system (Qemacs_mule
, &coding
);
3886 /* ... but with the special flag to indicate to read in a
3887 multibyte sequence for eight-bit-control char as is. */
3889 coding
.src_multibyte
= 0;
3890 coding
.dst_multibyte
3891 = !NILP (current_buffer
->enable_multibyte_characters
);
3892 coding
.eol_type
= CODING_EOL_LF
;
3893 coding_system_decided
= 1;
3897 /* Decide the coding system to use for reading the file now
3898 because we can't use an optimized method for handling
3899 `coding:' tag if the current buffer is not empty. */
3903 if (!NILP (Vcoding_system_for_read
))
3904 val
= Vcoding_system_for_read
;
3907 /* Don't try looking inside a file for a coding system
3908 specification if it is not seekable. */
3909 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3911 /* Find a coding system specified in the heading two
3912 lines or in the tailing several lines of the file.
3913 We assume that the 1K-byte and 3K-byte for heading
3914 and tailing respectively are sufficient for this
3918 if (st
.st_size
<= (1024 * 4))
3919 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3922 nread
= emacs_read (fd
, read_buf
, 1024);
3925 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3926 report_file_error ("Setting file position",
3927 Fcons (orig_filename
, Qnil
));
3928 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3933 error ("IO error reading %s: %s",
3934 SDATA (orig_filename
), emacs_strerror (errno
));
3937 struct buffer
*prev
= current_buffer
;
3941 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3943 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3944 buf
= XBUFFER (buffer
);
3946 delete_all_overlays (buf
);
3947 buf
->directory
= current_buffer
->directory
;
3948 buf
->read_only
= Qnil
;
3949 buf
->filename
= Qnil
;
3950 buf
->undo_list
= Qt
;
3951 eassert (buf
->overlays_before
== NULL
);
3952 eassert (buf
->overlays_after
== NULL
);
3954 set_buffer_internal (buf
);
3956 buf
->enable_multibyte_characters
= Qnil
;
3958 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3959 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3960 val
= call2 (Vset_auto_coding_function
,
3961 filename
, make_number (nread
));
3962 set_buffer_internal (prev
);
3964 /* Discard the unwind protect for recovering the
3968 /* Rewind the file for the actual read done later. */
3969 if (lseek (fd
, 0, 0) < 0)
3970 report_file_error ("Setting file position",
3971 Fcons (orig_filename
, Qnil
));
3977 /* If we have not yet decided a coding system, check
3978 file-coding-system-alist. */
3979 Lisp_Object args
[6], coding_systems
;
3981 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3982 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3983 coding_systems
= Ffind_operation_coding_system (6, args
);
3984 if (CONSP (coding_systems
))
3985 val
= XCAR (coding_systems
);
3989 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3990 /* Ensure we set Vlast_coding_system_used. */
3991 set_coding_system
= 1;
3993 if (NILP (current_buffer
->enable_multibyte_characters
)
3995 /* We must suppress all character code conversion except for
3996 end-of-line conversion. */
3997 setup_raw_text_coding_system (&coding
);
3999 coding
.src_multibyte
= 0;
4000 coding
.dst_multibyte
4001 = !NILP (current_buffer
->enable_multibyte_characters
);
4002 coding_system_decided
= 1;
4005 /* If requested, replace the accessible part of the buffer
4006 with the file contents. Avoid replacing text at the
4007 beginning or end of the buffer that matches the file contents;
4008 that preserves markers pointing to the unchanged parts.
4010 Here we implement this feature in an optimized way
4011 for the case where code conversion is NOT needed.
4012 The following if-statement handles the case of conversion
4013 in a less optimal way.
4015 If the code conversion is "automatic" then we try using this
4016 method and hope for the best.
4017 But if we discover the need for conversion, we give up on this method
4018 and let the following if-statement handle the replace job. */
4021 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
4023 /* same_at_start and same_at_end count bytes,
4024 because file access counts bytes
4025 and BEG and END count bytes. */
4026 int same_at_start
= BEGV_BYTE
;
4027 int same_at_end
= ZV_BYTE
;
4029 /* There is still a possibility we will find the need to do code
4030 conversion. If that happens, we set this variable to 1 to
4031 give up on handling REPLACE in the optimized way. */
4032 int giveup_match_end
= 0;
4034 if (XINT (beg
) != 0)
4036 if (lseek (fd
, XINT (beg
), 0) < 0)
4037 report_file_error ("Setting file position",
4038 Fcons (orig_filename
, Qnil
));
4043 /* Count how many chars at the start of the file
4044 match the text at the beginning of the buffer. */
4049 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4051 error ("IO error reading %s: %s",
4052 SDATA (orig_filename
), emacs_strerror (errno
));
4053 else if (nread
== 0)
4056 if (coding
.type
== coding_type_undecided
)
4057 detect_coding (&coding
, buffer
, nread
);
4058 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
4059 /* We found that the file should be decoded somehow.
4060 Let's give up here. */
4062 giveup_match_end
= 1;
4066 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
4067 detect_eol (&coding
, buffer
, nread
);
4068 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
4069 && coding
.eol_type
!= CODING_EOL_LF
)
4070 /* We found that the format of eol should be decoded.
4071 Let's give up here. */
4073 giveup_match_end
= 1;
4078 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4079 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4080 same_at_start
++, bufpos
++;
4081 /* If we found a discrepancy, stop the scan.
4082 Otherwise loop around and scan the next bufferful. */
4083 if (bufpos
!= nread
)
4087 /* If the file matches the buffer completely,
4088 there's no need to replace anything. */
4089 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4093 /* Truncate the buffer to the size of the file. */
4094 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4099 /* Count how many chars at the end of the file
4100 match the text at the end of the buffer. But, if we have
4101 already found that decoding is necessary, don't waste time. */
4102 while (!giveup_match_end
)
4104 int total_read
, nread
, bufpos
, curpos
, trial
;
4106 /* At what file position are we now scanning? */
4107 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4108 /* If the entire file matches the buffer tail, stop the scan. */
4111 /* How much can we scan in the next step? */
4112 trial
= min (curpos
, sizeof buffer
);
4113 if (lseek (fd
, curpos
- trial
, 0) < 0)
4114 report_file_error ("Setting file position",
4115 Fcons (orig_filename
, Qnil
));
4117 total_read
= nread
= 0;
4118 while (total_read
< trial
)
4120 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4122 error ("IO error reading %s: %s",
4123 SDATA (orig_filename
), emacs_strerror (errno
));
4124 else if (nread
== 0)
4126 total_read
+= nread
;
4129 /* Scan this bufferful from the end, comparing with
4130 the Emacs buffer. */
4131 bufpos
= total_read
;
4133 /* Compare with same_at_start to avoid counting some buffer text
4134 as matching both at the file's beginning and at the end. */
4135 while (bufpos
> 0 && same_at_end
> same_at_start
4136 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4137 same_at_end
--, bufpos
--;
4139 /* If we found a discrepancy, stop the scan.
4140 Otherwise loop around and scan the preceding bufferful. */
4143 /* If this discrepancy is because of code conversion,
4144 we cannot use this method; giveup and try the other. */
4145 if (same_at_end
> same_at_start
4146 && FETCH_BYTE (same_at_end
- 1) >= 0200
4147 && ! NILP (current_buffer
->enable_multibyte_characters
)
4148 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4149 giveup_match_end
= 1;
4158 if (! giveup_match_end
)
4162 /* We win! We can handle REPLACE the optimized way. */
4164 /* Extend the start of non-matching text area to multibyte
4165 character boundary. */
4166 if (! NILP (current_buffer
->enable_multibyte_characters
))
4167 while (same_at_start
> BEGV_BYTE
4168 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4171 /* Extend the end of non-matching text area to multibyte
4172 character boundary. */
4173 if (! NILP (current_buffer
->enable_multibyte_characters
))
4174 while (same_at_end
< ZV_BYTE
4175 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4178 /* Don't try to reuse the same piece of text twice. */
4179 overlap
= (same_at_start
- BEGV_BYTE
4180 - (same_at_end
+ st
.st_size
- ZV
));
4182 same_at_end
+= overlap
;
4184 /* Arrange to read only the nonmatching middle part of the file. */
4185 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4186 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4188 del_range_byte (same_at_start
, same_at_end
, 0);
4189 /* Insert from the file at the proper position. */
4190 temp
= BYTE_TO_CHAR (same_at_start
);
4191 SET_PT_BOTH (temp
, same_at_start
);
4193 /* If display currently starts at beginning of line,
4194 keep it that way. */
4195 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4196 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4198 replace_handled
= 1;
4202 /* If requested, replace the accessible part of the buffer
4203 with the file contents. Avoid replacing text at the
4204 beginning or end of the buffer that matches the file contents;
4205 that preserves markers pointing to the unchanged parts.
4207 Here we implement this feature for the case where code conversion
4208 is needed, in a simple way that needs a lot of memory.
4209 The preceding if-statement handles the case of no conversion
4210 in a more optimized way. */
4211 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4213 int same_at_start
= BEGV_BYTE
;
4214 int same_at_end
= ZV_BYTE
;
4217 /* Make sure that the gap is large enough. */
4218 int bufsize
= 2 * st
.st_size
;
4219 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4222 /* First read the whole file, performing code conversion into
4223 CONVERSION_BUFFER. */
4225 if (lseek (fd
, XINT (beg
), 0) < 0)
4227 xfree (conversion_buffer
);
4228 report_file_error ("Setting file position",
4229 Fcons (orig_filename
, Qnil
));
4232 total
= st
.st_size
; /* Total bytes in the file. */
4233 how_much
= 0; /* Bytes read from file so far. */
4234 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4235 unprocessed
= 0; /* Bytes not processed in previous loop. */
4237 while (how_much
< total
)
4239 /* try is reserved in some compilers (Microsoft C) */
4240 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4241 unsigned char *destination
= read_buf
+ unprocessed
;
4244 /* Allow quitting out of the actual I/O. */
4247 this = emacs_read (fd
, destination
, trytry
);
4250 if (this < 0 || this + unprocessed
== 0)
4258 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4260 int require
, result
;
4262 this += unprocessed
;
4264 /* If we are using more space than estimated,
4265 make CONVERSION_BUFFER bigger. */
4266 require
= decoding_buffer_size (&coding
, this);
4267 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4269 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4270 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4273 /* Convert this batch with results in CONVERSION_BUFFER. */
4274 if (how_much
>= total
) /* This is the last block. */
4275 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4276 if (coding
.composing
!= COMPOSITION_DISABLED
)
4277 coding_allocate_composition_data (&coding
, BEGV
);
4278 result
= decode_coding (&coding
, read_buf
,
4279 conversion_buffer
+ inserted
,
4280 this, bufsize
- inserted
);
4282 /* Save for next iteration whatever we didn't convert. */
4283 unprocessed
= this - coding
.consumed
;
4284 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4285 if (!NILP (current_buffer
->enable_multibyte_characters
))
4286 this = coding
.produced
;
4288 this = str_as_unibyte (conversion_buffer
+ inserted
,
4295 /* At this point, INSERTED is how many characters (i.e. bytes)
4296 are present in CONVERSION_BUFFER.
4297 HOW_MUCH should equal TOTAL,
4298 or should be <= 0 if we couldn't read the file. */
4302 xfree (conversion_buffer
);
4303 coding_free_composition_data (&coding
);
4304 error ("IO error reading %s: %s",
4305 SDATA (orig_filename
), emacs_strerror (errno
));
4308 /* Compare the beginning of the converted file
4309 with the buffer text. */
4312 while (bufpos
< inserted
&& same_at_start
< same_at_end
4313 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4314 same_at_start
++, bufpos
++;
4316 /* If the file matches the buffer completely,
4317 there's no need to replace anything. */
4319 if (bufpos
== inserted
)
4321 xfree (conversion_buffer
);
4322 coding_free_composition_data (&coding
);
4325 /* Truncate the buffer to the size of the file. */
4326 del_range_byte (same_at_start
, same_at_end
, 0);
4331 /* Extend the start of non-matching text area to multibyte
4332 character boundary. */
4333 if (! NILP (current_buffer
->enable_multibyte_characters
))
4334 while (same_at_start
> BEGV_BYTE
4335 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4338 /* Scan this bufferful from the end, comparing with
4339 the Emacs buffer. */
4342 /* Compare with same_at_start to avoid counting some buffer text
4343 as matching both at the file's beginning and at the end. */
4344 while (bufpos
> 0 && same_at_end
> same_at_start
4345 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4346 same_at_end
--, bufpos
--;
4348 /* Extend the end of non-matching text area to multibyte
4349 character boundary. */
4350 if (! NILP (current_buffer
->enable_multibyte_characters
))
4351 while (same_at_end
< ZV_BYTE
4352 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4355 /* Don't try to reuse the same piece of text twice. */
4356 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4358 same_at_end
+= overlap
;
4360 /* If display currently starts at beginning of line,
4361 keep it that way. */
4362 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4363 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4365 /* Replace the chars that we need to replace,
4366 and update INSERTED to equal the number of bytes
4367 we are taking from the file. */
4368 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4370 if (same_at_end
!= same_at_start
)
4372 del_range_byte (same_at_start
, same_at_end
, 0);
4374 same_at_start
= GPT_BYTE
;
4378 temp
= BYTE_TO_CHAR (same_at_start
);
4380 /* Insert from the file at the proper position. */
4381 SET_PT_BOTH (temp
, same_at_start
);
4382 insert_1 (conversion_buffer
+ same_at_start
- BEGV_BYTE
, inserted
,
4384 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4385 coding_restore_composition (&coding
, Fcurrent_buffer ());
4386 coding_free_composition_data (&coding
);
4388 /* Set `inserted' to the number of inserted characters. */
4389 inserted
= PT
- temp
;
4390 /* Set point before the inserted characters. */
4391 SET_PT_BOTH (temp
, same_at_start
);
4393 xfree (conversion_buffer
);
4402 register Lisp_Object temp
;
4404 total
= XINT (end
) - XINT (beg
);
4406 /* Make sure point-max won't overflow after this insertion. */
4407 XSETINT (temp
, total
);
4408 if (total
!= XINT (temp
))
4409 error ("Maximum buffer size exceeded");
4412 /* For a special file, all we can do is guess. */
4413 total
= READ_BUF_SIZE
;
4415 if (NILP (visit
) && inserted
> 0)
4417 #ifdef CLASH_DETECTION
4418 if (!NILP (current_buffer
->file_truename
)
4419 /* Make binding buffer-file-name to nil effective. */
4420 && !NILP (current_buffer
->filename
)
4421 && SAVE_MODIFF
>= MODIFF
)
4423 #endif /* CLASH_DETECTION */
4424 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
4428 if (GAP_SIZE
< total
)
4429 make_gap (total
- GAP_SIZE
);
4431 if (XINT (beg
) != 0 || !NILP (replace
))
4433 if (lseek (fd
, XINT (beg
), 0) < 0)
4434 report_file_error ("Setting file position",
4435 Fcons (orig_filename
, Qnil
));
4438 /* In the following loop, HOW_MUCH contains the total bytes read so
4439 far for a regular file, and not changed for a special file. But,
4440 before exiting the loop, it is set to a negative value if I/O
4444 /* Total bytes inserted. */
4447 /* Here, we don't do code conversion in the loop. It is done by
4448 code_convert_region after all data are read into the buffer. */
4450 int gap_size
= GAP_SIZE
;
4452 while (how_much
< total
)
4454 /* try is reserved in some compilers (Microsoft C) */
4455 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4462 /* Maybe make more room. */
4463 if (gap_size
< trytry
)
4465 make_gap (total
- gap_size
);
4466 gap_size
= GAP_SIZE
;
4469 /* Read from the file, capturing `quit'. When an
4470 error occurs, end the loop, and arrange for a quit
4471 to be signaled after decoding the text we read. */
4472 non_regular_fd
= fd
;
4473 non_regular_inserted
= inserted
;
4474 non_regular_nbytes
= trytry
;
4475 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4476 read_non_regular_quit
);
4487 /* Allow quitting out of the actual I/O. We don't make text
4488 part of the buffer until all the reading is done, so a C-g
4489 here doesn't do any harm. */
4492 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4504 /* For a regular file, where TOTAL is the real size,
4505 count HOW_MUCH to compare with it.
4506 For a special file, where TOTAL is just a buffer size,
4507 so don't bother counting in HOW_MUCH.
4508 (INSERTED is where we count the number of characters inserted.) */
4515 /* Now we have read all the file data into the gap.
4516 If it was empty, undo marking the buffer modified. */
4520 #ifdef CLASH_DETECTION
4522 unlock_file (current_buffer
->file_truename
);
4524 Vdeactivate_mark
= old_Vdeactivate_mark
;
4527 Vdeactivate_mark
= Qt
;
4529 /* Make the text read part of the buffer. */
4530 GAP_SIZE
-= inserted
;
4532 GPT_BYTE
+= inserted
;
4534 ZV_BYTE
+= inserted
;
4539 /* Put an anchor to ensure multi-byte form ends at gap. */
4544 /* Discard the unwind protect for closing the file. */
4548 error ("IO error reading %s: %s",
4549 SDATA (orig_filename
), emacs_strerror (errno
));
4553 if (! coding_system_decided
)
4555 /* The coding system is not yet decided. Decide it by an
4556 optimized method for handling `coding:' tag.
4558 Note that we can get here only if the buffer was empty
4559 before the insertion. */
4563 if (!NILP (Vcoding_system_for_read
))
4564 val
= Vcoding_system_for_read
;
4567 /* Since we are sure that the current buffer was empty
4568 before the insertion, we can toggle
4569 enable-multibyte-characters directly here without taking
4570 care of marker adjustment and byte combining problem. By
4571 this way, we can run Lisp program safely before decoding
4572 the inserted text. */
4573 Lisp_Object unwind_data
;
4574 int count
= SPECPDL_INDEX ();
4576 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4577 Fcons (current_buffer
->undo_list
,
4578 Fcurrent_buffer ()));
4579 current_buffer
->enable_multibyte_characters
= Qnil
;
4580 current_buffer
->undo_list
= Qt
;
4581 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4583 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4585 val
= call2 (Vset_auto_coding_function
,
4586 filename
, make_number (inserted
));
4591 /* If the coding system is not yet decided, check
4592 file-coding-system-alist. */
4593 Lisp_Object args
[6], coding_systems
;
4595 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4596 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4597 coding_systems
= Ffind_operation_coding_system (6, args
);
4598 if (CONSP (coding_systems
))
4599 val
= XCAR (coding_systems
);
4601 unbind_to (count
, Qnil
);
4602 inserted
= Z_BYTE
- BEG_BYTE
;
4605 /* The following kludgy code is to avoid some compiler bug.
4607 setup_coding_system (val, &coding);
4610 struct coding_system temp_coding
;
4611 setup_coding_system (Fcheck_coding_system (val
), &temp_coding
);
4612 bcopy (&temp_coding
, &coding
, sizeof coding
);
4614 /* Ensure we set Vlast_coding_system_used. */
4615 set_coding_system
= 1;
4617 if (NILP (current_buffer
->enable_multibyte_characters
)
4619 /* We must suppress all character code conversion except for
4620 end-of-line conversion. */
4621 setup_raw_text_coding_system (&coding
);
4622 coding
.src_multibyte
= 0;
4623 coding
.dst_multibyte
4624 = !NILP (current_buffer
->enable_multibyte_characters
);
4628 /* Can't do this if part of the buffer might be preserved. */
4630 && (coding
.type
== coding_type_no_conversion
4631 || coding
.type
== coding_type_raw_text
))
4633 /* Visiting a file with these coding system makes the buffer
4635 current_buffer
->enable_multibyte_characters
= Qnil
;
4636 coding
.dst_multibyte
= 0;
4639 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4641 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4643 if (coding
.type
== coding_type_ccl
)
4644 coding
.spec
.ccl
.decoder
.quit_silently
= 1;
4645 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4647 if (coding
.type
== coding_type_ccl
)
4648 coding
.spec
.ccl
.decoder
.quit_silently
= 0;
4649 if (coding
.result
== CODING_FINISH_INTERRUPT
)
4651 /* Fixme: It is better that we report that the decoding
4652 was interruppted by the user, and the current buffer
4653 contents doesn't reflect the file correctly. */
4654 Fsignal (Qquit
, Qnil
);
4656 inserted
= coding
.produced_char
;
4659 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4663 /* Now INSERTED is measured in characters. */
4666 /* Use the conversion type to determine buffer-file-type
4667 (find-buffer-file-type is now used to help determine the
4669 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4670 || coding
.eol_type
== CODING_EOL_LF
)
4671 && ! CODING_REQUIRE_DECODING (&coding
))
4672 current_buffer
->buffer_file_type
= Qt
;
4674 current_buffer
->buffer_file_type
= Qnil
;
4681 if (!EQ (current_buffer
->undo_list
, Qt
))
4682 current_buffer
->undo_list
= Qnil
;
4684 stat (SDATA (filename
), &st
);
4689 current_buffer
->modtime
= st
.st_mtime
;
4690 current_buffer
->filename
= orig_filename
;
4693 SAVE_MODIFF
= MODIFF
;
4694 current_buffer
->auto_save_modified
= MODIFF
;
4695 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4696 #ifdef CLASH_DETECTION
4699 if (!NILP (current_buffer
->file_truename
))
4700 unlock_file (current_buffer
->file_truename
);
4701 unlock_file (filename
);
4703 #endif /* CLASH_DETECTION */
4705 xsignal2 (Qfile_error
,
4706 build_string ("not a regular file"), orig_filename
);
4709 if (set_coding_system
)
4710 Vlast_coding_system_used
= coding
.symbol
;
4712 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4714 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4716 if (! NILP (insval
))
4718 CHECK_NUMBER (insval
);
4719 inserted
= XFASTINT (insval
);
4723 /* Decode file format */
4726 int empty_undo_list_p
= 0;
4728 /* If we're anyway going to discard undo information, don't
4729 record it in the first place. The buffer's undo list at this
4730 point is either nil or t when visiting a file. */
4733 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4734 current_buffer
->undo_list
= Qt
;
4737 insval
= call3 (Qformat_decode
,
4738 Qnil
, make_number (inserted
), visit
);
4739 CHECK_NUMBER (insval
);
4740 inserted
= XFASTINT (insval
);
4743 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4746 /* Call after-change hooks for the inserted text, aside from the case
4747 of normal visiting (not with REPLACE), which is done in a new buffer
4748 "before" the buffer is changed. */
4749 if (inserted
> 0 && total
> 0
4750 && (NILP (visit
) || !NILP (replace
)))
4752 signal_after_change (PT
, 0, inserted
);
4753 update_compositions (PT
, PT
, CHECK_BORDER
);
4756 p
= Vafter_insert_file_functions
;
4759 insval
= call1 (XCAR (p
), make_number (inserted
));
4762 CHECK_NUMBER (insval
);
4763 inserted
= XFASTINT (insval
);
4770 && current_buffer
->modtime
== -1)
4772 /* If visiting nonexistent file, return nil. */
4773 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4777 Fsignal (Qquit
, Qnil
);
4779 /* ??? Retval needs to be dealt with in all cases consistently. */
4781 val
= Fcons (orig_filename
,
4782 Fcons (make_number (inserted
),
4785 RETURN_UNGCPRO (unbind_to (count
, val
));
4788 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4789 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4790 Lisp_Object
, Lisp_Object
));
4792 /* If build_annotations switched buffers, switch back to BUF.
4793 Kill the temporary buffer that was selected in the meantime.
4795 Since this kill only the last temporary buffer, some buffers remain
4796 not killed if build_annotations switched buffers more than once.
4800 build_annotations_unwind (buf
)
4805 if (XBUFFER (buf
) == current_buffer
)
4807 tembuf
= Fcurrent_buffer ();
4809 Fkill_buffer (tembuf
);
4813 /* Decide the coding-system to encode the data with. */
4816 choose_write_coding_system (start
, end
, filename
,
4817 append
, visit
, lockname
, coding
)
4818 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4819 struct coding_system
*coding
;
4824 && NILP (Fstring_equal (current_buffer
->filename
,
4825 current_buffer
->auto_save_file_name
)))
4827 /* We use emacs-mule for auto saving... */
4828 setup_coding_system (Qemacs_mule
, coding
);
4829 /* ... but with the special flag to indicate not to strip off
4830 leading code of eight-bit-control chars. */
4832 /* We force LF for end-of-line because that is faster. */
4833 coding
->eol_type
= CODING_EOL_LF
;
4834 goto done_setup_coding
;
4836 else if (!NILP (Vcoding_system_for_write
))
4838 val
= Vcoding_system_for_write
;
4839 if (coding_system_require_warning
4840 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4841 /* Confirm that VAL can surely encode the current region. */
4842 val
= call5 (Vselect_safe_coding_system_function
,
4843 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4848 /* If the variable `buffer-file-coding-system' is set locally,
4849 it means that the file was read with some kind of code
4850 conversion or the variable is explicitly set by users. We
4851 had better write it out with the same coding system even if
4852 `enable-multibyte-characters' is nil.
4854 If it is not set locally, we anyway have to convert EOL
4855 format if the default value of `buffer-file-coding-system'
4856 tells that it is not Unix-like (LF only) format. */
4857 int using_default_coding
= 0;
4858 int force_raw_text
= 0;
4860 val
= current_buffer
->buffer_file_coding_system
;
4862 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4865 if (NILP (current_buffer
->enable_multibyte_characters
))
4871 /* Check file-coding-system-alist. */
4872 Lisp_Object args
[7], coding_systems
;
4874 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4875 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4877 coding_systems
= Ffind_operation_coding_system (7, args
);
4878 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4879 val
= XCDR (coding_systems
);
4883 && !NILP (current_buffer
->buffer_file_coding_system
))
4885 /* If we still have not decided a coding system, use the
4886 default value of buffer-file-coding-system. */
4887 val
= current_buffer
->buffer_file_coding_system
;
4888 using_default_coding
= 1;
4892 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4893 /* Confirm that VAL can surely encode the current region. */
4894 val
= call5 (Vselect_safe_coding_system_function
,
4895 start
, end
, val
, Qnil
, filename
);
4897 setup_coding_system (Fcheck_coding_system (val
), coding
);
4898 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4899 && !using_default_coding
)
4901 if (! EQ (default_buffer_file_coding
.symbol
,
4902 buffer_defaults
.buffer_file_coding_system
))
4903 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4904 &default_buffer_file_coding
);
4905 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4907 Lisp_Object subsidiaries
;
4909 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4910 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4911 if (VECTORP (subsidiaries
)
4912 && XVECTOR (subsidiaries
)->size
== 3)
4914 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4919 setup_raw_text_coding_system (coding
);
4920 goto done_setup_coding
;
4923 setup_coding_system (Fcheck_coding_system (val
), coding
);
4926 if (coding
->eol_type
== CODING_EOL_UNDECIDED
)
4927 coding
->eol_type
= system_eol_type
;
4928 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4929 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4932 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4933 "r\nFWrite region to file: \ni\ni\ni\np",
4934 doc
: /* Write current region into specified file.
4935 When called from a program, requires three arguments:
4936 START, END and FILENAME. START and END are normally buffer positions
4937 specifying the part of the buffer to write.
4938 If START is nil, that means to use the entire buffer contents.
4939 If START is a string, then output that string to the file
4940 instead of any buffer contents; END is ignored.
4942 Optional fourth argument APPEND if non-nil means
4943 append to existing file contents (if any). If it is an integer,
4944 seek to that offset in the file before writing.
4945 Optional fifth argument VISIT, if t or a string, means
4946 set the last-save-file-modtime of buffer to this file's modtime
4947 and mark buffer not modified.
4948 If VISIT is a string, it is a second file name;
4949 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4950 VISIT is also the file name to lock and unlock for clash detection.
4951 If VISIT is neither t nor nil nor a string,
4952 that means do not display the \"Wrote file\" message.
4953 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4954 use for locking and unlocking, overriding FILENAME and VISIT.
4955 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4956 for an existing file with the same name. If MUSTBENEW is `excl',
4957 that means to get an error if the file already exists; never overwrite.
4958 If MUSTBENEW is neither nil nor `excl', that means ask for
4959 confirmation before overwriting, but do go ahead and overwrite the file
4960 if the user confirms.
4962 This does code conversion according to the value of
4963 `coding-system-for-write', `buffer-file-coding-system', or
4964 `file-coding-system-alist', and sets the variable
4965 `last-coding-system-used' to the coding system actually used. */)
4966 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4967 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4972 const unsigned char *fn
;
4975 int count
= SPECPDL_INDEX ();
4978 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4980 Lisp_Object handler
;
4981 Lisp_Object visit_file
;
4982 Lisp_Object annotations
;
4983 Lisp_Object encoded_filename
;
4984 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4985 int quietly
= !NILP (visit
);
4986 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4987 struct buffer
*given_buffer
;
4989 int buffer_file_type
= O_BINARY
;
4991 struct coding_system coding
;
4993 if (current_buffer
->base_buffer
&& visiting
)
4994 error ("Cannot do file visiting in an indirect buffer");
4996 if (!NILP (start
) && !STRINGP (start
))
4997 validate_region (&start
, &end
);
5000 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
5002 filename
= Fexpand_file_name (filename
, Qnil
);
5004 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
5005 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
5007 if (STRINGP (visit
))
5008 visit_file
= Fexpand_file_name (visit
, Qnil
);
5010 visit_file
= filename
;
5012 if (NILP (lockname
))
5013 lockname
= visit_file
;
5017 /* If the file name has special constructs in it,
5018 call the corresponding file handler. */
5019 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
5020 /* If FILENAME has no handler, see if VISIT has one. */
5021 if (NILP (handler
) && STRINGP (visit
))
5022 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
5024 if (!NILP (handler
))
5027 val
= call6 (handler
, Qwrite_region
, start
, end
,
5028 filename
, append
, visit
);
5032 SAVE_MODIFF
= MODIFF
;
5033 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5034 current_buffer
->filename
= visit_file
;
5040 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
5042 /* Special kludge to simplify auto-saving. */
5045 XSETFASTINT (start
, BEG
);
5046 XSETFASTINT (end
, Z
);
5050 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
5051 count1
= SPECPDL_INDEX ();
5053 given_buffer
= current_buffer
;
5055 if (!STRINGP (start
))
5057 annotations
= build_annotations (start
, end
);
5059 if (current_buffer
!= given_buffer
)
5061 XSETFASTINT (start
, BEGV
);
5062 XSETFASTINT (end
, ZV
);
5068 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
5070 /* Decide the coding-system to encode the data with.
5071 We used to make this choice before calling build_annotations, but that
5072 leads to problems when a write-annotate-function takes care of
5073 unsavable chars (as was the case with X-Symbol). */
5074 choose_write_coding_system (start
, end
, filename
,
5075 append
, visit
, lockname
, &coding
);
5076 Vlast_coding_system_used
= coding
.symbol
;
5078 given_buffer
= current_buffer
;
5079 if (! STRINGP (start
))
5081 annotations
= build_annotations_2 (start
, end
,
5082 coding
.pre_write_conversion
, annotations
);
5083 if (current_buffer
!= given_buffer
)
5085 XSETFASTINT (start
, BEGV
);
5086 XSETFASTINT (end
, ZV
);
5090 #ifdef CLASH_DETECTION
5093 #if 0 /* This causes trouble for GNUS. */
5094 /* If we've locked this file for some other buffer,
5095 query before proceeding. */
5096 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5097 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5100 lock_file (lockname
);
5102 #endif /* CLASH_DETECTION */
5104 encoded_filename
= ENCODE_FILE (filename
);
5106 fn
= SDATA (encoded_filename
);
5110 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5111 #else /* not DOS_NT */
5112 desc
= emacs_open (fn
, O_WRONLY
, 0);
5113 #endif /* not DOS_NT */
5115 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5117 if (auto_saving
) /* Overwrite any previous version of autosave file */
5119 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5120 desc
= emacs_open (fn
, O_RDWR
, 0);
5122 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5123 ? SDATA (current_buffer
->filename
) : 0,
5126 else /* Write to temporary name and rename if no errors */
5128 Lisp_Object temp_name
;
5129 temp_name
= Ffile_name_directory (filename
);
5131 if (!NILP (temp_name
))
5133 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5134 build_string ("$$SAVE$$")));
5135 fname
= SDATA (filename
);
5136 fn
= SDATA (temp_name
);
5137 desc
= creat_copy_attrs (fname
, fn
);
5140 /* If we can't open the temporary file, try creating a new
5141 version of the original file. VMS "creat" creates a
5142 new version rather than truncating an existing file. */
5145 desc
= creat (fn
, 0666);
5146 #if 0 /* This can clobber an existing file and fail to replace it,
5147 if the user runs out of space. */
5150 /* We can't make a new version;
5151 try to truncate and rewrite existing version if any. */
5153 desc
= emacs_open (fn
, O_RDWR
, 0);
5159 desc
= creat (fn
, 0666);
5163 desc
= emacs_open (fn
,
5164 O_WRONLY
| O_CREAT
| buffer_file_type
5165 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5166 S_IREAD
| S_IWRITE
);
5167 #else /* not DOS_NT */
5168 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5169 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5170 auto_saving
? auto_save_mode_bits
: 0666);
5171 #endif /* not DOS_NT */
5172 #endif /* not VMS */
5176 #ifdef CLASH_DETECTION
5178 if (!auto_saving
) unlock_file (lockname
);
5180 #endif /* CLASH_DETECTION */
5182 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5185 record_unwind_protect (close_file_unwind
, make_number (desc
));
5187 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5191 if (NUMBERP (append
))
5192 ret
= lseek (desc
, XINT (append
), 1);
5194 ret
= lseek (desc
, 0, 2);
5197 #ifdef CLASH_DETECTION
5198 if (!auto_saving
) unlock_file (lockname
);
5199 #endif /* CLASH_DETECTION */
5201 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5209 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5210 * if we do writes that don't end with a carriage return. Furthermore
5211 * it cannot handle writes of more then 16K. The modified
5212 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5213 * this EXCEPT for the last record (if it doesn't end with a carriage
5214 * return). This implies that if your buffer doesn't end with a carriage
5215 * return, you get one free... tough. However it also means that if
5216 * we make two calls to sys_write (a la the following code) you can
5217 * get one at the gap as well. The easiest way to fix this (honest)
5218 * is to move the gap to the next newline (or the end of the buffer).
5223 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5224 move_gap (find_next_newline (GPT
, 1));
5226 /* Whether VMS or not, we must move the gap to the next of newline
5227 when we must put designation sequences at beginning of line. */
5228 if (INTEGERP (start
)
5229 && coding
.type
== coding_type_iso2022
5230 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5231 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5233 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5234 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5235 move_gap_both (PT
, PT_BYTE
);
5236 SET_PT_BOTH (opoint
, opoint_byte
);
5243 if (STRINGP (start
))
5245 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5246 &annotations
, &coding
);
5249 else if (XINT (start
) != XINT (end
))
5251 tem
= CHAR_TO_BYTE (XINT (start
));
5253 if (XINT (start
) < GPT
)
5255 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5256 min (GPT
, XINT (end
)) - XINT (start
),
5257 &annotations
, &coding
);
5261 if (XINT (end
) > GPT
&& !failure
)
5263 tem
= max (XINT (start
), GPT
);
5264 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5265 &annotations
, &coding
);
5271 /* If file was empty, still need to write the annotations */
5272 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5273 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5277 if (CODING_REQUIRE_FLUSHING (&coding
)
5278 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5281 /* We have to flush out a data. */
5282 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5283 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5290 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5291 Disk full in NFS may be reported here. */
5292 /* mib says that closing the file will try to write as fast as NFS can do
5293 it, and that means the fsync here is not crucial for autosave files. */
5294 if (!auto_saving
&& !write_region_inhibit_fsync
&& fsync (desc
) < 0)
5296 /* If fsync fails with EINTR, don't treat that as serious. Also
5297 ignore EINVAL which happens when fsync is not supported on this
5299 if (errno
!= EINTR
&& errno
!= EINVAL
)
5300 failure
= 1, save_errno
= errno
;
5304 /* Spurious "file has changed on disk" warnings have been
5305 observed on Suns as well.
5306 It seems that `close' can change the modtime, under nfs.
5308 (This has supposedly been fixed in Sunos 4,
5309 but who knows about all the other machines with NFS?) */
5312 /* On VMS and APOLLO, must do the stat after the close
5313 since closing changes the modtime. */
5316 /* Recall that #if defined does not work on VMS. */
5323 /* NFS can report a write failure now. */
5324 if (emacs_close (desc
) < 0)
5325 failure
= 1, save_errno
= errno
;
5328 /* If we wrote to a temporary name and had no errors, rename to real name. */
5332 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5340 /* Discard the unwind protect for close_file_unwind. */
5341 specpdl_ptr
= specpdl
+ count1
;
5342 /* Restore the original current buffer. */
5343 visit_file
= unbind_to (count
, visit_file
);
5345 #ifdef CLASH_DETECTION
5347 unlock_file (lockname
);
5348 #endif /* CLASH_DETECTION */
5350 /* Do this before reporting IO error
5351 to avoid a "file has changed on disk" warning on
5352 next attempt to save. */
5354 current_buffer
->modtime
= st
.st_mtime
;
5357 error ("IO error writing %s: %s", SDATA (filename
),
5358 emacs_strerror (save_errno
));
5362 SAVE_MODIFF
= MODIFF
;
5363 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5364 current_buffer
->filename
= visit_file
;
5365 update_mode_lines
++;
5370 && ! NILP (Fstring_equal (current_buffer
->filename
,
5371 current_buffer
->auto_save_file_name
)))
5372 SAVE_MODIFF
= MODIFF
;
5378 message_with_string ((INTEGERP (append
)
5388 Lisp_Object
merge ();
5390 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5391 doc
: /* Return t if (car A) is numerically less than (car B). */)
5395 return Flss (Fcar (a
), Fcar (b
));
5398 /* Build the complete list of annotations appropriate for writing out
5399 the text between START and END, by calling all the functions in
5400 write-region-annotate-functions and merging the lists they return.
5401 If one of these functions switches to a different buffer, we assume
5402 that buffer contains altered text. Therefore, the caller must
5403 make sure to restore the current buffer in all cases,
5404 as save-excursion would do. */
5407 build_annotations (start
, end
)
5408 Lisp_Object start
, end
;
5410 Lisp_Object annotations
;
5412 struct gcpro gcpro1
, gcpro2
;
5413 Lisp_Object original_buffer
;
5414 int i
, used_global
= 0;
5416 XSETBUFFER (original_buffer
, current_buffer
);
5419 p
= Vwrite_region_annotate_functions
;
5420 GCPRO2 (annotations
, p
);
5423 struct buffer
*given_buffer
= current_buffer
;
5424 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5425 { /* Use the global value of the hook. */
5428 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5430 p
= Fappend (2, arg
);
5433 Vwrite_region_annotations_so_far
= annotations
;
5434 res
= call2 (XCAR (p
), start
, end
);
5435 /* If the function makes a different buffer current,
5436 assume that means this buffer contains altered text to be output.
5437 Reset START and END from the buffer bounds
5438 and discard all previous annotations because they should have
5439 been dealt with by this function. */
5440 if (current_buffer
!= given_buffer
)
5442 XSETFASTINT (start
, BEGV
);
5443 XSETFASTINT (end
, ZV
);
5446 Flength (res
); /* Check basic validity of return value */
5447 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5451 /* Now do the same for annotation functions implied by the file-format */
5452 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
5453 p
= current_buffer
->auto_save_file_format
;
5455 p
= current_buffer
->file_format
;
5456 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5458 struct buffer
*given_buffer
= current_buffer
;
5460 Vwrite_region_annotations_so_far
= annotations
;
5462 /* Value is either a list of annotations or nil if the function
5463 has written annotations to a temporary buffer, which is now
5465 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5466 original_buffer
, make_number (i
));
5467 if (current_buffer
!= given_buffer
)
5469 XSETFASTINT (start
, BEGV
);
5470 XSETFASTINT (end
, ZV
);
5475 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5483 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5484 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5486 struct gcpro gcpro1
;
5489 GCPRO1 (annotations
);
5490 /* At last, do the same for the function PRE_WRITE_CONVERSION
5491 implied by the current coding-system. */
5492 if (!NILP (pre_write_conversion
))
5494 struct buffer
*given_buffer
= current_buffer
;
5495 Vwrite_region_annotations_so_far
= annotations
;
5496 res
= call2 (pre_write_conversion
, start
, end
);
5498 annotations
= (current_buffer
!= given_buffer
5500 : merge (annotations
, res
, Qcar_less_than_car
));
5507 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5508 If STRING is nil, POS is the character position in the current buffer.
5509 Intersperse with them the annotations from *ANNOT
5510 which fall within the range of POS to POS + NCHARS,
5511 each at its appropriate position.
5513 We modify *ANNOT by discarding elements as we use them up.
5515 The return value is negative in case of system call failure. */
5518 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5521 register int nchars
;
5524 struct coding_system
*coding
;
5528 int lastpos
= pos
+ nchars
;
5530 while (NILP (*annot
) || CONSP (*annot
))
5532 tem
= Fcar_safe (Fcar (*annot
));
5535 nextpos
= XFASTINT (tem
);
5537 /* If there are no more annotations in this range,
5538 output the rest of the range all at once. */
5539 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5540 return e_write (desc
, string
, pos
, lastpos
, coding
);
5542 /* Output buffer text up to the next annotation's position. */
5545 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5549 /* Output the annotation. */
5550 tem
= Fcdr (Fcar (*annot
));
5553 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5556 *annot
= Fcdr (*annot
);
5561 #ifndef WRITE_BUF_SIZE
5562 #define WRITE_BUF_SIZE (16 * 1024)
5565 /* Write text in the range START and END into descriptor DESC,
5566 encoding them with coding system CODING. If STRING is nil, START
5567 and END are character positions of the current buffer, else they
5568 are indexes to the string STRING. */
5571 e_write (desc
, string
, start
, end
, coding
)
5575 struct coding_system
*coding
;
5577 register char *addr
;
5578 register int nbytes
;
5579 char buf
[WRITE_BUF_SIZE
];
5583 coding
->composing
= COMPOSITION_DISABLED
;
5584 if (coding
->composing
!= COMPOSITION_DISABLED
)
5585 coding_save_composition (coding
, start
, end
, string
);
5587 if (STRINGP (string
))
5589 addr
= SDATA (string
);
5590 nbytes
= SBYTES (string
);
5591 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5593 else if (start
< end
)
5595 /* It is assured that the gap is not in the range START and END-1. */
5596 addr
= CHAR_POS_ADDR (start
);
5597 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5598 coding
->src_multibyte
5599 = !NILP (current_buffer
->enable_multibyte_characters
);
5605 coding
->src_multibyte
= 1;
5608 /* We used to have a code for handling selective display here. But,
5609 now it is handled within encode_coding. */
5614 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5615 if (coding
->produced
> 0)
5617 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5618 if (coding
->produced
)
5624 nbytes
-= coding
->consumed
;
5625 addr
+= coding
->consumed
;
5626 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5629 /* The source text ends by an incomplete multibyte form.
5630 There's no way other than write it out as is. */
5631 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5640 start
+= coding
->consumed_char
;
5641 if (coding
->cmp_data
)
5642 coding_adjust_composition_offset (coding
, start
);
5645 if (coding
->cmp_data
)
5646 coding_free_composition_data (coding
);
5651 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5652 Sverify_visited_file_modtime
, 1, 1, 0,
5653 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5654 This means that the file has not been changed since it was visited or saved.
5655 See Info node `(elisp)Modification Time' for more details. */)
5661 Lisp_Object handler
;
5662 Lisp_Object filename
;
5667 if (!STRINGP (b
->filename
)) return Qt
;
5668 if (b
->modtime
== 0) return Qt
;
5670 /* If the file name has special constructs in it,
5671 call the corresponding file handler. */
5672 handler
= Ffind_file_name_handler (b
->filename
,
5673 Qverify_visited_file_modtime
);
5674 if (!NILP (handler
))
5675 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5677 filename
= ENCODE_FILE (b
->filename
);
5679 if (stat (SDATA (filename
), &st
) < 0)
5681 /* If the file doesn't exist now and didn't exist before,
5682 we say that it isn't modified, provided the error is a tame one. */
5683 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5688 if (st
.st_mtime
== b
->modtime
5689 /* If both are positive, accept them if they are off by one second. */
5690 || (st
.st_mtime
> 0 && b
->modtime
> 0
5691 && (st
.st_mtime
== b
->modtime
+ 1
5692 || st
.st_mtime
== b
->modtime
- 1)))
5697 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5698 Sclear_visited_file_modtime
, 0, 0, 0,
5699 doc
: /* Clear out records of last mod time of visited file.
5700 Next attempt to save will certainly not complain of a discrepancy. */)
5703 current_buffer
->modtime
= 0;
5707 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5708 Svisited_file_modtime
, 0, 0, 0,
5709 doc
: /* Return the current buffer's recorded visited file modification time.
5710 The value is a list of the form (HIGH LOW), like the time values
5711 that `file-attributes' returns. If the current buffer has no recorded
5712 file modification time, this function returns 0.
5713 See Info node `(elisp)Modification Time' for more details. */)
5716 if (! current_buffer
->modtime
)
5717 return make_number (0);
5718 return make_time ((time_t) current_buffer
->modtime
);
5721 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5722 Sset_visited_file_modtime
, 0, 1, 0,
5723 doc
: /* Update buffer's recorded modification time from the visited file's time.
5724 Useful if the buffer was not read from the file normally
5725 or if the file itself has been changed for some known benign reason.
5726 An argument specifies the modification time value to use
5727 \(instead of that of the visited file), in the form of a list
5728 \(HIGH . LOW) or (HIGH LOW). */)
5730 Lisp_Object time_list
;
5732 if (!NILP (time_list
))
5733 current_buffer
->modtime
= cons_to_long (time_list
);
5736 register Lisp_Object filename
;
5738 Lisp_Object handler
;
5740 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5742 /* If the file name has special constructs in it,
5743 call the corresponding file handler. */
5744 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5745 if (!NILP (handler
))
5746 /* The handler can find the file name the same way we did. */
5747 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5749 filename
= ENCODE_FILE (filename
);
5751 if (stat (SDATA (filename
), &st
) >= 0)
5752 current_buffer
->modtime
= st
.st_mtime
;
5759 auto_save_error (error
)
5762 Lisp_Object args
[3], msg
;
5764 struct gcpro gcpro1
;
5768 auto_save_error_occurred
= 1;
5772 args
[0] = build_string ("Auto-saving %s: %s");
5773 args
[1] = current_buffer
->name
;
5774 args
[2] = Ferror_message_string (error
);
5775 msg
= Fformat (3, args
);
5777 nbytes
= SBYTES (msg
);
5778 SAFE_ALLOCA (msgbuf
, char *, nbytes
);
5779 bcopy (SDATA (msg
), msgbuf
, nbytes
);
5781 for (i
= 0; i
< 3; ++i
)
5784 message2 (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5786 message2_nolog (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5787 Fsleep_for (make_number (1), Qnil
);
5801 auto_save_mode_bits
= 0666;
5803 /* Get visited file's mode to become the auto save file's mode. */
5804 if (! NILP (current_buffer
->filename
))
5806 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5807 /* But make sure we can overwrite it later! */
5808 auto_save_mode_bits
= st
.st_mode
| 0600;
5809 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5811 /* Remote files don't cooperate with stat. */
5812 auto_save_mode_bits
= XINT (modes
) | 0600;
5816 Fwrite_region (Qnil
, Qnil
,
5817 current_buffer
->auto_save_file_name
,
5818 Qnil
, Qlambda
, Qnil
, Qnil
);
5822 do_auto_save_unwind (arg
) /* used as unwind-protect function */
5825 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
5837 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5840 minibuffer_auto_raise
= XINT (value
);
5845 do_auto_save_make_dir (dir
)
5850 call2 (Qmake_directory
, dir
, Qt
);
5851 XSETFASTINT (mode
, 0700);
5852 return Fset_file_modes (dir
, mode
);
5856 do_auto_save_eh (ignore
)
5862 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5863 doc
: /* Auto-save all buffers that need it.
5864 This is all buffers that have auto-saving enabled
5865 and are changed since last auto-saved.
5866 Auto-saving writes the buffer into a file
5867 so that your editing is not lost if the system crashes.
5868 This file is not the file you visited; that changes only when you save.
5869 Normally we run the normal hook `auto-save-hook' before saving.
5871 A non-nil NO-MESSAGE argument means do not print any message if successful.
5872 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5873 (no_message
, current_only
)
5874 Lisp_Object no_message
, current_only
;
5876 struct buffer
*old
= current_buffer
, *b
;
5877 Lisp_Object tail
, buf
;
5879 int do_handled_files
;
5881 FILE *stream
= NULL
;
5882 int count
= SPECPDL_INDEX ();
5883 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5884 int old_message_p
= 0;
5885 struct gcpro gcpro1
, gcpro2
;
5887 if (max_specpdl_size
< specpdl_size
+ 40)
5888 max_specpdl_size
= specpdl_size
+ 40;
5893 if (NILP (no_message
))
5895 old_message_p
= push_message ();
5896 record_unwind_protect (pop_message_unwind
, Qnil
);
5899 /* Ordinarily don't quit within this function,
5900 but don't make it impossible to quit (in case we get hung in I/O). */
5904 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5905 point to non-strings reached from Vbuffer_alist. */
5907 if (!NILP (Vrun_hooks
))
5908 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5910 if (STRINGP (Vauto_save_list_file_name
))
5912 Lisp_Object listfile
;
5914 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5916 /* Don't try to create the directory when shutting down Emacs,
5917 because creating the directory might signal an error, and
5918 that would leave Emacs in a strange state. */
5919 if (!NILP (Vrun_hooks
))
5923 GCPRO2 (dir
, listfile
);
5924 dir
= Ffile_name_directory (listfile
);
5925 if (NILP (Ffile_directory_p (dir
)))
5926 internal_condition_case_1 (do_auto_save_make_dir
,
5927 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5932 stream
= fopen (SDATA (listfile
), "w");
5935 record_unwind_protect (do_auto_save_unwind
,
5936 make_save_value (stream
, 0));
5937 record_unwind_protect (do_auto_save_unwind_1
,
5938 make_number (minibuffer_auto_raise
));
5939 minibuffer_auto_raise
= 0;
5941 auto_save_error_occurred
= 0;
5943 /* On first pass, save all files that don't have handlers.
5944 On second pass, save all files that do have handlers.
5946 If Emacs is crashing, the handlers may tweak what is causing
5947 Emacs to crash in the first place, and it would be a shame if
5948 Emacs failed to autosave perfectly ordinary files because it
5949 couldn't handle some ange-ftp'd file. */
5951 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5952 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5954 buf
= XCDR (XCAR (tail
));
5957 /* Record all the buffers that have auto save mode
5958 in the special file that lists them. For each of these buffers,
5959 Record visited name (if any) and auto save name. */
5960 if (STRINGP (b
->auto_save_file_name
)
5961 && stream
!= NULL
&& do_handled_files
== 0)
5964 if (!NILP (b
->filename
))
5966 fwrite (SDATA (b
->filename
), 1,
5967 SBYTES (b
->filename
), stream
);
5969 putc ('\n', stream
);
5970 fwrite (SDATA (b
->auto_save_file_name
), 1,
5971 SBYTES (b
->auto_save_file_name
), stream
);
5972 putc ('\n', stream
);
5976 if (!NILP (current_only
)
5977 && b
!= current_buffer
)
5980 /* Don't auto-save indirect buffers.
5981 The base buffer takes care of it. */
5985 /* Check for auto save enabled
5986 and file changed since last auto save
5987 and file changed since last real save. */
5988 if (STRINGP (b
->auto_save_file_name
)
5989 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5990 && b
->auto_save_modified
< BUF_MODIFF (b
)
5991 /* -1 means we've turned off autosaving for a while--see below. */
5992 && XINT (b
->save_length
) >= 0
5993 && (do_handled_files
5994 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5997 EMACS_TIME before_time
, after_time
;
5999 EMACS_GET_TIME (before_time
);
6001 /* If we had a failure, don't try again for 20 minutes. */
6002 if (b
->auto_save_failure_time
>= 0
6003 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
6006 if ((XFASTINT (b
->save_length
) * 10
6007 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
6008 /* A short file is likely to change a large fraction;
6009 spare the user annoying messages. */
6010 && XFASTINT (b
->save_length
) > 5000
6011 /* These messages are frequent and annoying for `*mail*'. */
6012 && !EQ (b
->filename
, Qnil
)
6013 && NILP (no_message
))
6015 /* It has shrunk too much; turn off auto-saving here. */
6016 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
6017 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
6019 minibuffer_auto_raise
= 0;
6020 /* Turn off auto-saving until there's a real save,
6021 and prevent any more warnings. */
6022 XSETINT (b
->save_length
, -1);
6023 Fsleep_for (make_number (1), Qnil
);
6026 set_buffer_internal (b
);
6027 if (!auto_saved
&& NILP (no_message
))
6028 message1 ("Auto-saving...");
6029 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
6031 b
->auto_save_modified
= BUF_MODIFF (b
);
6032 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6033 set_buffer_internal (old
);
6035 EMACS_GET_TIME (after_time
);
6037 /* If auto-save took more than 60 seconds,
6038 assume it was an NFS failure that got a timeout. */
6039 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
6040 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
6044 /* Prevent another auto save till enough input events come in. */
6045 record_auto_save ();
6047 if (auto_saved
&& NILP (no_message
))
6051 /* If we are going to restore an old message,
6052 give time to read ours. */
6053 sit_for (make_number (1), 0, 0);
6056 else if (!auto_save_error_occurred
)
6057 /* Don't overwrite the error message if an error occurred.
6058 If we displayed a message and then restored a state
6059 with no message, leave a "done" message on the screen. */
6060 message1 ("Auto-saving...done");
6065 /* This restores the message-stack status. */
6066 unbind_to (count
, Qnil
);
6070 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
6071 Sset_buffer_auto_saved
, 0, 0, 0,
6072 doc
: /* Mark current buffer as auto-saved with its current text.
6073 No auto-save file will be written until the buffer changes again. */)
6076 current_buffer
->auto_save_modified
= MODIFF
;
6077 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6078 current_buffer
->auto_save_failure_time
= -1;
6082 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
6083 Sclear_buffer_auto_save_failure
, 0, 0, 0,
6084 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
6087 current_buffer
->auto_save_failure_time
= -1;
6091 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6093 doc
: /* Return t if current buffer has been auto-saved recently.
6094 More precisely, if it has been auto-saved since last read from or saved
6095 in the visited file. If the buffer has no visited file,
6096 then any auto-save counts as "recent". */)
6099 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6102 /* Reading and completing file names */
6103 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
6104 extern Lisp_Object Qcompletion_ignore_case
;
6106 /* In the string VAL, change each $ to $$ and return the result. */
6109 double_dollars (val
)
6112 register const unsigned char *old
;
6113 register unsigned char *new;
6117 osize
= SBYTES (val
);
6119 /* Count the number of $ characters. */
6120 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
6121 if (*old
++ == '$') count
++;
6125 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
6128 for (n
= osize
; n
> 0; n
--)
6142 read_file_name_cleanup (arg
)
6145 return (current_buffer
->directory
= arg
);
6148 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
6150 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
6151 (string
, dir
, action
)
6152 Lisp_Object string
, dir
, action
;
6153 /* action is nil for complete, t for return list of completions,
6154 lambda for verify final value */
6156 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
6158 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
6160 CHECK_STRING (string
);
6167 /* No need to protect ACTION--we only compare it with t and nil. */
6168 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6170 if (SCHARS (string
) == 0)
6172 if (EQ (action
, Qlambda
))
6180 orig_string
= string
;
6181 string
= Fsubstitute_in_file_name (string
);
6182 changed
= NILP (Fstring_equal (string
, orig_string
));
6183 name
= Ffile_name_nondirectory (string
);
6184 val
= Ffile_name_directory (string
);
6186 realdir
= Fexpand_file_name (val
, realdir
);
6191 specdir
= Ffile_name_directory (string
);
6192 val
= Ffile_name_completion (name
, realdir
, Vread_file_name_predicate
);
6197 return double_dollars (string
);
6201 if (!NILP (specdir
))
6202 val
= concat2 (specdir
, val
);
6204 return double_dollars (val
);
6207 #endif /* not VMS */
6211 if (EQ (action
, Qt
))
6213 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6217 if (NILP (Vread_file_name_predicate
)
6218 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6222 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6224 /* Brute-force speed up for directory checking:
6225 Discard strings which don't end in a slash. */
6226 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6228 Lisp_Object tem
= XCAR (all
);
6231 && (len
= SBYTES (tem
), len
> 0)
6232 && IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6233 comp
= Fcons (tem
, comp
);
6239 /* Must do it the hard (and slow) way. */
6241 GCPRO3 (all
, comp
, specdir
);
6242 count
= SPECPDL_INDEX ();
6243 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6244 current_buffer
->directory
= realdir
;
6245 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6247 tem
= call1 (Vread_file_name_predicate
, XCAR (all
));
6249 comp
= Fcons (XCAR (all
), comp
);
6251 unbind_to (count
, Qnil
);
6254 return Fnreverse (comp
);
6257 /* Only other case actually used is ACTION = lambda */
6259 /* Supposedly this helps commands such as `cd' that read directory names,
6260 but can someone explain how it helps them? -- RMS */
6261 if (SCHARS (name
) == 0)
6264 string
= Fexpand_file_name (string
, dir
);
6265 if (!NILP (Vread_file_name_predicate
))
6266 return call1 (Vread_file_name_predicate
, string
);
6267 return Ffile_exists_p (string
);
6270 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
6271 Snext_read_file_uses_dialog_p
, 0, 0, 0,
6272 doc
: /* Return t if a call to `read-file-name' will use a dialog.
6273 The return value is only relevant for a call to `read-file-name' that happens
6274 before any other event (mouse or keypress) is handeled. */)
6277 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6278 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6287 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6288 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6289 Value is not expanded---you must call `expand-file-name' yourself.
6290 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6291 the same non-empty string that was inserted by this function.
6292 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6293 except that if INITIAL is specified, that combined with DIR is used.)
6294 If the user exits with an empty minibuffer, this function returns
6295 an empty string. (This can only happen if the user erased the
6296 pre-inserted contents or if `insert-default-directory' is nil.)
6297 Fourth arg MUSTMATCH non-nil means require existing file's name.
6298 Non-nil and non-t means also require confirmation after completion.
6299 Fifth arg INITIAL specifies text to start with.
6300 If optional sixth arg PREDICATE is non-nil, possible completions and
6301 the resulting file name must satisfy (funcall PREDICATE NAME).
6302 DIR should be an absolute directory name. It defaults to the value of
6303 `default-directory'.
6305 If this command was invoked with the mouse, use a file dialog box if
6306 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6307 provides a file dialog box.
6309 See also `read-file-name-completion-ignore-case'
6310 and `read-file-name-function'. */)
6311 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6312 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6314 Lisp_Object val
, insdef
, tem
;
6315 struct gcpro gcpro1
, gcpro2
;
6316 register char *homedir
;
6317 Lisp_Object decoded_homedir
;
6318 int replace_in_history
= 0;
6319 int add_to_history
= 0;
6323 dir
= current_buffer
->directory
;
6324 if (NILP (Ffile_name_absolute_p (dir
)))
6325 dir
= Fexpand_file_name (dir
, Qnil
);
6326 if (NILP (default_filename
))
6329 ? Fexpand_file_name (initial
, dir
)
6330 : current_buffer
->filename
);
6332 /* If dir starts with user's homedir, change that to ~. */
6333 homedir
= (char *) egetenv ("HOME");
6335 /* homedir can be NULL in temacs, since Vprocess_environment is not
6336 yet set up. We shouldn't crash in that case. */
6339 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6340 CORRECT_DIR_SEPS (homedir
);
6345 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6348 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6349 SBYTES (decoded_homedir
))
6350 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6352 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6353 dir
= concat2 (build_string ("~"), dir
);
6355 /* Likewise for default_filename. */
6357 && STRINGP (default_filename
)
6358 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6359 SBYTES (decoded_homedir
))
6360 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6363 = Fsubstring (default_filename
,
6364 make_number (SCHARS (decoded_homedir
)), Qnil
);
6365 default_filename
= concat2 (build_string ("~"), default_filename
);
6367 if (!NILP (default_filename
))
6369 CHECK_STRING (default_filename
);
6370 default_filename
= double_dollars (default_filename
);
6373 if (insert_default_directory
&& STRINGP (dir
))
6376 if (!NILP (initial
))
6378 Lisp_Object args
[2], pos
;
6382 insdef
= Fconcat (2, args
);
6383 pos
= make_number (SCHARS (double_dollars (dir
)));
6384 insdef
= Fcons (double_dollars (insdef
), pos
);
6387 insdef
= double_dollars (insdef
);
6389 else if (STRINGP (initial
))
6390 insdef
= Fcons (double_dollars (initial
), make_number (0));
6394 if (!NILP (Vread_file_name_function
))
6396 Lisp_Object args
[7];
6398 GCPRO2 (insdef
, default_filename
);
6399 args
[0] = Vread_file_name_function
;
6402 args
[3] = default_filename
;
6403 args
[4] = mustmatch
;
6405 args
[6] = predicate
;
6406 RETURN_UNGCPRO (Ffuncall (7, args
));
6409 count
= SPECPDL_INDEX ();
6410 specbind (Qcompletion_ignore_case
,
6411 read_file_name_completion_ignore_case
? Qt
: Qnil
);
6412 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6413 specbind (intern ("read-file-name-predicate"),
6414 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6416 GCPRO2 (insdef
, default_filename
);
6418 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6419 if (! NILP (Fnext_read_file_uses_dialog_p ()))
6421 /* If DIR contains a file name, split it. */
6423 file
= Ffile_name_nondirectory (dir
);
6424 if (SCHARS (file
) && NILP (default_filename
))
6426 default_filename
= file
;
6427 dir
= Ffile_name_directory (dir
);
6429 if (!NILP(default_filename
))
6430 default_filename
= Fexpand_file_name (default_filename
, dir
);
6431 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
,
6432 EQ (predicate
, Qfile_directory_p
) ? Qt
: Qnil
);
6437 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6438 dir
, mustmatch
, insdef
,
6439 Qfile_name_history
, default_filename
, Qnil
);
6441 tem
= Fsymbol_value (Qfile_name_history
);
6442 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6443 replace_in_history
= 1;
6445 /* If Fcompleting_read returned the inserted default string itself
6446 (rather than a new string with the same contents),
6447 it has to mean that the user typed RET with the minibuffer empty.
6448 In that case, we really want to return ""
6449 so that commands such as set-visited-file-name can distinguish. */
6450 if (EQ (val
, default_filename
))
6452 /* In this case, Fcompleting_read has not added an element
6453 to the history. Maybe we should. */
6454 if (! replace_in_history
)
6460 unbind_to (count
, Qnil
);
6463 error ("No file name specified");
6465 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6467 if (!NILP (tem
) && !NILP (default_filename
))
6468 val
= default_filename
;
6469 val
= Fsubstitute_in_file_name (val
);
6471 if (replace_in_history
)
6472 /* Replace what Fcompleting_read added to the history
6473 with what we will actually return. */
6475 Lisp_Object val1
= double_dollars (val
);
6476 tem
= Fsymbol_value (Qfile_name_history
);
6477 if (history_delete_duplicates
)
6478 XSETCDR (tem
, Fdelete (val1
, XCDR(tem
)));
6479 XSETCAR (tem
, val1
);
6481 else if (add_to_history
)
6483 /* Add the value to the history--but not if it matches
6484 the last value already there. */
6485 Lisp_Object val1
= double_dollars (val
);
6486 tem
= Fsymbol_value (Qfile_name_history
);
6487 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6489 if (history_delete_duplicates
) tem
= Fdelete (val1
, tem
);
6490 Fset (Qfile_name_history
, Fcons (val1
, tem
));
6501 /* Must be set before any path manipulation is performed. */
6502 XSETFASTINT (Vdirectory_sep_char
, '/');
6509 Qoperations
= intern ("operations");
6510 Qexpand_file_name
= intern ("expand-file-name");
6511 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6512 Qdirectory_file_name
= intern ("directory-file-name");
6513 Qfile_name_directory
= intern ("file-name-directory");
6514 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6515 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6516 Qfile_name_as_directory
= intern ("file-name-as-directory");
6517 Qcopy_file
= intern ("copy-file");
6518 Qmake_directory_internal
= intern ("make-directory-internal");
6519 Qmake_directory
= intern ("make-directory");
6520 Qdelete_directory
= intern ("delete-directory");
6521 Qdelete_file
= intern ("delete-file");
6522 Qrename_file
= intern ("rename-file");
6523 Qadd_name_to_file
= intern ("add-name-to-file");
6524 Qmake_symbolic_link
= intern ("make-symbolic-link");
6525 Qfile_exists_p
= intern ("file-exists-p");
6526 Qfile_executable_p
= intern ("file-executable-p");
6527 Qfile_readable_p
= intern ("file-readable-p");
6528 Qfile_writable_p
= intern ("file-writable-p");
6529 Qfile_symlink_p
= intern ("file-symlink-p");
6530 Qaccess_file
= intern ("access-file");
6531 Qfile_directory_p
= intern ("file-directory-p");
6532 Qfile_regular_p
= intern ("file-regular-p");
6533 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6534 Qfile_modes
= intern ("file-modes");
6535 Qset_file_modes
= intern ("set-file-modes");
6536 Qset_file_times
= intern ("set-file-times");
6537 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6538 Qinsert_file_contents
= intern ("insert-file-contents");
6539 Qwrite_region
= intern ("write-region");
6540 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6541 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6542 Qauto_save_coding
= intern ("auto-save-coding");
6544 staticpro (&Qoperations
);
6545 staticpro (&Qexpand_file_name
);
6546 staticpro (&Qsubstitute_in_file_name
);
6547 staticpro (&Qdirectory_file_name
);
6548 staticpro (&Qfile_name_directory
);
6549 staticpro (&Qfile_name_nondirectory
);
6550 staticpro (&Qunhandled_file_name_directory
);
6551 staticpro (&Qfile_name_as_directory
);
6552 staticpro (&Qcopy_file
);
6553 staticpro (&Qmake_directory_internal
);
6554 staticpro (&Qmake_directory
);
6555 staticpro (&Qdelete_directory
);
6556 staticpro (&Qdelete_file
);
6557 staticpro (&Qrename_file
);
6558 staticpro (&Qadd_name_to_file
);
6559 staticpro (&Qmake_symbolic_link
);
6560 staticpro (&Qfile_exists_p
);
6561 staticpro (&Qfile_executable_p
);
6562 staticpro (&Qfile_readable_p
);
6563 staticpro (&Qfile_writable_p
);
6564 staticpro (&Qaccess_file
);
6565 staticpro (&Qfile_symlink_p
);
6566 staticpro (&Qfile_directory_p
);
6567 staticpro (&Qfile_regular_p
);
6568 staticpro (&Qfile_accessible_directory_p
);
6569 staticpro (&Qfile_modes
);
6570 staticpro (&Qset_file_modes
);
6571 staticpro (&Qset_file_times
);
6572 staticpro (&Qfile_newer_than_file_p
);
6573 staticpro (&Qinsert_file_contents
);
6574 staticpro (&Qwrite_region
);
6575 staticpro (&Qverify_visited_file_modtime
);
6576 staticpro (&Qset_visited_file_modtime
);
6577 staticpro (&Qauto_save_coding
);
6579 Qfile_name_history
= intern ("file-name-history");
6580 Fset (Qfile_name_history
, Qnil
);
6581 staticpro (&Qfile_name_history
);
6583 Qfile_error
= intern ("file-error");
6584 staticpro (&Qfile_error
);
6585 Qfile_already_exists
= intern ("file-already-exists");
6586 staticpro (&Qfile_already_exists
);
6587 Qfile_date_error
= intern ("file-date-error");
6588 staticpro (&Qfile_date_error
);
6589 Qexcl
= intern ("excl");
6593 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6594 staticpro (&Qfind_buffer_file_type
);
6597 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6598 doc
: /* *Coding system for encoding file names.
6599 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6600 Vfile_name_coding_system
= Qnil
;
6602 DEFVAR_LISP ("default-file-name-coding-system",
6603 &Vdefault_file_name_coding_system
,
6604 doc
: /* Default coding system for encoding file names.
6605 This variable is used only when `file-name-coding-system' is nil.
6607 This variable is set/changed by the command `set-language-environment'.
6608 User should not set this variable manually,
6609 instead use `file-name-coding-system' to get a constant encoding
6610 of file names regardless of the current language environment. */);
6611 Vdefault_file_name_coding_system
= Qnil
;
6613 Qformat_decode
= intern ("format-decode");
6614 staticpro (&Qformat_decode
);
6615 Qformat_annotate_function
= intern ("format-annotate-function");
6616 staticpro (&Qformat_annotate_function
);
6617 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6618 staticpro (&Qafter_insert_file_set_coding
);
6620 Qcar_less_than_car
= intern ("car-less-than-car");
6621 staticpro (&Qcar_less_than_car
);
6623 Fput (Qfile_error
, Qerror_conditions
,
6624 list2 (Qfile_error
, Qerror
));
6625 Fput (Qfile_error
, Qerror_message
,
6626 build_string ("File error"));
6628 Fput (Qfile_already_exists
, Qerror_conditions
,
6629 list3 (Qfile_already_exists
, Qfile_error
, Qerror
));
6630 Fput (Qfile_already_exists
, Qerror_message
,
6631 build_string ("File already exists"));
6633 Fput (Qfile_date_error
, Qerror_conditions
,
6634 list3 (Qfile_date_error
, Qfile_error
, Qerror
));
6635 Fput (Qfile_date_error
, Qerror_message
,
6636 build_string ("Cannot set file date"));
6638 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6639 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6640 Vread_file_name_function
= Qnil
;
6642 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6643 doc
: /* Current predicate used by `read-file-name-internal'. */);
6644 Vread_file_name_predicate
= Qnil
;
6646 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case
,
6647 doc
: /* *Non-nil means when reading a file name completion ignores case. */);
6648 #if defined VMS || defined DOS_NT || defined MAC_OS
6649 read_file_name_completion_ignore_case
= 1;
6651 read_file_name_completion_ignore_case
= 0;
6654 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6655 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6657 When the initial minibuffer contents show a name of a file or a directory,
6658 typing RETURN without editing the initial contents is equivalent to typing
6659 the default file name.
6661 If this variable is non-nil, the minibuffer contents are always
6662 initially non-empty, and typing RETURN without editing will fetch the
6663 default name, if one is provided. Note however that this default name
6664 is not necessarily the same as initial contents inserted in the minibuffer,
6665 if the initial contents is just the default directory.
6667 If this variable is nil, the minibuffer often starts out empty. In
6668 that case you may have to explicitly fetch the next history element to
6669 request the default name; typing RETURN without editing will leave
6670 the minibuffer empty.
6672 For some commands, exiting with an empty minibuffer has a special meaning,
6673 such as making the current buffer visit no file in the case of
6674 `set-visited-file-name'. */);
6675 insert_default_directory
= 1;
6677 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6678 doc
: /* *Non-nil means write new files with record format `stmlf'.
6679 nil means use format `var'. This variable is meaningful only on VMS. */);
6680 vms_stmlf_recfm
= 0;
6682 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6683 doc
: /* Directory separator character for built-in functions that return file names.
6684 The value is always ?/. Don't use this variable, just use `/'. */);
6686 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6687 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6688 If a file name matches REGEXP, then all I/O on that file is done by calling
6691 The first argument given to HANDLER is the name of the I/O primitive
6692 to be handled; the remaining arguments are the arguments that were
6693 passed to that primitive. For example, if you do
6694 (file-exists-p FILENAME)
6695 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6696 (funcall HANDLER 'file-exists-p FILENAME)
6697 The function `find-file-name-handler' checks this list for a handler
6698 for its argument. */);
6699 Vfile_name_handler_alist
= Qnil
;
6701 DEFVAR_LISP ("set-auto-coding-function",
6702 &Vset_auto_coding_function
,
6703 doc
: /* If non-nil, a function to call to decide a coding system of file.
6704 Two arguments are passed to this function: the file name
6705 and the length of a file contents following the point.
6706 This function should return a coding system to decode the file contents.
6707 It should check the file name against `auto-coding-alist'.
6708 If no coding system is decided, it should check a coding system
6709 specified in the heading lines with the format:
6710 -*- ... coding: CODING-SYSTEM; ... -*-
6711 or local variable spec of the tailing lines with `coding:' tag. */);
6712 Vset_auto_coding_function
= Qnil
;
6714 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6715 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6716 Each is passed one argument, the number of characters inserted.
6717 It should return the new character count, and leave point the same.
6718 If `insert-file-contents' is intercepted by a handler from
6719 `file-name-handler-alist', that handler is responsible for calling the
6720 functions in `after-insert-file-functions' if appropriate. */);
6721 Vafter_insert_file_functions
= Qnil
;
6723 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6724 doc
: /* A list of functions to be called at the start of `write-region'.
6725 Each is passed two arguments, START and END as for `write-region'.
6726 These are usually two numbers but not always; see the documentation
6727 for `write-region'. The function should return a list of pairs
6728 of the form (POSITION . STRING), consisting of strings to be effectively
6729 inserted at the specified positions of the file being written (1 means to
6730 insert before the first byte written). The POSITIONs must be sorted into
6731 increasing order. If there are several functions in the list, the several
6732 lists are merged destructively. Alternatively, the function can return
6733 with a different buffer current; in that case it should pay attention
6734 to the annotations returned by previous functions and listed in
6735 `write-region-annotations-so-far'.*/);
6736 Vwrite_region_annotate_functions
= Qnil
;
6737 staticpro (&Qwrite_region_annotate_functions
);
6738 Qwrite_region_annotate_functions
6739 = intern ("write-region-annotate-functions");
6741 DEFVAR_LISP ("write-region-annotations-so-far",
6742 &Vwrite_region_annotations_so_far
,
6743 doc
: /* When an annotation function is called, this holds the previous annotations.
6744 These are the annotations made by other annotation functions
6745 that were already called. See also `write-region-annotate-functions'. */);
6746 Vwrite_region_annotations_so_far
= Qnil
;
6748 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6749 doc
: /* A list of file name handlers that temporarily should not be used.
6750 This applies only to the operation `inhibit-file-name-operation'. */);
6751 Vinhibit_file_name_handlers
= Qnil
;
6753 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6754 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6755 Vinhibit_file_name_operation
= Qnil
;
6757 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6758 doc
: /* File name in which we write a list of all auto save file names.
6759 This variable is initialized automatically from `auto-save-list-file-prefix'
6760 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6761 a non-nil value. */);
6762 Vauto_save_list_file_name
= Qnil
;
6765 DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync
,
6766 doc
: /* *Non-nil means don't call fsync in `write-region'.
6767 This variable affects calls to `write-region' as well as save commands.
6768 A non-nil value may result in data loss! */);
6769 write_region_inhibit_fsync
= 0;
6772 defsubr (&Sfind_file_name_handler
);
6773 defsubr (&Sfile_name_directory
);
6774 defsubr (&Sfile_name_nondirectory
);
6775 defsubr (&Sunhandled_file_name_directory
);
6776 defsubr (&Sfile_name_as_directory
);
6777 defsubr (&Sdirectory_file_name
);
6778 defsubr (&Smake_temp_name
);
6779 defsubr (&Sexpand_file_name
);
6780 defsubr (&Ssubstitute_in_file_name
);
6781 defsubr (&Scopy_file
);
6782 defsubr (&Smake_directory_internal
);
6783 defsubr (&Sdelete_directory
);
6784 defsubr (&Sdelete_file
);
6785 defsubr (&Srename_file
);
6786 defsubr (&Sadd_name_to_file
);
6787 defsubr (&Smake_symbolic_link
);
6789 defsubr (&Sdefine_logical_name
);
6792 defsubr (&Ssysnetunam
);
6793 #endif /* HPUX_NET */
6794 defsubr (&Sfile_name_absolute_p
);
6795 defsubr (&Sfile_exists_p
);
6796 defsubr (&Sfile_executable_p
);
6797 defsubr (&Sfile_readable_p
);
6798 defsubr (&Sfile_writable_p
);
6799 defsubr (&Saccess_file
);
6800 defsubr (&Sfile_symlink_p
);
6801 defsubr (&Sfile_directory_p
);
6802 defsubr (&Sfile_accessible_directory_p
);
6803 defsubr (&Sfile_regular_p
);
6804 defsubr (&Sfile_modes
);
6805 defsubr (&Sset_file_modes
);
6806 defsubr (&Sset_file_times
);
6807 defsubr (&Sset_default_file_modes
);
6808 defsubr (&Sdefault_file_modes
);
6809 defsubr (&Sfile_newer_than_file_p
);
6810 defsubr (&Sinsert_file_contents
);
6811 defsubr (&Swrite_region
);
6812 defsubr (&Scar_less_than_car
);
6813 defsubr (&Sverify_visited_file_modtime
);
6814 defsubr (&Sclear_visited_file_modtime
);
6815 defsubr (&Svisited_file_modtime
);
6816 defsubr (&Sset_visited_file_modtime
);
6817 defsubr (&Sdo_auto_save
);
6818 defsubr (&Sset_buffer_auto_saved
);
6819 defsubr (&Sclear_buffer_auto_save_failure
);
6820 defsubr (&Srecent_auto_save_p
);
6822 defsubr (&Sread_file_name_internal
);
6823 defsubr (&Sread_file_name
);
6824 defsubr (&Snext_read_file_uses_dialog_p
);
6827 defsubr (&Sunix_sync
);
6831 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6832 (do not change this comment) */