1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996,
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 2, or (at your option)
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
30 #include <sys/types.h>
37 #if !defined (S_ISLNK) && defined (S_IFLNK)
38 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
41 #if !defined (S_ISFIFO) && defined (S_IFIFO)
42 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
45 #if !defined (S_ISREG) && defined (S_IFREG)
46 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
75 #include "intervals.h"
86 #endif /* not WINDOWSNT */
90 #include <sys/param.h>
98 #define CORRECT_DIR_SEPS(s) \
99 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
100 else unixtodos_filename (s); \
102 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
103 redirector allows the six letters between 'Z' and 'a' as well. */
105 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
108 #define IS_DRIVE(x) isalpha (x)
110 /* Need to lower-case the drive letter, or else expanded
111 filenames will sometimes compare inequal, because
112 `expand-file-name' doesn't always down-case the drive letter. */
113 #define DRIVE_LETTER(x) (tolower (x))
134 #include "commands.h"
135 extern int use_dialog_box
;
136 extern int use_file_dialog
;
150 #ifndef FILE_SYSTEM_CASE
151 #define FILE_SYSTEM_CASE(filename) (filename)
154 /* Nonzero during writing of auto-save files */
157 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
158 a new file with the same mode as the original */
159 int auto_save_mode_bits
;
161 /* The symbol bound to coding-system-for-read when
162 insert-file-contents is called for recovering a file. This is not
163 an actual coding system name, but just an indicator to tell
164 insert-file-contents to use `emacs-mule' with a special flag for
165 auto saving and recovering a file. */
166 Lisp_Object Qauto_save_coding
;
168 /* Coding system for file names, or nil if none. */
169 Lisp_Object Vfile_name_coding_system
;
171 /* Coding system for file names used only when
172 Vfile_name_coding_system is nil. */
173 Lisp_Object Vdefault_file_name_coding_system
;
175 /* Alist of elements (REGEXP . HANDLER) for file names
176 whose I/O is done with a special handler. */
177 Lisp_Object Vfile_name_handler_alist
;
179 /* Property name of a file name handler,
180 which gives a list of operations it handles.. */
181 Lisp_Object Qoperations
;
183 /* Lisp functions for translating file formats */
184 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
186 /* Function to be called to decide a coding system of a reading file. */
187 Lisp_Object Vset_auto_coding_function
;
189 /* Functions to be called to process text properties in inserted file. */
190 Lisp_Object Vafter_insert_file_functions
;
192 /* Lisp function for setting buffer-file-coding-system and the
193 multibyteness of the current buffer after inserting a file. */
194 Lisp_Object Qafter_insert_file_set_coding
;
196 /* Functions to be called to create text property annotations for file. */
197 Lisp_Object Vwrite_region_annotate_functions
;
198 Lisp_Object Qwrite_region_annotate_functions
;
200 /* During build_annotations, each time an annotation function is called,
201 this holds the annotations made by the previous functions. */
202 Lisp_Object Vwrite_region_annotations_so_far
;
204 /* File name in which we write a list of all our auto save files. */
205 Lisp_Object Vauto_save_list_file_name
;
207 /* Function to call to read a file name. */
208 Lisp_Object Vread_file_name_function
;
210 /* Current predicate used by read_file_name_internal. */
211 Lisp_Object Vread_file_name_predicate
;
213 /* Nonzero means completion ignores case when reading file name. */
214 int read_file_name_completion_ignore_case
;
216 /* Nonzero means, when reading a filename in the minibuffer,
217 start out by inserting the default directory into the minibuffer. */
218 int insert_default_directory
;
220 /* On VMS, nonzero means write new files with record format stmlf.
221 Zero means use var format. */
224 /* On NT, specifies the directory separator character, used (eg.) when
225 expanding file names. This can be bound to / or \. */
226 Lisp_Object Vdirectory_sep_char
;
229 /* Nonzero means skip the call to fsync in Fwrite-region. */
230 int write_region_inhibit_fsync
;
233 extern Lisp_Object Vuser_login_name
;
236 extern Lisp_Object Vw32_get_true_file_attributes
;
239 extern int minibuf_level
;
241 extern int minibuffer_auto_raise
;
243 extern int history_delete_duplicates
;
245 /* These variables describe handlers that have "already" had a chance
246 to handle the current operation.
248 Vinhibit_file_name_handlers is a list of file name handlers.
249 Vinhibit_file_name_operation is the operation being handled.
250 If we try to handle that operation, we ignore those handlers. */
252 static Lisp_Object Vinhibit_file_name_handlers
;
253 static Lisp_Object Vinhibit_file_name_operation
;
255 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
257 Lisp_Object Qfile_name_history
;
259 Lisp_Object Qcar_less_than_car
;
261 static int a_write
P_ ((int, Lisp_Object
, int, int,
262 Lisp_Object
*, struct coding_system
*));
263 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
267 report_file_error (string
, data
)
271 Lisp_Object errstring
;
274 synchronize_system_messages_locale ();
275 errstring
= code_convert_string_norecord (build_string (strerror (errorno
)),
276 Vlocale_coding_system
, 0);
282 Fsignal (Qfile_already_exists
, Fcons (errstring
, data
));
285 /* System error messages are capitalized. Downcase the initial
286 unless it is followed by a slash. */
287 if (SREF (errstring
, 1) != '/')
288 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
290 Fsignal (Qfile_error
,
291 Fcons (build_string (string
), Fcons (errstring
, data
)));
296 close_file_unwind (fd
)
299 emacs_close (XFASTINT (fd
));
303 /* Restore point, having saved it as a marker. */
306 restore_point_unwind (location
)
307 Lisp_Object location
;
309 Fgoto_char (location
);
310 Fset_marker (location
, Qnil
, Qnil
);
314 Lisp_Object Qexpand_file_name
;
315 Lisp_Object Qsubstitute_in_file_name
;
316 Lisp_Object Qdirectory_file_name
;
317 Lisp_Object Qfile_name_directory
;
318 Lisp_Object Qfile_name_nondirectory
;
319 Lisp_Object Qunhandled_file_name_directory
;
320 Lisp_Object Qfile_name_as_directory
;
321 Lisp_Object Qcopy_file
;
322 Lisp_Object Qmake_directory_internal
;
323 Lisp_Object Qmake_directory
;
324 Lisp_Object Qdelete_directory
;
325 Lisp_Object Qdelete_file
;
326 Lisp_Object Qrename_file
;
327 Lisp_Object Qadd_name_to_file
;
328 Lisp_Object Qmake_symbolic_link
;
329 Lisp_Object Qfile_exists_p
;
330 Lisp_Object Qfile_executable_p
;
331 Lisp_Object Qfile_readable_p
;
332 Lisp_Object Qfile_writable_p
;
333 Lisp_Object Qfile_symlink_p
;
334 Lisp_Object Qaccess_file
;
335 Lisp_Object Qfile_directory_p
;
336 Lisp_Object Qfile_regular_p
;
337 Lisp_Object Qfile_accessible_directory_p
;
338 Lisp_Object Qfile_modes
;
339 Lisp_Object Qset_file_modes
;
340 Lisp_Object Qset_file_times
;
341 Lisp_Object Qfile_newer_than_file_p
;
342 Lisp_Object Qinsert_file_contents
;
343 Lisp_Object Qwrite_region
;
344 Lisp_Object Qverify_visited_file_modtime
;
345 Lisp_Object Qset_visited_file_modtime
;
347 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
348 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
349 Otherwise, return nil.
350 A file name is handled if one of the regular expressions in
351 `file-name-handler-alist' matches it.
353 If OPERATION equals `inhibit-file-name-operation', then we ignore
354 any handlers that are members of `inhibit-file-name-handlers',
355 but we still do run any other handlers. This lets handlers
356 use the standard functions without calling themselves recursively. */)
357 (filename
, operation
)
358 Lisp_Object filename
, operation
;
360 /* This function must not munge the match data. */
361 Lisp_Object chain
, inhibited_handlers
, result
;
365 CHECK_STRING (filename
);
367 if (EQ (operation
, Vinhibit_file_name_operation
))
368 inhibited_handlers
= Vinhibit_file_name_handlers
;
370 inhibited_handlers
= Qnil
;
372 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
373 chain
= XCDR (chain
))
379 Lisp_Object string
= XCAR (elt
);
381 Lisp_Object handler
= XCDR (elt
);
382 Lisp_Object operations
= Qnil
;
384 if (SYMBOLP (handler
))
385 operations
= Fget (handler
, Qoperations
);
388 && (match_pos
= fast_string_match (string
, filename
)) > pos
389 && (NILP (operations
) || ! NILP (Fmemq (operation
, operations
))))
393 handler
= XCDR (elt
);
394 tem
= Fmemq (handler
, inhibited_handlers
);
408 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
410 doc
: /* Return the directory component in file name FILENAME.
411 Return nil if FILENAME does not include a directory.
412 Otherwise return a directory spec.
413 Given a Unix syntax file name, returns a string ending in slash;
414 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
416 Lisp_Object filename
;
419 register const unsigned char *beg
;
421 register unsigned char *beg
;
423 register const unsigned char *p
;
426 CHECK_STRING (filename
);
428 /* If the file name has special constructs in it,
429 call the corresponding file handler. */
430 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
432 return call2 (handler
, Qfile_name_directory
, filename
);
434 filename
= FILE_SYSTEM_CASE (filename
);
435 beg
= SDATA (filename
);
437 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
439 p
= beg
+ SBYTES (filename
);
441 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
443 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
446 /* only recognise drive specifier at the beginning */
448 /* handle the "/:d:foo" and "/:foo" cases correctly */
449 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
450 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
457 /* Expansion of "c:" to drive and default directory. */
460 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
461 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
462 unsigned char *r
= res
;
464 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
466 strncpy (res
, beg
, 2);
471 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
473 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
476 p
= beg
+ strlen (beg
);
479 CORRECT_DIR_SEPS (beg
);
482 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
485 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
486 Sfile_name_nondirectory
, 1, 1, 0,
487 doc
: /* Return file name FILENAME sans its directory.
488 For example, in a Unix-syntax file name,
489 this is everything after the last slash,
490 or the entire name if it contains no slash. */)
492 Lisp_Object filename
;
494 register const unsigned char *beg
, *p
, *end
;
497 CHECK_STRING (filename
);
499 /* If the file name has special constructs in it,
500 call the corresponding file handler. */
501 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
503 return call2 (handler
, Qfile_name_nondirectory
, filename
);
505 beg
= SDATA (filename
);
506 end
= p
= beg
+ SBYTES (filename
);
508 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
510 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
513 /* only recognise drive specifier at beginning */
515 /* handle the "/:d:foo" case correctly */
516 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
521 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
524 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
525 Sunhandled_file_name_directory
, 1, 1, 0,
526 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
527 A `directly usable' directory name is one that may be used without the
528 intervention of any file handler.
529 If FILENAME is a directly usable file itself, return
530 \(file-name-directory FILENAME).
531 The `call-process' and `start-process' functions use this function to
532 get a current directory to run processes in. */)
534 Lisp_Object filename
;
538 /* If the file name has special constructs in it,
539 call the corresponding file handler. */
540 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
542 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
544 return Ffile_name_directory (filename
);
549 file_name_as_directory (out
, in
)
552 int size
= strlen (in
) - 1;
565 /* Is it already a directory string? */
566 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
568 /* Is it a VMS directory file name? If so, hack VMS syntax. */
569 else if (! index (in
, '/')
570 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
571 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
572 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
573 || ! strncmp (&in
[size
- 5], ".dir", 4))
574 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
575 && in
[size
] == '1')))
577 register char *p
, *dot
;
581 dir:x.dir --> dir:[x]
582 dir:[x]y.dir --> dir:[x.y] */
584 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
587 strncpy (out
, in
, p
- in
);
606 dot
= index (p
, '.');
609 /* blindly remove any extension */
610 size
= strlen (out
) + (dot
- p
);
611 strncat (out
, p
, dot
- p
);
622 /* For Unix syntax, Append a slash if necessary */
623 if (!IS_DIRECTORY_SEP (out
[size
]))
625 /* Cannot use DIRECTORY_SEP, which could have any value */
627 out
[size
+ 2] = '\0';
630 CORRECT_DIR_SEPS (out
);
636 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
637 Sfile_name_as_directory
, 1, 1, 0,
638 doc
: /* Return a string representing the file name FILE interpreted as a directory.
639 This operation exists because a directory is also a file, but its name as
640 a directory is different from its name as a file.
641 The result can be used as the value of `default-directory'
642 or passed as second argument to `expand-file-name'.
643 For a Unix-syntax file name, just appends a slash.
644 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
655 /* If the file name has special constructs in it,
656 call the corresponding file handler. */
657 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
659 return call2 (handler
, Qfile_name_as_directory
, file
);
661 buf
= (char *) alloca (SBYTES (file
) + 10);
662 file_name_as_directory (buf
, SDATA (file
));
663 return make_specified_string (buf
, -1, strlen (buf
),
664 STRING_MULTIBYTE (file
));
668 * Convert from directory name to filename.
670 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
671 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
672 * On UNIX, it's simple: just make sure there isn't a terminating /
674 * Value is nonzero if the string output is different from the input.
678 directory_file_name (src
, dst
)
686 struct FAB fab
= cc$rms_fab
;
687 struct NAM nam
= cc$rms_nam
;
688 char esa
[NAM$C_MAXRSS
];
693 if (! index (src
, '/')
694 && (src
[slen
- 1] == ']'
695 || src
[slen
- 1] == ':'
696 || src
[slen
- 1] == '>'))
698 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
700 fab
.fab$b_fns
= slen
;
701 fab
.fab$l_nam
= &nam
;
702 fab
.fab$l_fop
= FAB$M_NAM
;
705 nam
.nam$b_ess
= sizeof esa
;
706 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
708 /* We call SYS$PARSE to handle such things as [--] for us. */
709 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
711 slen
= nam
.nam$b_esl
;
712 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
717 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
719 /* what about when we have logical_name:???? */
720 if (src
[slen
- 1] == ':')
721 { /* Xlate logical name and see what we get */
722 ptr
= strcpy (dst
, src
); /* upper case for getenv */
725 if ('a' <= *ptr
&& *ptr
<= 'z')
729 dst
[slen
- 1] = 0; /* remove colon */
730 if (!(src
= egetenv (dst
)))
732 /* should we jump to the beginning of this procedure?
733 Good points: allows us to use logical names that xlate
735 Bad points: can be a problem if we just translated to a device
737 For now, I'll punt and always expect VMS names, and hope for
740 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
741 { /* no recursion here! */
747 { /* not a directory spec */
752 bracket
= src
[slen
- 1];
754 /* If bracket is ']' or '>', bracket - 2 is the corresponding
756 ptr
= index (src
, bracket
- 2);
758 { /* no opening bracket */
762 if (!(rptr
= rindex (src
, '.')))
765 strncpy (dst
, src
, slen
);
769 dst
[slen
++] = bracket
;
774 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
775 then translate the device and recurse. */
776 if (dst
[slen
- 1] == ':'
777 && dst
[slen
- 2] != ':' /* skip decnet nodes */
778 && strcmp (src
+ slen
, "[000000]") == 0)
780 dst
[slen
- 1] = '\0';
781 if ((ptr
= egetenv (dst
))
782 && (rlen
= strlen (ptr
) - 1) > 0
783 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
784 && ptr
[rlen
- 1] == '.')
786 char * buf
= (char *) alloca (strlen (ptr
) + 1);
790 return directory_file_name (buf
, dst
);
795 strcat (dst
, "[000000]");
799 rlen
= strlen (rptr
) - 1;
800 strncat (dst
, rptr
, rlen
);
801 dst
[slen
+ rlen
] = '\0';
802 strcat (dst
, ".DIR.1");
806 /* Process as Unix format: just remove any final slash.
807 But leave "/" unchanged; do not change it to "". */
810 /* Handle // as root for apollo's. */
811 if ((slen
> 2 && dst
[slen
- 1] == '/')
812 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
816 && IS_DIRECTORY_SEP (dst
[slen
- 1])
818 && !IS_ANY_SEP (dst
[slen
- 2])
824 CORRECT_DIR_SEPS (dst
);
829 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
831 doc
: /* Returns the file name of the directory named DIRECTORY.
832 This is the name of the file that holds the data for the directory DIRECTORY.
833 This operation exists because a directory is also a file, but its name as
834 a directory is different from its name as a file.
835 In Unix-syntax, this function just removes the final slash.
836 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
837 it returns a file name such as \"[X]Y.DIR.1\". */)
839 Lisp_Object directory
;
844 CHECK_STRING (directory
);
846 if (NILP (directory
))
849 /* If the file name has special constructs in it,
850 call the corresponding file handler. */
851 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
853 return call2 (handler
, Qdirectory_file_name
, directory
);
856 /* 20 extra chars is insufficient for VMS, since we might perform a
857 logical name translation. an equivalence string can be up to 255
858 chars long, so grab that much extra space... - sss */
859 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
861 buf
= (char *) alloca (SBYTES (directory
) + 20);
863 directory_file_name (SDATA (directory
), buf
);
864 return make_specified_string (buf
, -1, strlen (buf
),
865 STRING_MULTIBYTE (directory
));
868 static char make_temp_name_tbl
[64] =
870 'A','B','C','D','E','F','G','H',
871 'I','J','K','L','M','N','O','P',
872 'Q','R','S','T','U','V','W','X',
873 'Y','Z','a','b','c','d','e','f',
874 'g','h','i','j','k','l','m','n',
875 'o','p','q','r','s','t','u','v',
876 'w','x','y','z','0','1','2','3',
877 '4','5','6','7','8','9','-','_'
880 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
882 /* Value is a temporary file name starting with PREFIX, a string.
884 The Emacs process number forms part of the result, so there is
885 no danger of generating a name being used by another process.
886 In addition, this function makes an attempt to choose a name
887 which has no existing file. To make this work, PREFIX should be
888 an absolute file name.
890 BASE64_P non-zero means add the pid as 3 characters in base64
891 encoding. In this case, 6 characters will be added to PREFIX to
892 form the file name. Otherwise, if Emacs is running on a system
893 with long file names, add the pid as a decimal number.
895 This function signals an error if no unique file name could be
899 make_temp_name (prefix
, base64_p
)
906 unsigned char *p
, *data
;
910 CHECK_STRING (prefix
);
912 /* VAL is created by adding 6 characters to PREFIX. The first
913 three are the PID of this process, in base 64, and the second
914 three are incremented if the file already exists. This ensures
915 262144 unique file names per PID per PREFIX. */
917 pid
= (int) getpid ();
921 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
922 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
923 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
928 #ifdef HAVE_LONG_FILE_NAMES
929 sprintf (pidbuf
, "%d", pid
);
930 pidlen
= strlen (pidbuf
);
932 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
933 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
934 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
939 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
940 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
941 if (!STRING_MULTIBYTE (prefix
))
942 STRING_SET_UNIBYTE (val
);
944 bcopy(SDATA (prefix
), data
, len
);
947 bcopy (pidbuf
, p
, pidlen
);
950 /* Here we try to minimize useless stat'ing when this function is
951 invoked many times successively with the same PREFIX. We achieve
952 this by initializing count to a random value, and incrementing it
955 We don't want make-temp-name to be called while dumping,
956 because then make_temp_name_count_initialized_p would get set
957 and then make_temp_name_count would not be set when Emacs starts. */
959 if (!make_temp_name_count_initialized_p
)
961 make_temp_name_count
= (unsigned) time (NULL
);
962 make_temp_name_count_initialized_p
= 1;
968 unsigned num
= make_temp_name_count
;
970 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
971 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
972 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
974 /* Poor man's congruential RN generator. Replace with
975 ++make_temp_name_count for debugging. */
976 make_temp_name_count
+= 25229;
977 make_temp_name_count
%= 225307;
979 if (stat (data
, &ignored
) < 0)
981 /* We want to return only if errno is ENOENT. */
985 /* The error here is dubious, but there is little else we
986 can do. The alternatives are to return nil, which is
987 as bad as (and in many cases worse than) throwing the
988 error, or to ignore the error, which will likely result
989 in looping through 225307 stat's, which is not only
990 dog-slow, but also useless since it will fallback to
991 the errow below, anyway. */
992 report_file_error ("Cannot create temporary name for prefix",
993 Fcons (prefix
, Qnil
));
998 error ("Cannot create temporary name for prefix `%s'",
1004 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
1005 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
1006 The Emacs process number forms part of the result,
1007 so there is no danger of generating a name being used by another process.
1009 In addition, this function makes an attempt to choose a name
1010 which has no existing file. To make this work,
1011 PREFIX should be an absolute file name.
1013 There is a race condition between calling `make-temp-name' and creating the
1014 file which opens all kinds of security holes. For that reason, you should
1015 probably use `make-temp-file' instead, except in three circumstances:
1017 * If you are creating the file in the user's home directory.
1018 * If you are creating a directory rather than an ordinary file.
1019 * If you are taking special precautions as `make-temp-file' does. */)
1023 return make_temp_name (prefix
, 0);
1028 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1029 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1030 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1031 \(does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
1032 the current buffer's value of `default-directory' is used.
1033 File name components that are `.' are removed, and
1034 so are file name components followed by `..', along with the `..' itself;
1035 note that these simplifications are done without checking the resulting
1036 file names in the file system.
1037 An initial `~/' expands to your home directory.
1038 An initial `~USER/' expands to USER's home directory.
1039 See also the function `substitute-in-file-name'. */)
1040 (name
, default_directory
)
1041 Lisp_Object name
, default_directory
;
1045 register unsigned char *newdir
, *p
, *o
;
1047 unsigned char *target
;
1050 unsigned char * colon
= 0;
1051 unsigned char * close
= 0;
1052 unsigned char * slash
= 0;
1053 unsigned char * brack
= 0;
1054 int lbrack
= 0, rbrack
= 0;
1059 int collapse_newdir
= 1;
1063 Lisp_Object handler
, result
;
1066 CHECK_STRING (name
);
1068 /* If the file name has special constructs in it,
1069 call the corresponding file handler. */
1070 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1071 if (!NILP (handler
))
1072 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1074 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1075 if (NILP (default_directory
))
1076 default_directory
= current_buffer
->directory
;
1077 if (! STRINGP (default_directory
))
1080 /* "/" is not considered a root directory on DOS_NT, so using "/"
1081 here causes an infinite recursion in, e.g., the following:
1083 (let (default-directory)
1084 (expand-file-name "a"))
1086 To avoid this, we set default_directory to the root of the
1088 extern char *emacs_root_dir (void);
1090 default_directory
= build_string (emacs_root_dir ());
1092 default_directory
= build_string ("/");
1096 if (!NILP (default_directory
))
1098 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1099 if (!NILP (handler
))
1100 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1103 o
= SDATA (default_directory
);
1105 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1106 It would be better to do this down below where we actually use
1107 default_directory. Unfortunately, calling Fexpand_file_name recursively
1108 could invoke GC, and the strings might be relocated. This would
1109 be annoying because we have pointers into strings lying around
1110 that would need adjusting, and people would add new pointers to
1111 the code and forget to adjust them, resulting in intermittent bugs.
1112 Putting this call here avoids all that crud.
1114 The EQ test avoids infinite recursion. */
1115 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1116 /* Save time in some common cases - as long as default_directory
1117 is not relative, it can be canonicalized with name below (if it
1118 is needed at all) without requiring it to be expanded now. */
1120 /* Detect MSDOS file names with drive specifiers. */
1121 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1123 /* Detect Windows file names in UNC format. */
1124 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1126 #else /* not DOS_NT */
1127 /* Detect Unix absolute file names (/... alone is not absolute on
1129 && ! (IS_DIRECTORY_SEP (o
[0]))
1130 #endif /* not DOS_NT */
1133 struct gcpro gcpro1
;
1136 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1140 name
= FILE_SYSTEM_CASE (name
);
1142 multibyte
= STRING_MULTIBYTE (name
);
1145 /* We will force directory separators to be either all \ or /, so make
1146 a local copy to modify, even if there ends up being no change. */
1147 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1149 /* Note if special escape prefix is present, but remove for now. */
1150 if (nm
[0] == '/' && nm
[1] == ':')
1156 /* Find and remove drive specifier if present; this makes nm absolute
1157 even if the rest of the name appears to be relative. Only look for
1158 drive specifier at the beginning. */
1159 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1166 /* If we see "c://somedir", we want to strip the first slash after the
1167 colon when stripping the drive letter. Otherwise, this expands to
1169 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1171 #endif /* WINDOWSNT */
1175 /* Discard any previous drive specifier if nm is now in UNC format. */
1176 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1182 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1183 none are found, we can probably return right away. We will avoid
1184 allocating a new string if name is already fully expanded. */
1186 IS_DIRECTORY_SEP (nm
[0])
1188 && drive
&& !is_escaped
1191 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1198 /* If it turns out that the filename we want to return is just a
1199 suffix of FILENAME, we don't need to go through and edit
1200 things; we just need to construct a new string using data
1201 starting at the middle of FILENAME. If we set lose to a
1202 non-zero value, that means we've discovered that we can't do
1209 /* Since we know the name is absolute, we can assume that each
1210 element starts with a "/". */
1212 /* "." and ".." are hairy. */
1213 if (IS_DIRECTORY_SEP (p
[0])
1215 && (IS_DIRECTORY_SEP (p
[2])
1217 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1220 /* We want to replace multiple `/' in a row with a single
1223 && IS_DIRECTORY_SEP (p
[0])
1224 && IS_DIRECTORY_SEP (p
[1]))
1231 /* if dev:[dir]/, move nm to / */
1232 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1233 nm
= (brack
? brack
+ 1 : colon
+ 1);
1234 lbrack
= rbrack
= 0;
1241 #ifdef NO_HYPHENS_IN_FILENAMES
1242 if (lbrack
== rbrack
)
1244 /* Avoid clobbering negative version numbers. */
1249 #endif /* NO_HYPHENS_IN_FILENAMES */
1250 if (lbrack
> rbrack
&&
1251 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1252 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1254 #ifdef NO_HYPHENS_IN_FILENAMES
1257 #endif /* NO_HYPHENS_IN_FILENAMES */
1258 /* count open brackets, reset close bracket pointer */
1259 if (p
[0] == '[' || p
[0] == '<')
1260 lbrack
++, brack
= 0;
1261 /* count close brackets, set close bracket pointer */
1262 if (p
[0] == ']' || p
[0] == '>')
1263 rbrack
++, brack
= p
;
1264 /* detect ][ or >< */
1265 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1267 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1268 nm
= p
+ 1, lose
= 1;
1269 if (p
[0] == ':' && (colon
|| slash
))
1270 /* if dev1:[dir]dev2:, move nm to dev2: */
1276 /* if /name/dev:, move nm to dev: */
1279 /* if node::dev:, move colon following dev */
1280 else if (colon
&& colon
[-1] == ':')
1282 /* if dev1:dev2:, move nm to dev2: */
1283 else if (colon
&& colon
[-1] != ':')
1288 if (p
[0] == ':' && !colon
)
1294 if (lbrack
== rbrack
)
1297 else if (p
[0] == '.')
1305 if (index (nm
, '/'))
1307 nm
= sys_translate_unix (nm
);
1308 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1312 /* Make sure directories are all separated with / or \ as
1313 desired, but avoid allocation of a new string when not
1315 CORRECT_DIR_SEPS (nm
);
1317 if (IS_DIRECTORY_SEP (nm
[1]))
1319 if (strcmp (nm
, SDATA (name
)) != 0)
1320 name
= make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1324 /* drive must be set, so this is okay */
1325 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1329 name
= make_specified_string (nm
, -1, p
- nm
, multibyte
);
1330 temp
[0] = DRIVE_LETTER (drive
);
1331 name
= concat2 (build_string (temp
), name
);
1334 #else /* not DOS_NT */
1335 if (nm
== SDATA (name
))
1337 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1338 #endif /* not DOS_NT */
1342 /* At this point, nm might or might not be an absolute file name. We
1343 need to expand ~ or ~user if present, otherwise prefix nm with
1344 default_directory if nm is not absolute, and finally collapse /./
1345 and /foo/../ sequences.
1347 We set newdir to be the appropriate prefix if one is needed:
1348 - the relevant user directory if nm starts with ~ or ~user
1349 - the specified drive's working dir (DOS/NT only) if nm does not
1351 - the value of default_directory.
1353 Note that these prefixes are not guaranteed to be absolute (except
1354 for the working dir of a drive). Therefore, to ensure we always
1355 return an absolute name, if the final prefix is not absolute we
1356 append it to the current working directory. */
1360 if (nm
[0] == '~') /* prefix ~ */
1362 if (IS_DIRECTORY_SEP (nm
[1])
1366 || nm
[1] == 0) /* ~ by itself */
1368 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1369 newdir
= (unsigned char *) "";
1372 collapse_newdir
= 0;
1375 nm
++; /* Don't leave the slash in nm. */
1378 else /* ~user/filename */
1380 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1385 o
= (unsigned char *) alloca (p
- nm
+ 1);
1386 bcopy ((char *) nm
, o
, p
- nm
);
1389 pw
= (struct passwd
*) getpwnam (o
+ 1);
1392 newdir
= (unsigned char *) pw
-> pw_dir
;
1394 nm
= p
+ 1; /* skip the terminator */
1398 collapse_newdir
= 0;
1403 /* If we don't find a user of that name, leave the name
1404 unchanged; don't move nm forward to p. */
1409 /* On DOS and Windows, nm is absolute if a drive name was specified;
1410 use the drive's current directory as the prefix if needed. */
1411 if (!newdir
&& drive
)
1413 /* Get default directory if needed to make nm absolute. */
1414 if (!IS_DIRECTORY_SEP (nm
[0]))
1416 newdir
= alloca (MAXPATHLEN
+ 1);
1417 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1422 /* Either nm starts with /, or drive isn't mounted. */
1423 newdir
= alloca (4);
1424 newdir
[0] = DRIVE_LETTER (drive
);
1432 /* Finally, if no prefix has been specified and nm is not absolute,
1433 then it must be expanded relative to default_directory. */
1437 /* /... alone is not absolute on DOS and Windows. */
1438 && !IS_DIRECTORY_SEP (nm
[0])
1441 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1448 newdir
= SDATA (default_directory
);
1449 multibyte
|= STRING_MULTIBYTE (default_directory
);
1451 /* Note if special escape prefix is present, but remove for now. */
1452 if (newdir
[0] == '/' && newdir
[1] == ':')
1463 /* First ensure newdir is an absolute name. */
1465 /* Detect MSDOS file names with drive specifiers. */
1466 ! (IS_DRIVE (newdir
[0])
1467 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1469 /* Detect Windows file names in UNC format. */
1470 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1474 /* Effectively, let newdir be (expand-file-name newdir cwd).
1475 Because of the admonition against calling expand-file-name
1476 when we have pointers into lisp strings, we accomplish this
1477 indirectly by prepending newdir to nm if necessary, and using
1478 cwd (or the wd of newdir's drive) as the new newdir. */
1480 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1485 if (!IS_DIRECTORY_SEP (nm
[0]))
1487 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1488 file_name_as_directory (tmp
, newdir
);
1492 newdir
= alloca (MAXPATHLEN
+ 1);
1495 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1502 /* Strip off drive name from prefix, if present. */
1503 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1509 /* Keep only a prefix from newdir if nm starts with slash
1510 (//server/share for UNC, nothing otherwise). */
1511 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1514 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1516 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1518 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1520 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1532 /* Get rid of any slash at the end of newdir, unless newdir is
1533 just / or // (an incomplete UNC name). */
1534 length
= strlen (newdir
);
1535 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1537 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1541 unsigned char *temp
= (unsigned char *) alloca (length
);
1542 bcopy (newdir
, temp
, length
- 1);
1543 temp
[length
- 1] = 0;
1551 /* Now concatenate the directory and name to new space in the stack frame */
1552 tlen
+= strlen (nm
) + 1;
1554 /* Reserve space for drive specifier and escape prefix, since either
1555 or both may need to be inserted. (The Microsoft x86 compiler
1556 produces incorrect code if the following two lines are combined.) */
1557 target
= (unsigned char *) alloca (tlen
+ 4);
1559 #else /* not DOS_NT */
1560 target
= (unsigned char *) alloca (tlen
);
1561 #endif /* not DOS_NT */
1567 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1570 /* If newdir is effectively "C:/", then the drive letter will have
1571 been stripped and newdir will be "/". Concatenating with an
1572 absolute directory in nm produces "//", which will then be
1573 incorrectly treated as a network share. Ignore newdir in
1574 this case (keeping the drive letter). */
1575 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1576 && newdir
[1] == '\0'))
1578 strcpy (target
, newdir
);
1582 file_name_as_directory (target
, newdir
);
1585 strcat (target
, nm
);
1587 if (index (target
, '/'))
1588 strcpy (target
, sys_translate_unix (target
));
1591 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1593 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1602 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1608 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1609 /* brackets are offset from each other by 2 */
1612 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1613 /* convert [foo][bar] to [bar] */
1614 while (o
[-1] != '[' && o
[-1] != '<')
1616 else if (*p
== '-' && *o
!= '.')
1619 else if (p
[0] == '-' && o
[-1] == '.' &&
1620 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1621 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1625 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1626 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1628 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1630 /* else [foo.-] ==> [-] */
1634 #ifdef NO_HYPHENS_IN_FILENAMES
1636 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1637 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1639 #endif /* NO_HYPHENS_IN_FILENAMES */
1643 if (!IS_DIRECTORY_SEP (*p
))
1647 else if (IS_DIRECTORY_SEP (p
[0])
1649 && (IS_DIRECTORY_SEP (p
[2])
1652 /* If "/." is the entire filename, keep the "/". Otherwise,
1653 just delete the whole "/.". */
1654 if (o
== target
&& p
[2] == '\0')
1658 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1659 /* `/../' is the "superroot" on certain file systems.
1660 Turned off on DOS_NT systems because they have no
1661 "superroot" and because this causes us to produce
1662 file names like "d:/../foo" which fail file-related
1663 functions of the underlying OS. (To reproduce, try a
1664 long series of "../../" in default_directory, longer
1665 than the number of levels from the root.) */
1669 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1671 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1673 /* Keep initial / only if this is the whole name. */
1674 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1679 && IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1]))
1681 /* Collapse multiple `/' in a row. */
1683 while (IS_DIRECTORY_SEP (*p
))
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 */
1826 if (lbrack
> rbrack
&&
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. */
1926 pw
= (struct passwd
*) getpwnam (o
+ 1);
1928 error ("\"%s\" isn't a registered user", o
+ 1);
1930 newdir
= (unsigned char *) pw
->pw_dir
;
1932 /* Discard the user name from NM. */
1939 #endif /* not VMS */
1943 defalt
= current_buffer
->directory
;
1944 CHECK_STRING (defalt
);
1945 newdir
= SDATA (defalt
);
1948 /* Now concatenate the directory and name to new space in the stack frame */
1950 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1951 target
= (unsigned char *) alloca (tlen
);
1957 if (nm
[0] == 0 || nm
[0] == '/')
1958 strcpy (target
, newdir
);
1961 file_name_as_directory (target
, newdir
);
1964 strcat (target
, nm
);
1966 if (index (target
, '/'))
1967 strcpy (target
, sys_translate_unix (target
));
1970 /* Now canonicalize by removing /. and /foo/.. if they appear */
1978 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1984 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1985 /* brackets are offset from each other by 2 */
1988 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1989 /* convert [foo][bar] to [bar] */
1990 while (o
[-1] != '[' && o
[-1] != '<')
1992 else if (*p
== '-' && *o
!= '.')
1995 else if (p
[0] == '-' && o
[-1] == '.' &&
1996 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1997 /* flush .foo.- ; leave - if stopped by '[' or '<' */
2001 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
2002 if (p
[1] == '.') /* foo.-.bar ==> bar. */
2004 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
2006 /* else [foo.-] ==> [-] */
2012 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
2013 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2023 else if (!strncmp (p
, "//", 2)
2025 /* // at start of filename is meaningful in Apollo system. */
2033 else if (p
[0] == '/' && p
[1] == '.' &&
2034 (p
[2] == '/' || p
[2] == 0))
2036 else if (!strncmp (p
, "/..", 3)
2037 /* `/../' is the "superroot" on certain file systems. */
2039 && (p
[3] == '/' || p
[3] == 0))
2041 while (o
!= target
&& *--o
!= '/')
2044 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2048 if (o
== target
&& *o
== '/')
2056 #endif /* not VMS */
2059 return make_string (target
, o
- target
);
2063 /* If /~ or // appears, discard everything through first slash. */
2065 file_name_absolute_p (filename
)
2066 const unsigned char *filename
;
2069 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
2071 /* ??? This criterion is probably wrong for '<'. */
2072 || index (filename
, ':') || index (filename
, '<')
2073 || (*filename
== '[' && (filename
[1] != '-'
2074 || (filename
[2] != '.' && filename
[2] != ']'))
2075 && filename
[1] != '.')
2078 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
2079 && IS_DIRECTORY_SEP (filename
[2]))
2084 static unsigned char *
2085 search_embedded_absfilename (nm
, endp
)
2086 unsigned char *nm
, *endp
;
2088 unsigned char *p
, *s
;
2090 for (p
= nm
+ 1; p
< endp
; p
++)
2094 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2096 || IS_DIRECTORY_SEP (p
[-1]))
2097 && file_name_absolute_p (p
)
2098 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2099 /* // at start of file name is meaningful in Apollo,
2100 WindowsNT and Cygwin systems. */
2101 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
2102 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2105 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2110 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2112 unsigned char *o
= alloca (s
- p
+ 1);
2114 bcopy (p
, o
, s
- p
);
2117 /* If we have ~user and `user' exists, discard
2118 everything up to ~. But if `user' does not exist, leave
2119 ~user alone, it might be a literal file name. */
2120 if ((pw
= getpwnam (o
+ 1)))
2132 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2133 Ssubstitute_in_file_name
, 1, 1, 0,
2134 doc
: /* Substitute environment variables referred to in FILENAME.
2135 `$FOO' where FOO is an environment variable name means to substitute
2136 the value of that variable. The variable name should be terminated
2137 with a character not a letter, digit or underscore; otherwise, enclose
2138 the entire variable name in braces.
2139 If `/~' appears, all of FILENAME through that `/' is discarded.
2141 On VMS, `$' substitution is not done; this function does little and only
2142 duplicates what `expand-file-name' does. */)
2144 Lisp_Object filename
;
2148 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2149 unsigned char *target
= NULL
;
2151 int substituted
= 0;
2153 Lisp_Object handler
;
2155 CHECK_STRING (filename
);
2157 /* If the file name has special constructs in it,
2158 call the corresponding file handler. */
2159 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2160 if (!NILP (handler
))
2161 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2163 nm
= SDATA (filename
);
2165 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2166 CORRECT_DIR_SEPS (nm
);
2167 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2169 endp
= nm
+ SBYTES (filename
);
2171 /* If /~ or // appears, discard everything through first slash. */
2172 p
= search_embedded_absfilename (nm
, endp
);
2174 /* Start over with the new string, so we check the file-name-handler
2175 again. Important with filenames like "/home/foo//:/hello///there"
2176 which whould substitute to "/:/hello///there" rather than "/there". */
2177 return Fsubstitute_in_file_name
2178 (make_specified_string (p
, -1, endp
- p
,
2179 STRING_MULTIBYTE (filename
)));
2185 /* See if any variables are substituted into the string
2186 and find the total length of their values in `total' */
2188 for (p
= nm
; p
!= endp
;)
2198 /* "$$" means a single "$" */
2207 while (p
!= endp
&& *p
!= '}') p
++;
2208 if (*p
!= '}') goto missingclose
;
2214 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2218 /* Copy out the variable name */
2219 target
= (unsigned char *) alloca (s
- o
+ 1);
2220 strncpy (target
, o
, s
- o
);
2223 strupr (target
); /* $home == $HOME etc. */
2226 /* Get variable value */
2227 o
= (unsigned char *) egetenv (target
);
2230 total
+= strlen (o
);
2240 /* If substitution required, recopy the string and do it */
2241 /* Make space in stack frame for the new copy */
2242 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2245 /* Copy the rest of the name through, replacing $ constructs with values */
2262 while (p
!= endp
&& *p
!= '}') p
++;
2263 if (*p
!= '}') goto missingclose
;
2269 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2273 /* Copy out the variable name */
2274 target
= (unsigned char *) alloca (s
- o
+ 1);
2275 strncpy (target
, o
, s
- o
);
2278 strupr (target
); /* $home == $HOME etc. */
2281 /* Get variable value */
2282 o
= (unsigned char *) egetenv (target
);
2286 strcpy (x
, target
); x
+= strlen (target
);
2288 else if (STRING_MULTIBYTE (filename
))
2290 /* If the original string is multibyte,
2291 convert what we substitute into multibyte. */
2294 int c
= unibyte_char_to_multibyte (*o
++);
2295 x
+= CHAR_STRING (c
, x
);
2307 /* If /~ or // appears, discard everything through first slash. */
2308 while ((p
= search_embedded_absfilename (xnm
, x
)))
2309 /* This time we do not start over because we've already expanded envvars
2310 and replaced $$ with $. Maybe we should start over as well, but we'd
2311 need to quote some $ to $$ first. */
2314 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2317 error ("Bad format environment-variable substitution");
2319 error ("Missing \"}\" in environment-variable substitution");
2321 error ("Substituting nonexistent environment variable \"%s\"", target
);
2324 #endif /* not VMS */
2328 /* A slightly faster and more convenient way to get
2329 (directory-file-name (expand-file-name FOO)). */
2332 expand_and_dir_to_file (filename
, defdir
)
2333 Lisp_Object filename
, defdir
;
2335 register Lisp_Object absname
;
2337 absname
= Fexpand_file_name (filename
, defdir
);
2340 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2341 if (c
== ':' || c
== ']' || c
== '>')
2342 absname
= Fdirectory_file_name (absname
);
2345 /* Remove final slash, if any (unless this is the root dir).
2346 stat behaves differently depending! */
2347 if (SCHARS (absname
) > 1
2348 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2349 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2350 /* We cannot take shortcuts; they might be wrong for magic file names. */
2351 absname
= Fdirectory_file_name (absname
);
2356 /* Signal an error if the file ABSNAME already exists.
2357 If INTERACTIVE is nonzero, ask the user whether to proceed,
2358 and bypass the error if the user says to go ahead.
2359 QUERYSTRING is a name for the action that is being considered
2362 *STATPTR is used to store the stat information if the file exists.
2363 If the file does not exist, STATPTR->st_mode is set to 0.
2364 If STATPTR is null, we don't store into it.
2366 If QUICK is nonzero, we ask for y or n, not yes or no. */
2369 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2370 Lisp_Object absname
;
2371 unsigned char *querystring
;
2373 struct stat
*statptr
;
2376 register Lisp_Object tem
, encoded_filename
;
2377 struct stat statbuf
;
2378 struct gcpro gcpro1
;
2380 encoded_filename
= ENCODE_FILE (absname
);
2382 /* stat is a good way to tell whether the file exists,
2383 regardless of what access permissions it has. */
2384 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
2387 Fsignal (Qfile_already_exists
,
2388 Fcons (build_string ("File already exists"),
2389 Fcons (absname
, Qnil
)));
2391 tem
= format2 ("File %s already exists; %s anyway? ",
2392 absname
, build_string (querystring
));
2394 tem
= Fy_or_n_p (tem
);
2396 tem
= do_yes_or_no_p (tem
);
2399 Fsignal (Qfile_already_exists
,
2400 Fcons (build_string ("File already exists"),
2401 Fcons (absname
, Qnil
)));
2408 statptr
->st_mode
= 0;
2413 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 6,
2414 "fCopy file: \nGCopy %s to file: \np\nP",
2415 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2416 If NEWNAME names a directory, copy FILE there.
2417 Signals a `file-already-exists' error if file NEWNAME already exists,
2418 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
2419 A number as third arg means request confirmation if NEWNAME already exists.
2420 This is what happens in interactive use with M-x.
2421 Always sets the file modes of the output file to match the input file.
2423 Fourth arg KEEP-TIME non-nil means give the output file the same
2424 last-modified time as the old one. (This works on only some systems.)
2426 A prefix arg makes KEEP-TIME non-nil.
2428 The optional fifth arg MUSTBENEW, if non-nil, insists on a check
2429 for an existing file with the same name. If MUSTBENEW is `excl',
2430 that means to get an error if the file already exists; never overwrite.
2431 If MUSTBENEW is neither nil nor `excl', that means ask for
2432 confirmation before overwriting, but do go ahead and overwrite the file
2433 if the user confirms.
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
, mustbenew
, preserve_uid_gid
)
2438 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
, mustbenew
;
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 (mustbenew
) && !EQ (mustbenew
, Qexcl
))
2456 barf_or_query_if_file_exists (newname
, "overwrite", 1, 0, 1);
2458 if (!NILP (Ffile_directory_p (newname
)))
2459 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2461 newname
= Fexpand_file_name (newname
, Qnil
);
2463 file
= Fexpand_file_name (file
, Qnil
);
2465 /* If the input file name has special constructs in it,
2466 call the corresponding file handler. */
2467 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2468 /* Likewise for output file name. */
2470 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2471 if (!NILP (handler
))
2472 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2473 ok_if_already_exists
, keep_time
));
2475 encoded_file
= ENCODE_FILE (file
);
2476 encoded_newname
= ENCODE_FILE (newname
);
2478 if (NILP (ok_if_already_exists
)
2479 || INTEGERP (ok_if_already_exists
))
2480 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2481 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2482 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2486 if (!CopyFile (SDATA (encoded_file
),
2487 SDATA (encoded_newname
),
2489 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2490 /* CopyFile retains the timestamp by default. */
2491 else if (NILP (keep_time
))
2497 EMACS_GET_TIME (now
);
2498 filename
= SDATA (encoded_newname
);
2500 /* Ensure file is writable while its modified time is set. */
2501 attributes
= GetFileAttributes (filename
);
2502 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2503 if (set_file_times (filename
, now
, now
))
2505 /* Restore original attributes. */
2506 SetFileAttributes (filename
, attributes
);
2507 Fsignal (Qfile_date_error
,
2508 Fcons (build_string ("Cannot set file date"),
2509 Fcons (newname
, Qnil
)));
2511 /* Restore original attributes. */
2512 SetFileAttributes (filename
, attributes
);
2514 #else /* not WINDOWSNT */
2516 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2520 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2522 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2524 /* We can only copy regular files and symbolic links. Other files are not
2526 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2528 #if !defined (MSDOS) || __DJGPP__ > 1
2529 if (out_st
.st_mode
!= 0
2530 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2533 report_file_error ("Input and output files are the same",
2534 Fcons (file
, Fcons (newname
, Qnil
)));
2538 #if defined (S_ISREG) && defined (S_ISLNK)
2539 if (input_file_statable_p
)
2541 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2543 #if defined (EISDIR)
2544 /* Get a better looking error message. */
2547 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2550 #endif /* S_ISREG && S_ISLNK */
2553 /* Create the copy file with the same record format as the input file */
2554 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2557 /* System's default file type was set to binary by _fmode in emacs.c. */
2558 ofd
= emacs_open (SDATA (encoded_newname
),
2559 O_WRONLY
| O_TRUNC
| O_CREAT
2560 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
2561 S_IREAD
| S_IWRITE
);
2562 #else /* not MSDOS */
2563 ofd
= emacs_open (SDATA (encoded_newname
),
2564 O_WRONLY
| O_TRUNC
| O_CREAT
2565 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
2567 #endif /* not MSDOS */
2570 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2572 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2576 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2577 if (emacs_write (ofd
, buf
, n
) != n
)
2578 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2582 /* Preserve the original file modes, and if requested, also its
2584 if (input_file_statable_p
)
2586 if (! NILP (preserve_uid_gid
))
2587 fchown (ofd
, st
.st_uid
, st
.st_gid
);
2588 fchmod (ofd
, st
.st_mode
& 07777);
2590 #endif /* not MSDOS */
2592 /* Closing the output clobbers the file times on some systems. */
2593 if (emacs_close (ofd
) < 0)
2594 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2596 if (input_file_statable_p
)
2598 if (!NILP (keep_time
))
2600 EMACS_TIME atime
, mtime
;
2601 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2602 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2603 if (set_file_times (SDATA (encoded_newname
),
2605 Fsignal (Qfile_date_error
,
2606 Fcons (build_string ("Cannot set file date"),
2607 Fcons (newname
, Qnil
)));
2613 #if defined (__DJGPP__) && __DJGPP__ > 1
2614 if (input_file_statable_p
)
2616 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2617 and if it can't, it tells so. Otherwise, under MSDOS we usually
2618 get only the READ bit, which will make the copied file read-only,
2619 so it's better not to chmod at all. */
2620 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2621 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2623 #endif /* DJGPP version 2 or newer */
2624 #endif /* not WINDOWSNT */
2626 /* Discard the unwind protects. */
2627 specpdl_ptr
= specpdl
+ count
;
2633 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2634 Smake_directory_internal
, 1, 1, 0,
2635 doc
: /* Create a new directory named DIRECTORY. */)
2637 Lisp_Object directory
;
2639 const unsigned char *dir
;
2640 Lisp_Object handler
;
2641 Lisp_Object encoded_dir
;
2643 CHECK_STRING (directory
);
2644 directory
= Fexpand_file_name (directory
, Qnil
);
2646 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2647 if (!NILP (handler
))
2648 return call2 (handler
, Qmake_directory_internal
, directory
);
2650 encoded_dir
= ENCODE_FILE (directory
);
2652 dir
= SDATA (encoded_dir
);
2655 if (mkdir (dir
) != 0)
2657 if (mkdir (dir
, 0777) != 0)
2659 report_file_error ("Creating directory", Flist (1, &directory
));
2664 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2665 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2667 Lisp_Object directory
;
2669 const unsigned char *dir
;
2670 Lisp_Object handler
;
2671 Lisp_Object encoded_dir
;
2673 CHECK_STRING (directory
);
2674 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2676 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2677 if (!NILP (handler
))
2678 return call2 (handler
, Qdelete_directory
, directory
);
2680 encoded_dir
= ENCODE_FILE (directory
);
2682 dir
= SDATA (encoded_dir
);
2684 if (rmdir (dir
) != 0)
2685 report_file_error ("Removing directory", Flist (1, &directory
));
2690 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2691 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2692 If file has multiple names, it continues to exist with the other names. */)
2694 Lisp_Object filename
;
2696 Lisp_Object handler
;
2697 Lisp_Object encoded_file
;
2698 struct gcpro gcpro1
;
2701 if (!NILP (Ffile_directory_p (filename
))
2702 && NILP (Ffile_symlink_p (filename
)))
2703 Fsignal (Qfile_error
,
2704 Fcons (build_string ("Removing old name: is a directory"),
2705 Fcons (filename
, Qnil
)));
2707 filename
= Fexpand_file_name (filename
, Qnil
);
2709 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2710 if (!NILP (handler
))
2711 return call2 (handler
, Qdelete_file
, filename
);
2713 encoded_file
= ENCODE_FILE (filename
);
2715 if (0 > unlink (SDATA (encoded_file
)))
2716 report_file_error ("Removing old name", Flist (1, &filename
));
2721 internal_delete_file_1 (ignore
)
2727 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2730 internal_delete_file (filename
)
2731 Lisp_Object filename
;
2733 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2734 Qt
, internal_delete_file_1
));
2737 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2738 "fRename file: \nGRename %s to file: \np",
2739 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2740 If file has names other than FILE, it continues to have those names.
2741 Signals a `file-already-exists' error if a file NEWNAME already exists
2742 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2743 A number as third arg means request confirmation if NEWNAME already exists.
2744 This is what happens in interactive use with M-x. */)
2745 (file
, newname
, ok_if_already_exists
)
2746 Lisp_Object file
, newname
, ok_if_already_exists
;
2749 Lisp_Object args
[2];
2751 Lisp_Object handler
;
2752 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2753 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2755 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2756 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2757 CHECK_STRING (file
);
2758 CHECK_STRING (newname
);
2759 file
= Fexpand_file_name (file
, Qnil
);
2761 if (!NILP (Ffile_directory_p (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 (encoded_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
);
2817 report_file_error ("Renaming", Flist (2, args
));
2820 report_file_error ("Renaming", Flist (2, &file
));
2827 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2828 "fAdd name to file: \nGName to add to %s: \np",
2829 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2830 Signals a `file-already-exists' error if a file NEWNAME already exists
2831 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2832 A number as third arg means request confirmation if NEWNAME already exists.
2833 This is what happens in interactive use with M-x. */)
2834 (file
, newname
, ok_if_already_exists
)
2835 Lisp_Object file
, newname
, ok_if_already_exists
;
2838 Lisp_Object args
[2];
2840 Lisp_Object handler
;
2841 Lisp_Object encoded_file
, encoded_newname
;
2842 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2844 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2845 encoded_file
= encoded_newname
= Qnil
;
2846 CHECK_STRING (file
);
2847 CHECK_STRING (newname
);
2848 file
= Fexpand_file_name (file
, Qnil
);
2850 if (!NILP (Ffile_directory_p (newname
)))
2851 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2853 newname
= Fexpand_file_name (newname
, Qnil
);
2855 /* If the file name has special constructs in it,
2856 call the corresponding file handler. */
2857 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2858 if (!NILP (handler
))
2859 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2860 newname
, ok_if_already_exists
));
2862 /* If the new name has special constructs in it,
2863 call the corresponding file handler. */
2864 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2865 if (!NILP (handler
))
2866 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2867 newname
, ok_if_already_exists
));
2869 encoded_file
= ENCODE_FILE (file
);
2870 encoded_newname
= ENCODE_FILE (newname
);
2872 if (NILP (ok_if_already_exists
)
2873 || INTEGERP (ok_if_already_exists
))
2874 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2875 INTEGERP (ok_if_already_exists
), 0, 0);
2877 unlink (SDATA (newname
));
2878 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2883 report_file_error ("Adding new name", Flist (2, args
));
2885 report_file_error ("Adding new name", Flist (2, &file
));
2894 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2895 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2896 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2897 Both args must be strings.
2898 Signals a `file-already-exists' error if a file LINKNAME already exists
2899 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2900 A number as third arg means request confirmation if LINKNAME already exists.
2901 This happens for interactive use with M-x. */)
2902 (filename
, linkname
, ok_if_already_exists
)
2903 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2906 Lisp_Object args
[2];
2908 Lisp_Object handler
;
2909 Lisp_Object encoded_filename
, encoded_linkname
;
2910 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2912 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2913 encoded_filename
= encoded_linkname
= Qnil
;
2914 CHECK_STRING (filename
);
2915 CHECK_STRING (linkname
);
2916 /* If the link target has a ~, we must expand it to get
2917 a truly valid file name. Otherwise, do not expand;
2918 we want to permit links to relative file names. */
2919 if (SREF (filename
, 0) == '~')
2920 filename
= Fexpand_file_name (filename
, Qnil
);
2922 if (!NILP (Ffile_directory_p (linkname
)))
2923 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2925 linkname
= Fexpand_file_name (linkname
, Qnil
);
2927 /* If the file name has special constructs in it,
2928 call the corresponding file handler. */
2929 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2930 if (!NILP (handler
))
2931 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2932 linkname
, ok_if_already_exists
));
2934 /* If the new link name has special constructs in it,
2935 call the corresponding file handler. */
2936 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2937 if (!NILP (handler
))
2938 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2939 linkname
, ok_if_already_exists
));
2941 encoded_filename
= ENCODE_FILE (filename
);
2942 encoded_linkname
= ENCODE_FILE (linkname
);
2944 if (NILP (ok_if_already_exists
)
2945 || INTEGERP (ok_if_already_exists
))
2946 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2947 INTEGERP (ok_if_already_exists
), 0, 0);
2948 if (0 > symlink (SDATA (encoded_filename
),
2949 SDATA (encoded_linkname
)))
2951 /* If we didn't complain already, silently delete existing file. */
2952 if (errno
== EEXIST
)
2954 unlink (SDATA (encoded_linkname
));
2955 if (0 <= symlink (SDATA (encoded_filename
),
2956 SDATA (encoded_linkname
)))
2966 report_file_error ("Making symbolic link", Flist (2, args
));
2968 report_file_error ("Making symbolic link", Flist (2, &filename
));
2974 #endif /* S_IFLNK */
2978 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2979 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2980 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2981 If STRING is nil or a null string, the logical name NAME is deleted. */)
2986 CHECK_STRING (name
);
2988 delete_logical_name (SDATA (name
));
2991 CHECK_STRING (string
);
2993 if (SCHARS (string
) == 0)
2994 delete_logical_name (SDATA (name
));
2996 define_logical_name (SDATA (name
), SDATA (string
));
3005 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
3006 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
3008 Lisp_Object path
, login
;
3012 CHECK_STRING (path
);
3013 CHECK_STRING (login
);
3015 netresult
= netunam (SDATA (path
), SDATA (login
));
3017 if (netresult
== -1)
3022 #endif /* HPUX_NET */
3024 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
3026 doc
: /* Return t if file FILENAME specifies an absolute file name.
3027 On Unix, this is a name starting with a `/' or a `~'. */)
3029 Lisp_Object filename
;
3031 CHECK_STRING (filename
);
3032 return file_name_absolute_p (SDATA (filename
)) ? Qt
: Qnil
;
3035 /* Return nonzero if file FILENAME exists and can be executed. */
3038 check_executable (filename
)
3042 int len
= strlen (filename
);
3045 if (stat (filename
, &st
) < 0)
3047 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
3048 return ((st
.st_mode
& S_IEXEC
) != 0);
3050 return (S_ISREG (st
.st_mode
)
3052 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
3053 || stricmp (suffix
, ".exe") == 0
3054 || stricmp (suffix
, ".bat") == 0)
3055 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3056 #endif /* not WINDOWSNT */
3057 #else /* not DOS_NT */
3058 #ifdef HAVE_EUIDACCESS
3059 return (euidaccess (filename
, 1) >= 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 return (access (filename
, 1) >= 0);
3066 #endif /* not DOS_NT */
3069 /* Return nonzero if file FILENAME exists and can be written. */
3072 check_writable (filename
)
3077 if (stat (filename
, &st
) < 0)
3079 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3080 #else /* not MSDOS */
3081 #ifdef HAVE_EUIDACCESS
3082 return (euidaccess (filename
, 2) >= 0);
3084 /* Access isn't quite right because it uses the real uid
3085 and we really want to test with the effective uid.
3086 But Unix doesn't give us a right way to do it.
3087 Opening with O_WRONLY could work for an ordinary file,
3088 but would lose for directories. */
3089 return (access (filename
, 2) >= 0);
3091 #endif /* not MSDOS */
3094 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3095 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
3096 See also `file-readable-p' and `file-attributes'.
3097 This returns nil for a symlink to a nonexistent file.
3098 Use `file-symlink-p' to test for such links. */)
3100 Lisp_Object filename
;
3102 Lisp_Object absname
;
3103 Lisp_Object handler
;
3104 struct stat statbuf
;
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_exists_p
);
3112 if (!NILP (handler
))
3113 return call2 (handler
, Qfile_exists_p
, absname
);
3115 absname
= ENCODE_FILE (absname
);
3117 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3120 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3121 doc
: /* Return t if FILENAME can be executed by you.
3122 For a directory, this means you can access files in that directory. */)
3124 Lisp_Object filename
;
3126 Lisp_Object absname
;
3127 Lisp_Object handler
;
3129 CHECK_STRING (filename
);
3130 absname
= Fexpand_file_name (filename
, Qnil
);
3132 /* If the file name has special constructs in it,
3133 call the corresponding file handler. */
3134 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3135 if (!NILP (handler
))
3136 return call2 (handler
, Qfile_executable_p
, absname
);
3138 absname
= ENCODE_FILE (absname
);
3140 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3143 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3144 doc
: /* Return t if file FILENAME exists and you can read it.
3145 See also `file-exists-p' and `file-attributes'. */)
3147 Lisp_Object filename
;
3149 Lisp_Object absname
;
3150 Lisp_Object handler
;
3153 struct stat statbuf
;
3155 CHECK_STRING (filename
);
3156 absname
= Fexpand_file_name (filename
, Qnil
);
3158 /* If the file name has special constructs in it,
3159 call the corresponding file handler. */
3160 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3161 if (!NILP (handler
))
3162 return call2 (handler
, Qfile_readable_p
, absname
);
3164 absname
= ENCODE_FILE (absname
);
3166 #if defined(DOS_NT) || defined(macintosh)
3167 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3169 if (access (SDATA (absname
), 0) == 0)
3172 #else /* not DOS_NT and not macintosh */
3174 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3175 /* Opening a fifo without O_NONBLOCK can wait.
3176 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3177 except in the case of a fifo, on a system which handles it. */
3178 desc
= stat (SDATA (absname
), &statbuf
);
3181 if (S_ISFIFO (statbuf
.st_mode
))
3182 flags
|= O_NONBLOCK
;
3184 desc
= emacs_open (SDATA (absname
), flags
, 0);
3189 #endif /* not DOS_NT and not macintosh */
3192 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3194 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3195 doc
: /* Return t if file FILENAME can be written or created by you. */)
3197 Lisp_Object filename
;
3199 Lisp_Object absname
, dir
, encoded
;
3200 Lisp_Object handler
;
3201 struct stat statbuf
;
3203 CHECK_STRING (filename
);
3204 absname
= Fexpand_file_name (filename
, Qnil
);
3206 /* If the file name has special constructs in it,
3207 call the corresponding file handler. */
3208 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3209 if (!NILP (handler
))
3210 return call2 (handler
, Qfile_writable_p
, absname
);
3212 encoded
= ENCODE_FILE (absname
);
3213 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3214 return (check_writable (SDATA (encoded
))
3217 dir
= Ffile_name_directory (absname
);
3220 dir
= Fdirectory_file_name (dir
);
3224 dir
= Fdirectory_file_name (dir
);
3227 dir
= ENCODE_FILE (dir
);
3229 /* The read-only attribute of the parent directory doesn't affect
3230 whether a file or directory can be created within it. Some day we
3231 should check ACLs though, which do affect this. */
3232 if (stat (SDATA (dir
), &statbuf
) < 0)
3234 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3236 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3241 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3242 doc
: /* Access file FILENAME, and get an error if that does not work.
3243 The second argument STRING is used in the error message.
3244 If there is no error, returns nil. */)
3246 Lisp_Object filename
, string
;
3248 Lisp_Object handler
, encoded_filename
, absname
;
3251 CHECK_STRING (filename
);
3252 absname
= Fexpand_file_name (filename
, Qnil
);
3254 CHECK_STRING (string
);
3256 /* If the file name has special constructs in it,
3257 call the corresponding file handler. */
3258 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3259 if (!NILP (handler
))
3260 return call3 (handler
, Qaccess_file
, absname
, string
);
3262 encoded_filename
= ENCODE_FILE (absname
);
3264 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3266 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3272 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3273 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3274 The value is the link target, as a string.
3275 Otherwise it returns nil.
3277 This function returns t when given the name of a symlink that
3278 points to a nonexistent file. */)
3280 Lisp_Object filename
;
3282 Lisp_Object handler
;
3284 CHECK_STRING (filename
);
3285 filename
= Fexpand_file_name (filename
, Qnil
);
3287 /* If the file name has special constructs in it,
3288 call the corresponding file handler. */
3289 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3290 if (!NILP (handler
))
3291 return call2 (handler
, Qfile_symlink_p
, filename
);
3300 filename
= ENCODE_FILE (filename
);
3307 buf
= (char *) xrealloc (buf
, bufsize
);
3308 bzero (buf
, bufsize
);
3311 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3315 /* HP-UX reports ERANGE if buffer is too small. */
3316 if (errno
== ERANGE
)
3326 while (valsize
>= bufsize
);
3328 val
= make_string (buf
, valsize
);
3329 if (buf
[0] == '/' && index (buf
, ':'))
3330 val
= concat2 (build_string ("/:"), val
);
3332 val
= DECODE_FILE (val
);
3335 #else /* not S_IFLNK */
3337 #endif /* not S_IFLNK */
3340 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3341 doc
: /* Return t if FILENAME names an existing directory.
3342 Symbolic links to directories count as directories.
3343 See `file-symlink-p' to distinguish symlinks. */)
3345 Lisp_Object filename
;
3347 register Lisp_Object absname
;
3349 Lisp_Object handler
;
3351 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3353 /* If the file name has special constructs in it,
3354 call the corresponding file handler. */
3355 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3356 if (!NILP (handler
))
3357 return call2 (handler
, Qfile_directory_p
, absname
);
3359 absname
= ENCODE_FILE (absname
);
3361 if (stat (SDATA (absname
), &st
) < 0)
3363 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3366 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3367 doc
: /* Return t if file FILENAME names a directory you can open.
3368 For the value to be t, FILENAME must specify the name of a directory as a file,
3369 and the directory must allow you to open files in it. In order to use a
3370 directory as a buffer's current directory, this predicate must return true.
3371 A directory name spec may be given instead; then the value is t
3372 if the directory so specified exists and really is a readable and
3373 searchable directory. */)
3375 Lisp_Object filename
;
3377 Lisp_Object handler
;
3379 struct gcpro gcpro1
;
3381 /* If the file name has special constructs in it,
3382 call the corresponding file handler. */
3383 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3384 if (!NILP (handler
))
3385 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3388 tem
= (NILP (Ffile_directory_p (filename
))
3389 || NILP (Ffile_executable_p (filename
)));
3391 return tem
? Qnil
: Qt
;
3394 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3395 doc
: /* Return t if FILENAME names a regular file.
3396 This is the sort of file that holds an ordinary stream of data bytes.
3397 Symbolic links to regular files count as regular files.
3398 See `file-symlink-p' to distinguish symlinks. */)
3400 Lisp_Object filename
;
3402 register Lisp_Object absname
;
3404 Lisp_Object handler
;
3406 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3408 /* If the file name has special constructs in it,
3409 call the corresponding file handler. */
3410 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3411 if (!NILP (handler
))
3412 return call2 (handler
, Qfile_regular_p
, absname
);
3414 absname
= ENCODE_FILE (absname
);
3419 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3421 /* Tell stat to use expensive method to get accurate info. */
3422 Vw32_get_true_file_attributes
= Qt
;
3423 result
= stat (SDATA (absname
), &st
);
3424 Vw32_get_true_file_attributes
= tem
;
3428 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3431 if (stat (SDATA (absname
), &st
) < 0)
3433 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3437 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3438 doc
: /* Return mode bits of file named FILENAME, as an integer.
3439 Return nil, if file does not exist or is not accessible. */)
3441 Lisp_Object filename
;
3443 Lisp_Object absname
;
3445 Lisp_Object handler
;
3447 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3449 /* If the file name has special constructs in it,
3450 call the corresponding file handler. */
3451 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3452 if (!NILP (handler
))
3453 return call2 (handler
, Qfile_modes
, absname
);
3455 absname
= ENCODE_FILE (absname
);
3457 if (stat (SDATA (absname
), &st
) < 0)
3459 #if defined (MSDOS) && __DJGPP__ < 2
3460 if (check_executable (SDATA (absname
)))
3461 st
.st_mode
|= S_IEXEC
;
3462 #endif /* MSDOS && __DJGPP__ < 2 */
3464 return make_number (st
.st_mode
& 07777);
3467 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3468 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3469 Only the 12 low bits of MODE are used. */)
3471 Lisp_Object filename
, mode
;
3473 Lisp_Object absname
, encoded_absname
;
3474 Lisp_Object handler
;
3476 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3477 CHECK_NUMBER (mode
);
3479 /* If the file name has special constructs in it,
3480 call the corresponding file handler. */
3481 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3482 if (!NILP (handler
))
3483 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3485 encoded_absname
= ENCODE_FILE (absname
);
3487 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3488 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3493 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3494 doc
: /* Set the file permission bits for newly created files.
3495 The argument MODE should be an integer; only the low 9 bits are used.
3496 This setting is inherited by subprocesses. */)
3500 CHECK_NUMBER (mode
);
3502 umask ((~ XINT (mode
)) & 0777);
3507 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3508 doc
: /* Return the default file protection for created files.
3509 The value is an integer. */)
3515 realmask
= umask (0);
3518 XSETINT (value
, (~ realmask
) & 0777);
3522 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3524 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3525 doc
: /* Set times of file FILENAME to TIME.
3526 Set both access and modification times.
3527 Return t on success, else nil.
3528 Use the current time if TIME is nil. TIME is in the format of
3531 Lisp_Object filename
, time
;
3533 Lisp_Object absname
, encoded_absname
;
3534 Lisp_Object handler
;
3538 if (! lisp_time_argument (time
, &sec
, &usec
))
3539 error ("Invalid time specification");
3541 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3543 /* If the file name has special constructs in it,
3544 call the corresponding file handler. */
3545 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3546 if (!NILP (handler
))
3547 return call3 (handler
, Qset_file_times
, absname
, time
);
3549 encoded_absname
= ENCODE_FILE (absname
);
3554 EMACS_SET_SECS (t
, sec
);
3555 EMACS_SET_USECS (t
, usec
);
3557 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3562 /* Setting times on a directory always fails. */
3563 if (stat (SDATA (encoded_absname
), &st
) == 0
3564 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3567 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3580 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3581 doc
: /* Tell Unix to finish all pending disk updates. */)
3590 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3591 doc
: /* Return t if file FILE1 is newer than file FILE2.
3592 If FILE1 does not exist, the answer is nil;
3593 otherwise, if FILE2 does not exist, the answer is t. */)
3595 Lisp_Object file1
, file2
;
3597 Lisp_Object absname1
, absname2
;
3600 Lisp_Object handler
;
3601 struct gcpro gcpro1
, gcpro2
;
3603 CHECK_STRING (file1
);
3604 CHECK_STRING (file2
);
3607 GCPRO2 (absname1
, file2
);
3608 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3609 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3612 /* If the file name has special constructs in it,
3613 call the corresponding file handler. */
3614 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3616 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3617 if (!NILP (handler
))
3618 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3620 GCPRO2 (absname1
, absname2
);
3621 absname1
= ENCODE_FILE (absname1
);
3622 absname2
= ENCODE_FILE (absname2
);
3625 if (stat (SDATA (absname1
), &st
) < 0)
3628 mtime1
= st
.st_mtime
;
3630 if (stat (SDATA (absname2
), &st
) < 0)
3633 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3637 Lisp_Object Qfind_buffer_file_type
;
3640 #ifndef READ_BUF_SIZE
3641 #define READ_BUF_SIZE (64 << 10)
3644 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3646 /* This function is called after Lisp functions to decide a coding
3647 system are called, or when they cause an error. Before they are
3648 called, the current buffer is set unibyte and it contains only a
3649 newly inserted text (thus the buffer was empty before the
3652 The functions may set markers, overlays, text properties, or even
3653 alter the buffer contents, change the current buffer.
3655 Here, we reset all those changes by:
3656 o set back the current buffer.
3657 o move all markers and overlays to BEG.
3658 o remove all text properties.
3659 o set back the buffer multibyteness. */
3662 decide_coding_unwind (unwind_data
)
3663 Lisp_Object unwind_data
;
3665 Lisp_Object multibyte
, undo_list
, buffer
;
3667 multibyte
= XCAR (unwind_data
);
3668 unwind_data
= XCDR (unwind_data
);
3669 undo_list
= XCAR (unwind_data
);
3670 buffer
= XCDR (unwind_data
);
3672 if (current_buffer
!= XBUFFER (buffer
))
3673 set_buffer_internal (XBUFFER (buffer
));
3674 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3675 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3676 BUF_INTERVALS (current_buffer
) = 0;
3677 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3679 /* Now we are safe to change the buffer's multibyteness directly. */
3680 current_buffer
->enable_multibyte_characters
= multibyte
;
3681 current_buffer
->undo_list
= undo_list
;
3687 /* Used to pass values from insert-file-contents to read_non_regular. */
3689 static int non_regular_fd
;
3690 static int non_regular_inserted
;
3691 static int non_regular_nbytes
;
3694 /* Read from a non-regular file.
3695 Read non_regular_trytry bytes max from non_regular_fd.
3696 Non_regular_inserted specifies where to put the read bytes.
3697 Value is the number of bytes read. */
3706 nbytes
= emacs_read (non_regular_fd
,
3707 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3708 non_regular_nbytes
);
3710 return make_number (nbytes
);
3714 /* Condition-case handler used when reading from non-regular files
3715 in insert-file-contents. */
3718 read_non_regular_quit ()
3724 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3726 doc
: /* Insert contents of file FILENAME after point.
3727 Returns list of absolute file name and number of characters inserted.
3728 If second argument VISIT is non-nil, the buffer's visited filename
3729 and last save file modtime are set, and it is marked unmodified.
3730 If visiting and the file does not exist, visiting is completed
3731 before the error is signaled.
3732 The optional third and fourth arguments BEG and END
3733 specify what portion of the file to insert.
3734 These arguments count bytes in the file, not characters in the buffer.
3735 If VISIT is non-nil, BEG and END must be nil.
3737 If optional fifth argument REPLACE is non-nil,
3738 it means replace the current buffer contents (in the accessible portion)
3739 with the file contents. This is better than simply deleting and inserting
3740 the whole thing because (1) it preserves some marker positions
3741 and (2) it puts less data in the undo list.
3742 When REPLACE is non-nil, the value is the number of characters actually read,
3743 which is often less than the number of characters to be read.
3745 This does code conversion according to the value of
3746 `coding-system-for-read' or `file-coding-system-alist',
3747 and sets the variable `last-coding-system-used' to the coding system
3749 (filename
, visit
, beg
, end
, replace
)
3750 Lisp_Object filename
, visit
, beg
, end
, replace
;
3755 register int how_much
;
3756 register int unprocessed
;
3757 int count
= SPECPDL_INDEX ();
3758 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3759 Lisp_Object handler
, val
, insval
, orig_filename
;
3762 int not_regular
= 0;
3763 unsigned char read_buf
[READ_BUF_SIZE
];
3764 struct coding_system coding
;
3765 unsigned char buffer
[1 << 14];
3766 int replace_handled
= 0;
3767 int set_coding_system
= 0;
3768 int coding_system_decided
= 0;
3770 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3771 int we_locked_file
= 0;
3773 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3774 error ("Cannot do file visiting in an indirect buffer");
3776 if (!NILP (current_buffer
->read_only
))
3777 Fbarf_if_buffer_read_only ();
3781 orig_filename
= Qnil
;
3783 GCPRO4 (filename
, val
, p
, orig_filename
);
3785 CHECK_STRING (filename
);
3786 filename
= Fexpand_file_name (filename
, Qnil
);
3788 /* If the file name has special constructs in it,
3789 call the corresponding file handler. */
3790 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3791 if (!NILP (handler
))
3793 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3794 visit
, beg
, end
, replace
);
3795 if (CONSP (val
) && CONSP (XCDR (val
)))
3796 inserted
= XINT (XCAR (XCDR (val
)));
3800 orig_filename
= filename
;
3801 filename
= ENCODE_FILE (filename
);
3807 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3809 /* Tell stat to use expensive method to get accurate info. */
3810 Vw32_get_true_file_attributes
= Qt
;
3811 total
= stat (SDATA (filename
), &st
);
3812 Vw32_get_true_file_attributes
= tem
;
3817 if (stat (SDATA (filename
), &st
) < 0)
3819 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3820 || fstat (fd
, &st
) < 0)
3821 #endif /* not APOLLO */
3822 #endif /* WINDOWSNT */
3824 if (fd
>= 0) emacs_close (fd
);
3827 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3830 if (!NILP (Vcoding_system_for_read
))
3831 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3836 /* This code will need to be changed in order to work on named
3837 pipes, and it's probably just not worth it. So we should at
3838 least signal an error. */
3839 if (!S_ISREG (st
.st_mode
))
3846 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3847 Fsignal (Qfile_error
,
3848 Fcons (build_string ("not a regular file"),
3849 Fcons (orig_filename
, Qnil
)));
3854 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3857 /* Replacement should preserve point as it preserves markers. */
3858 if (!NILP (replace
))
3859 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3861 record_unwind_protect (close_file_unwind
, make_number (fd
));
3863 /* Supposedly happens on VMS. */
3864 /* Can happen on any platform that uses long as type of off_t, but allows
3865 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3866 give a message suitable for the latter case. */
3867 if (! not_regular
&& st
.st_size
< 0)
3868 error ("Maximum buffer size exceeded");
3870 /* Prevent redisplay optimizations. */
3871 current_buffer
->clip_changed
= 1;
3875 if (!NILP (beg
) || !NILP (end
))
3876 error ("Attempt to visit less than an entire file");
3877 if (BEG
< Z
&& NILP (replace
))
3878 error ("Cannot do file visiting in a non-empty buffer");
3884 XSETFASTINT (beg
, 0);
3892 XSETINT (end
, st
.st_size
);
3894 /* Arithmetic overflow can occur if an Emacs integer cannot
3895 represent the file size, or if the calculations below
3896 overflow. The calculations below double the file size
3897 twice, so check that it can be multiplied by 4 safely. */
3898 if (XINT (end
) != st
.st_size
3899 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3900 error ("Maximum buffer size exceeded");
3902 /* The file size returned from stat may be zero, but data
3903 may be readable nonetheless, for example when this is a
3904 file in the /proc filesystem. */
3905 if (st
.st_size
== 0)
3906 XSETINT (end
, READ_BUF_SIZE
);
3910 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3912 /* We use emacs-mule for auto saving... */
3913 setup_coding_system (Qemacs_mule
, &coding
);
3914 /* ... but with the special flag to indicate to read in a
3915 multibyte sequence for eight-bit-control char as is. */
3917 coding
.src_multibyte
= 0;
3918 coding
.dst_multibyte
3919 = !NILP (current_buffer
->enable_multibyte_characters
);
3920 coding
.eol_type
= CODING_EOL_LF
;
3921 coding_system_decided
= 1;
3925 /* Decide the coding system to use for reading the file now
3926 because we can't use an optimized method for handling
3927 `coding:' tag if the current buffer is not empty. */
3931 if (!NILP (Vcoding_system_for_read
))
3932 val
= Vcoding_system_for_read
;
3935 /* Don't try looking inside a file for a coding system
3936 specification if it is not seekable. */
3937 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3939 /* Find a coding system specified in the heading two
3940 lines or in the tailing several lines of the file.
3941 We assume that the 1K-byte and 3K-byte for heading
3942 and tailing respectively are sufficient for this
3946 if (st
.st_size
<= (1024 * 4))
3947 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3950 nread
= emacs_read (fd
, read_buf
, 1024);
3953 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3954 report_file_error ("Setting file position",
3955 Fcons (orig_filename
, Qnil
));
3956 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3961 error ("IO error reading %s: %s",
3962 SDATA (orig_filename
), emacs_strerror (errno
));
3965 struct buffer
*prev
= current_buffer
;
3969 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3971 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3972 buf
= XBUFFER (buffer
);
3974 delete_all_overlays (buf
);
3975 buf
->directory
= current_buffer
->directory
;
3976 buf
->read_only
= Qnil
;
3977 buf
->filename
= Qnil
;
3978 buf
->undo_list
= Qt
;
3979 eassert (buf
->overlays_before
== NULL
);
3980 eassert (buf
->overlays_after
== NULL
);
3982 set_buffer_internal (buf
);
3984 buf
->enable_multibyte_characters
= Qnil
;
3986 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3987 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3988 val
= call2 (Vset_auto_coding_function
,
3989 filename
, make_number (nread
));
3990 set_buffer_internal (prev
);
3992 /* Discard the unwind protect for recovering the
3996 /* Rewind the file for the actual read done later. */
3997 if (lseek (fd
, 0, 0) < 0)
3998 report_file_error ("Setting file position",
3999 Fcons (orig_filename
, Qnil
));
4005 /* If we have not yet decided a coding system, check
4006 file-coding-system-alist. */
4007 Lisp_Object args
[6], coding_systems
;
4009 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4010 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
4011 coding_systems
= Ffind_operation_coding_system (6, args
);
4012 if (CONSP (coding_systems
))
4013 val
= XCAR (coding_systems
);
4017 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4018 /* Ensure we set Vlast_coding_system_used. */
4019 set_coding_system
= 1;
4021 if (NILP (current_buffer
->enable_multibyte_characters
)
4023 /* We must suppress all character code conversion except for
4024 end-of-line conversion. */
4025 setup_raw_text_coding_system (&coding
);
4027 coding
.src_multibyte
= 0;
4028 coding
.dst_multibyte
4029 = !NILP (current_buffer
->enable_multibyte_characters
);
4030 coding_system_decided
= 1;
4033 /* If requested, replace the accessible part of the buffer
4034 with the file contents. Avoid replacing text at the
4035 beginning or end of the buffer that matches the file contents;
4036 that preserves markers pointing to the unchanged parts.
4038 Here we implement this feature in an optimized way
4039 for the case where code conversion is NOT needed.
4040 The following if-statement handles the case of conversion
4041 in a less optimal way.
4043 If the code conversion is "automatic" then we try using this
4044 method and hope for the best.
4045 But if we discover the need for conversion, we give up on this method
4046 and let the following if-statement handle the replace job. */
4049 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
4051 /* same_at_start and same_at_end count bytes,
4052 because file access counts bytes
4053 and BEG and END count bytes. */
4054 int same_at_start
= BEGV_BYTE
;
4055 int same_at_end
= ZV_BYTE
;
4057 /* There is still a possibility we will find the need to do code
4058 conversion. If that happens, we set this variable to 1 to
4059 give up on handling REPLACE in the optimized way. */
4060 int giveup_match_end
= 0;
4062 if (XINT (beg
) != 0)
4064 if (lseek (fd
, XINT (beg
), 0) < 0)
4065 report_file_error ("Setting file position",
4066 Fcons (orig_filename
, Qnil
));
4071 /* Count how many chars at the start of the file
4072 match the text at the beginning of the buffer. */
4077 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4079 error ("IO error reading %s: %s",
4080 SDATA (orig_filename
), emacs_strerror (errno
));
4081 else if (nread
== 0)
4084 if (coding
.type
== coding_type_undecided
)
4085 detect_coding (&coding
, buffer
, nread
);
4086 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
4087 /* We found that the file should be decoded somehow.
4088 Let's give up here. */
4090 giveup_match_end
= 1;
4094 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
4095 detect_eol (&coding
, buffer
, nread
);
4096 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
4097 && coding
.eol_type
!= CODING_EOL_LF
)
4098 /* We found that the format of eol should be decoded.
4099 Let's give up here. */
4101 giveup_match_end
= 1;
4106 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4107 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4108 same_at_start
++, bufpos
++;
4109 /* If we found a discrepancy, stop the scan.
4110 Otherwise loop around and scan the next bufferful. */
4111 if (bufpos
!= nread
)
4115 /* If the file matches the buffer completely,
4116 there's no need to replace anything. */
4117 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4121 /* Truncate the buffer to the size of the file. */
4122 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4127 /* Count how many chars at the end of the file
4128 match the text at the end of the buffer. But, if we have
4129 already found that decoding is necessary, don't waste time. */
4130 while (!giveup_match_end
)
4132 int total_read
, nread
, bufpos
, curpos
, trial
;
4134 /* At what file position are we now scanning? */
4135 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4136 /* If the entire file matches the buffer tail, stop the scan. */
4139 /* How much can we scan in the next step? */
4140 trial
= min (curpos
, sizeof buffer
);
4141 if (lseek (fd
, curpos
- trial
, 0) < 0)
4142 report_file_error ("Setting file position",
4143 Fcons (orig_filename
, Qnil
));
4145 total_read
= nread
= 0;
4146 while (total_read
< trial
)
4148 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4150 error ("IO error reading %s: %s",
4151 SDATA (orig_filename
), emacs_strerror (errno
));
4152 else if (nread
== 0)
4154 total_read
+= nread
;
4157 /* Scan this bufferful from the end, comparing with
4158 the Emacs buffer. */
4159 bufpos
= total_read
;
4161 /* Compare with same_at_start to avoid counting some buffer text
4162 as matching both at the file's beginning and at the end. */
4163 while (bufpos
> 0 && same_at_end
> same_at_start
4164 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4165 same_at_end
--, bufpos
--;
4167 /* If we found a discrepancy, stop the scan.
4168 Otherwise loop around and scan the preceding bufferful. */
4171 /* If this discrepancy is because of code conversion,
4172 we cannot use this method; giveup and try the other. */
4173 if (same_at_end
> same_at_start
4174 && FETCH_BYTE (same_at_end
- 1) >= 0200
4175 && ! NILP (current_buffer
->enable_multibyte_characters
)
4176 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4177 giveup_match_end
= 1;
4186 if (! giveup_match_end
)
4190 /* We win! We can handle REPLACE the optimized way. */
4192 /* Extend the start of non-matching text area to multibyte
4193 character boundary. */
4194 if (! NILP (current_buffer
->enable_multibyte_characters
))
4195 while (same_at_start
> BEGV_BYTE
4196 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4199 /* Extend the end of non-matching text area to multibyte
4200 character boundary. */
4201 if (! NILP (current_buffer
->enable_multibyte_characters
))
4202 while (same_at_end
< ZV_BYTE
4203 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4206 /* Don't try to reuse the same piece of text twice. */
4207 overlap
= (same_at_start
- BEGV_BYTE
4208 - (same_at_end
+ st
.st_size
- ZV
));
4210 same_at_end
+= overlap
;
4212 /* Arrange to read only the nonmatching middle part of the file. */
4213 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4214 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4216 del_range_byte (same_at_start
, same_at_end
, 0);
4217 /* Insert from the file at the proper position. */
4218 temp
= BYTE_TO_CHAR (same_at_start
);
4219 SET_PT_BOTH (temp
, same_at_start
);
4221 /* If display currently starts at beginning of line,
4222 keep it that way. */
4223 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4224 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4226 replace_handled
= 1;
4230 /* If requested, replace the accessible part of the buffer
4231 with the file contents. Avoid replacing text at the
4232 beginning or end of the buffer that matches the file contents;
4233 that preserves markers pointing to the unchanged parts.
4235 Here we implement this feature for the case where code conversion
4236 is needed, in a simple way that needs a lot of memory.
4237 The preceding if-statement handles the case of no conversion
4238 in a more optimized way. */
4239 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4241 int same_at_start
= BEGV_BYTE
;
4242 int same_at_end
= ZV_BYTE
;
4245 /* Make sure that the gap is large enough. */
4246 int bufsize
= 2 * st
.st_size
;
4247 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4250 /* First read the whole file, performing code conversion into
4251 CONVERSION_BUFFER. */
4253 if (lseek (fd
, XINT (beg
), 0) < 0)
4255 xfree (conversion_buffer
);
4256 report_file_error ("Setting file position",
4257 Fcons (orig_filename
, Qnil
));
4260 total
= st
.st_size
; /* Total bytes in the file. */
4261 how_much
= 0; /* Bytes read from file so far. */
4262 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4263 unprocessed
= 0; /* Bytes not processed in previous loop. */
4265 while (how_much
< total
)
4267 /* try is reserved in some compilers (Microsoft C) */
4268 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4269 unsigned char *destination
= read_buf
+ unprocessed
;
4272 /* Allow quitting out of the actual I/O. */
4275 this = emacs_read (fd
, destination
, trytry
);
4278 if (this < 0 || this + unprocessed
== 0)
4286 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4288 int require
, result
;
4290 this += unprocessed
;
4292 /* If we are using more space than estimated,
4293 make CONVERSION_BUFFER bigger. */
4294 require
= decoding_buffer_size (&coding
, this);
4295 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4297 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4298 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4301 /* Convert this batch with results in CONVERSION_BUFFER. */
4302 if (how_much
>= total
) /* This is the last block. */
4303 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4304 if (coding
.composing
!= COMPOSITION_DISABLED
)
4305 coding_allocate_composition_data (&coding
, BEGV
);
4306 result
= decode_coding (&coding
, read_buf
,
4307 conversion_buffer
+ inserted
,
4308 this, bufsize
- inserted
);
4310 /* Save for next iteration whatever we didn't convert. */
4311 unprocessed
= this - coding
.consumed
;
4312 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4313 if (!NILP (current_buffer
->enable_multibyte_characters
))
4314 this = coding
.produced
;
4316 this = str_as_unibyte (conversion_buffer
+ inserted
,
4323 /* At this point, INSERTED is how many characters (i.e. bytes)
4324 are present in CONVERSION_BUFFER.
4325 HOW_MUCH should equal TOTAL,
4326 or should be <= 0 if we couldn't read the file. */
4330 xfree (conversion_buffer
);
4331 coding_free_composition_data (&coding
);
4333 error ("IO error reading %s: %s",
4334 SDATA (orig_filename
), emacs_strerror (errno
));
4335 else if (how_much
== -2)
4336 error ("maximum buffer size exceeded");
4339 /* Compare the beginning of the converted file
4340 with the buffer text. */
4343 while (bufpos
< inserted
&& same_at_start
< same_at_end
4344 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4345 same_at_start
++, bufpos
++;
4347 /* If the file matches the buffer completely,
4348 there's no need to replace anything. */
4350 if (bufpos
== inserted
)
4352 xfree (conversion_buffer
);
4353 coding_free_composition_data (&coding
);
4356 /* Truncate the buffer to the size of the file. */
4357 del_range_byte (same_at_start
, same_at_end
, 0);
4362 /* Extend the start of non-matching text area to multibyte
4363 character boundary. */
4364 if (! NILP (current_buffer
->enable_multibyte_characters
))
4365 while (same_at_start
> BEGV_BYTE
4366 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4369 /* Scan this bufferful from the end, comparing with
4370 the Emacs buffer. */
4373 /* Compare with same_at_start to avoid counting some buffer text
4374 as matching both at the file's beginning and at the end. */
4375 while (bufpos
> 0 && same_at_end
> same_at_start
4376 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4377 same_at_end
--, bufpos
--;
4379 /* Extend the end of non-matching text area to multibyte
4380 character boundary. */
4381 if (! NILP (current_buffer
->enable_multibyte_characters
))
4382 while (same_at_end
< ZV_BYTE
4383 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4386 /* Don't try to reuse the same piece of text twice. */
4387 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4389 same_at_end
+= overlap
;
4391 /* If display currently starts at beginning of line,
4392 keep it that way. */
4393 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4394 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4396 /* Replace the chars that we need to replace,
4397 and update INSERTED to equal the number of bytes
4398 we are taking from the file. */
4399 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4401 if (same_at_end
!= same_at_start
)
4403 del_range_byte (same_at_start
, same_at_end
, 0);
4405 same_at_start
= GPT_BYTE
;
4409 temp
= BYTE_TO_CHAR (same_at_start
);
4411 /* Insert from the file at the proper position. */
4412 SET_PT_BOTH (temp
, same_at_start
);
4413 insert_1 (conversion_buffer
+ same_at_start
- BEGV_BYTE
, inserted
,
4415 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4416 coding_restore_composition (&coding
, Fcurrent_buffer ());
4417 coding_free_composition_data (&coding
);
4419 /* Set `inserted' to the number of inserted characters. */
4420 inserted
= PT
- temp
;
4422 xfree (conversion_buffer
);
4431 register Lisp_Object temp
;
4433 total
= XINT (end
) - XINT (beg
);
4435 /* Make sure point-max won't overflow after this insertion. */
4436 XSETINT (temp
, total
);
4437 if (total
!= XINT (temp
))
4438 error ("Maximum buffer size exceeded");
4441 /* For a special file, all we can do is guess. */
4442 total
= READ_BUF_SIZE
;
4444 if (NILP (visit
) && inserted
> 0)
4446 #ifdef CLASH_DETECTION
4447 if (!NILP (current_buffer
->file_truename
)
4448 /* Make binding buffer-file-name to nil effective. */
4449 && !NILP (current_buffer
->filename
)
4450 && SAVE_MODIFF
>= MODIFF
)
4452 #endif /* CLASH_DETECTION */
4453 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
4457 if (GAP_SIZE
< total
)
4458 make_gap (total
- GAP_SIZE
);
4460 if (XINT (beg
) != 0 || !NILP (replace
))
4462 if (lseek (fd
, XINT (beg
), 0) < 0)
4463 report_file_error ("Setting file position",
4464 Fcons (orig_filename
, Qnil
));
4467 /* In the following loop, HOW_MUCH contains the total bytes read so
4468 far for a regular file, and not changed for a special file. But,
4469 before exiting the loop, it is set to a negative value if I/O
4473 /* Total bytes inserted. */
4476 /* Here, we don't do code conversion in the loop. It is done by
4477 code_convert_region after all data are read into the buffer. */
4479 int gap_size
= GAP_SIZE
;
4481 while (how_much
< total
)
4483 /* try is reserved in some compilers (Microsoft C) */
4484 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4491 /* Maybe make more room. */
4492 if (gap_size
< trytry
)
4494 make_gap (total
- gap_size
);
4495 gap_size
= GAP_SIZE
;
4498 /* Read from the file, capturing `quit'. When an
4499 error occurs, end the loop, and arrange for a quit
4500 to be signaled after decoding the text we read. */
4501 non_regular_fd
= fd
;
4502 non_regular_inserted
= inserted
;
4503 non_regular_nbytes
= trytry
;
4504 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4505 read_non_regular_quit
);
4516 /* Allow quitting out of the actual I/O. We don't make text
4517 part of the buffer until all the reading is done, so a C-g
4518 here doesn't do any harm. */
4521 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4533 /* For a regular file, where TOTAL is the real size,
4534 count HOW_MUCH to compare with it.
4535 For a special file, where TOTAL is just a buffer size,
4536 so don't bother counting in HOW_MUCH.
4537 (INSERTED is where we count the number of characters inserted.) */
4544 /* Now we have read all the file data into the gap.
4545 If it was empty, undo marking the buffer modified. */
4549 #ifdef CLASH_DETECTION
4551 unlock_file (current_buffer
->file_truename
);
4553 Vdeactivate_mark
= old_Vdeactivate_mark
;
4556 /* Make the text read part of the buffer. */
4557 GAP_SIZE
-= inserted
;
4559 GPT_BYTE
+= inserted
;
4561 ZV_BYTE
+= inserted
;
4566 /* Put an anchor to ensure multi-byte form ends at gap. */
4571 /* Discard the unwind protect for closing the file. */
4575 error ("IO error reading %s: %s",
4576 SDATA (orig_filename
), emacs_strerror (errno
));
4580 if (! coding_system_decided
)
4582 /* The coding system is not yet decided. Decide it by an
4583 optimized method for handling `coding:' tag.
4585 Note that we can get here only if the buffer was empty
4586 before the insertion. */
4590 if (!NILP (Vcoding_system_for_read
))
4591 val
= Vcoding_system_for_read
;
4594 /* Since we are sure that the current buffer was empty
4595 before the insertion, we can toggle
4596 enable-multibyte-characters directly here without taking
4597 care of marker adjustment and byte combining problem. By
4598 this way, we can run Lisp program safely before decoding
4599 the inserted text. */
4600 Lisp_Object unwind_data
;
4601 int count
= SPECPDL_INDEX ();
4603 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4604 Fcons (current_buffer
->undo_list
,
4605 Fcurrent_buffer ()));
4606 current_buffer
->enable_multibyte_characters
= Qnil
;
4607 current_buffer
->undo_list
= Qt
;
4608 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4610 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4612 val
= call2 (Vset_auto_coding_function
,
4613 filename
, make_number (inserted
));
4618 /* If the coding system is not yet decided, check
4619 file-coding-system-alist. */
4620 Lisp_Object args
[6], coding_systems
;
4622 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4623 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4624 coding_systems
= Ffind_operation_coding_system (6, args
);
4625 if (CONSP (coding_systems
))
4626 val
= XCAR (coding_systems
);
4628 unbind_to (count
, Qnil
);
4629 inserted
= Z_BYTE
- BEG_BYTE
;
4632 /* The following kludgy code is to avoid some compiler bug.
4634 setup_coding_system (val, &coding);
4637 struct coding_system temp_coding
;
4638 setup_coding_system (Fcheck_coding_system (val
), &temp_coding
);
4639 bcopy (&temp_coding
, &coding
, sizeof coding
);
4641 /* Ensure we set Vlast_coding_system_used. */
4642 set_coding_system
= 1;
4644 if (NILP (current_buffer
->enable_multibyte_characters
)
4646 /* We must suppress all character code conversion except for
4647 end-of-line conversion. */
4648 setup_raw_text_coding_system (&coding
);
4649 coding
.src_multibyte
= 0;
4650 coding
.dst_multibyte
4651 = !NILP (current_buffer
->enable_multibyte_characters
);
4655 /* Can't do this if part of the buffer might be preserved. */
4657 && (coding
.type
== coding_type_no_conversion
4658 || coding
.type
== coding_type_raw_text
))
4660 /* Visiting a file with these coding system makes the buffer
4662 current_buffer
->enable_multibyte_characters
= Qnil
;
4663 coding
.dst_multibyte
= 0;
4666 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4668 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4670 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4672 inserted
= coding
.produced_char
;
4675 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4679 /* Now INSERTED is measured in characters. */
4682 /* Use the conversion type to determine buffer-file-type
4683 (find-buffer-file-type is now used to help determine the
4685 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4686 || coding
.eol_type
== CODING_EOL_LF
)
4687 && ! CODING_REQUIRE_DECODING (&coding
))
4688 current_buffer
->buffer_file_type
= Qt
;
4690 current_buffer
->buffer_file_type
= Qnil
;
4697 if (!EQ (current_buffer
->undo_list
, Qt
))
4698 current_buffer
->undo_list
= Qnil
;
4700 stat (SDATA (filename
), &st
);
4705 current_buffer
->modtime
= st
.st_mtime
;
4706 current_buffer
->filename
= orig_filename
;
4709 SAVE_MODIFF
= MODIFF
;
4710 current_buffer
->auto_save_modified
= MODIFF
;
4711 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4712 #ifdef CLASH_DETECTION
4715 if (!NILP (current_buffer
->file_truename
))
4716 unlock_file (current_buffer
->file_truename
);
4717 unlock_file (filename
);
4719 #endif /* CLASH_DETECTION */
4721 Fsignal (Qfile_error
,
4722 Fcons (build_string ("not a regular file"),
4723 Fcons (orig_filename
, Qnil
)));
4726 if (set_coding_system
)
4727 Vlast_coding_system_used
= coding
.symbol
;
4729 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4731 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4733 if (! NILP (insval
))
4735 CHECK_NUMBER (insval
);
4736 inserted
= XFASTINT (insval
);
4740 /* Decode file format */
4743 int empty_undo_list_p
= 0;
4745 /* If we're anyway going to discard undo information, don't
4746 record it in the first place. The buffer's undo list at this
4747 point is either nil or t when visiting a file. */
4750 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4751 current_buffer
->undo_list
= Qt
;
4754 insval
= call3 (Qformat_decode
,
4755 Qnil
, make_number (inserted
), visit
);
4756 CHECK_NUMBER (insval
);
4757 inserted
= XFASTINT (insval
);
4760 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4763 /* Call after-change hooks for the inserted text, aside from the case
4764 of normal visiting (not with REPLACE), which is done in a new buffer
4765 "before" the buffer is changed. */
4766 if (inserted
> 0 && total
> 0
4767 && (NILP (visit
) || !NILP (replace
)))
4769 signal_after_change (PT
, 0, inserted
);
4770 update_compositions (PT
, PT
, CHECK_BORDER
);
4773 p
= Vafter_insert_file_functions
;
4776 insval
= call1 (XCAR (p
), make_number (inserted
));
4779 CHECK_NUMBER (insval
);
4780 inserted
= XFASTINT (insval
);
4787 && current_buffer
->modtime
== -1)
4789 /* If visiting nonexistent file, return nil. */
4790 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4794 Fsignal (Qquit
, Qnil
);
4796 /* ??? Retval needs to be dealt with in all cases consistently. */
4798 val
= Fcons (orig_filename
,
4799 Fcons (make_number (inserted
),
4802 RETURN_UNGCPRO (unbind_to (count
, val
));
4805 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4806 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4807 Lisp_Object
, Lisp_Object
));
4809 /* If build_annotations switched buffers, switch back to BUF.
4810 Kill the temporary buffer that was selected in the meantime.
4812 Since this kill only the last temporary buffer, some buffers remain
4813 not killed if build_annotations switched buffers more than once.
4817 build_annotations_unwind (buf
)
4822 if (XBUFFER (buf
) == current_buffer
)
4824 tembuf
= Fcurrent_buffer ();
4826 Fkill_buffer (tembuf
);
4830 /* Decide the coding-system to encode the data with. */
4833 choose_write_coding_system (start
, end
, filename
,
4834 append
, visit
, lockname
, coding
)
4835 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4836 struct coding_system
*coding
;
4841 && NILP (Fstring_equal (current_buffer
->filename
,
4842 current_buffer
->auto_save_file_name
)))
4844 /* We use emacs-mule for auto saving... */
4845 setup_coding_system (Qemacs_mule
, coding
);
4846 /* ... but with the special flag to indicate not to strip off
4847 leading code of eight-bit-control chars. */
4849 goto done_setup_coding
;
4851 else if (!NILP (Vcoding_system_for_write
))
4853 val
= Vcoding_system_for_write
;
4854 if (coding_system_require_warning
4855 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4856 /* Confirm that VAL can surely encode the current region. */
4857 val
= call5 (Vselect_safe_coding_system_function
,
4858 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4863 /* If the variable `buffer-file-coding-system' is set locally,
4864 it means that the file was read with some kind of code
4865 conversion or the variable is explicitly set by users. We
4866 had better write it out with the same coding system even if
4867 `enable-multibyte-characters' is nil.
4869 If it is not set locally, we anyway have to convert EOL
4870 format if the default value of `buffer-file-coding-system'
4871 tells that it is not Unix-like (LF only) format. */
4872 int using_default_coding
= 0;
4873 int force_raw_text
= 0;
4875 val
= current_buffer
->buffer_file_coding_system
;
4877 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4880 if (NILP (current_buffer
->enable_multibyte_characters
))
4886 /* Check file-coding-system-alist. */
4887 Lisp_Object args
[7], coding_systems
;
4889 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4890 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4892 coding_systems
= Ffind_operation_coding_system (7, args
);
4893 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4894 val
= XCDR (coding_systems
);
4898 && !NILP (current_buffer
->buffer_file_coding_system
))
4900 /* If we still have not decided a coding system, use the
4901 default value of buffer-file-coding-system. */
4902 val
= current_buffer
->buffer_file_coding_system
;
4903 using_default_coding
= 1;
4907 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4908 /* Confirm that VAL can surely encode the current region. */
4909 val
= call5 (Vselect_safe_coding_system_function
,
4910 start
, end
, val
, Qnil
, filename
);
4912 setup_coding_system (Fcheck_coding_system (val
), coding
);
4913 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4914 && !using_default_coding
)
4916 if (! EQ (default_buffer_file_coding
.symbol
,
4917 buffer_defaults
.buffer_file_coding_system
))
4918 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4919 &default_buffer_file_coding
);
4920 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4922 Lisp_Object subsidiaries
;
4924 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4925 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4926 if (VECTORP (subsidiaries
)
4927 && XVECTOR (subsidiaries
)->size
== 3)
4929 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4934 setup_raw_text_coding_system (coding
);
4935 goto done_setup_coding
;
4938 setup_coding_system (Fcheck_coding_system (val
), coding
);
4941 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4942 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4945 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4946 "r\nFWrite region to file: \ni\ni\ni\np",
4947 doc
: /* Write current region into specified file.
4948 When called from a program, requires three arguments:
4949 START, END and FILENAME. START and END are normally buffer positions
4950 specifying the part of the buffer to write.
4951 If START is nil, that means to use the entire buffer contents.
4952 If START is a string, then output that string to the file
4953 instead of any buffer contents; END is ignored.
4955 Optional fourth argument APPEND if non-nil means
4956 append to existing file contents (if any). If it is an integer,
4957 seek to that offset in the file before writing.
4958 Optional fifth argument VISIT, if t or a string, means
4959 set the last-save-file-modtime of buffer to this file's modtime
4960 and mark buffer not modified.
4961 If VISIT is a string, it is a second file name;
4962 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4963 VISIT is also the file name to lock and unlock for clash detection.
4964 If VISIT is neither t nor nil nor a string,
4965 that means do not display the \"Wrote file\" message.
4966 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4967 use for locking and unlocking, overriding FILENAME and VISIT.
4968 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4969 for an existing file with the same name. If MUSTBENEW is `excl',
4970 that means to get an error if the file already exists; never overwrite.
4971 If MUSTBENEW is neither nil nor `excl', that means ask for
4972 confirmation before overwriting, but do go ahead and overwrite the file
4973 if the user confirms.
4975 This does code conversion according to the value of
4976 `coding-system-for-write', `buffer-file-coding-system', or
4977 `file-coding-system-alist', and sets the variable
4978 `last-coding-system-used' to the coding system actually used. */)
4979 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4980 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4985 const unsigned char *fn
;
4988 int count
= SPECPDL_INDEX ();
4991 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4993 Lisp_Object handler
;
4994 Lisp_Object visit_file
;
4995 Lisp_Object annotations
;
4996 Lisp_Object encoded_filename
;
4997 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4998 int quietly
= !NILP (visit
);
4999 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5000 struct buffer
*given_buffer
;
5002 int buffer_file_type
= O_BINARY
;
5004 struct coding_system coding
;
5006 if (current_buffer
->base_buffer
&& visiting
)
5007 error ("Cannot do file visiting in an indirect buffer");
5009 if (!NILP (start
) && !STRINGP (start
))
5010 validate_region (&start
, &end
);
5012 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
5014 filename
= Fexpand_file_name (filename
, Qnil
);
5016 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
5017 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
5019 if (STRINGP (visit
))
5020 visit_file
= Fexpand_file_name (visit
, Qnil
);
5022 visit_file
= filename
;
5024 if (NILP (lockname
))
5025 lockname
= visit_file
;
5029 /* If the file name has special constructs in it,
5030 call the corresponding file handler. */
5031 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
5032 /* If FILENAME has no handler, see if VISIT has one. */
5033 if (NILP (handler
) && STRINGP (visit
))
5034 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
5036 if (!NILP (handler
))
5039 val
= call6 (handler
, Qwrite_region
, start
, end
,
5040 filename
, append
, visit
);
5044 SAVE_MODIFF
= MODIFF
;
5045 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5046 current_buffer
->filename
= visit_file
;
5052 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
5054 /* Special kludge to simplify auto-saving. */
5057 XSETFASTINT (start
, BEG
);
5058 XSETFASTINT (end
, Z
);
5062 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
5063 count1
= SPECPDL_INDEX ();
5065 given_buffer
= current_buffer
;
5067 if (!STRINGP (start
))
5069 annotations
= build_annotations (start
, end
);
5071 if (current_buffer
!= given_buffer
)
5073 XSETFASTINT (start
, BEGV
);
5074 XSETFASTINT (end
, ZV
);
5080 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
5082 /* Decide the coding-system to encode the data with.
5083 We used to make this choice before calling build_annotations, but that
5084 leads to problems when a write-annotate-function takes care of
5085 unsavable chars (as was the case with X-Symbol). */
5086 choose_write_coding_system (start
, end
, filename
,
5087 append
, visit
, lockname
, &coding
);
5088 Vlast_coding_system_used
= coding
.symbol
;
5090 given_buffer
= current_buffer
;
5091 if (! STRINGP (start
))
5093 annotations
= build_annotations_2 (start
, end
,
5094 coding
.pre_write_conversion
, annotations
);
5095 if (current_buffer
!= given_buffer
)
5097 XSETFASTINT (start
, BEGV
);
5098 XSETFASTINT (end
, ZV
);
5102 #ifdef CLASH_DETECTION
5105 #if 0 /* This causes trouble for GNUS. */
5106 /* If we've locked this file for some other buffer,
5107 query before proceeding. */
5108 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5109 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5112 lock_file (lockname
);
5114 #endif /* CLASH_DETECTION */
5116 encoded_filename
= ENCODE_FILE (filename
);
5118 fn
= SDATA (encoded_filename
);
5122 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5123 #else /* not DOS_NT */
5124 desc
= emacs_open (fn
, O_WRONLY
, 0);
5125 #endif /* not DOS_NT */
5127 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5129 if (auto_saving
) /* Overwrite any previous version of autosave file */
5131 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5132 desc
= emacs_open (fn
, O_RDWR
, 0);
5134 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5135 ? SDATA (current_buffer
->filename
) : 0,
5138 else /* Write to temporary name and rename if no errors */
5140 Lisp_Object temp_name
;
5141 temp_name
= Ffile_name_directory (filename
);
5143 if (!NILP (temp_name
))
5145 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5146 build_string ("$$SAVE$$")));
5147 fname
= SDATA (filename
);
5148 fn
= SDATA (temp_name
);
5149 desc
= creat_copy_attrs (fname
, fn
);
5152 /* If we can't open the temporary file, try creating a new
5153 version of the original file. VMS "creat" creates a
5154 new version rather than truncating an existing file. */
5157 desc
= creat (fn
, 0666);
5158 #if 0 /* This can clobber an existing file and fail to replace it,
5159 if the user runs out of space. */
5162 /* We can't make a new version;
5163 try to truncate and rewrite existing version if any. */
5165 desc
= emacs_open (fn
, O_RDWR
, 0);
5171 desc
= creat (fn
, 0666);
5175 desc
= emacs_open (fn
,
5176 O_WRONLY
| O_CREAT
| buffer_file_type
5177 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5178 S_IREAD
| S_IWRITE
);
5179 #else /* not DOS_NT */
5180 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5181 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5182 auto_saving
? auto_save_mode_bits
: 0666);
5183 #endif /* not DOS_NT */
5184 #endif /* not VMS */
5188 #ifdef CLASH_DETECTION
5190 if (!auto_saving
) unlock_file (lockname
);
5192 #endif /* CLASH_DETECTION */
5194 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5197 record_unwind_protect (close_file_unwind
, make_number (desc
));
5199 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5203 if (NUMBERP (append
))
5204 ret
= lseek (desc
, XINT (append
), 1);
5206 ret
= lseek (desc
, 0, 2);
5209 #ifdef CLASH_DETECTION
5210 if (!auto_saving
) unlock_file (lockname
);
5211 #endif /* CLASH_DETECTION */
5213 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5221 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5222 * if we do writes that don't end with a carriage return. Furthermore
5223 * it cannot handle writes of more then 16K. The modified
5224 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5225 * this EXCEPT for the last record (iff it doesn't end with a carriage
5226 * return). This implies that if your buffer doesn't end with a carriage
5227 * return, you get one free... tough. However it also means that if
5228 * we make two calls to sys_write (a la the following code) you can
5229 * get one at the gap as well. The easiest way to fix this (honest)
5230 * is to move the gap to the next newline (or the end of the buffer).
5235 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5236 move_gap (find_next_newline (GPT
, 1));
5238 /* Whether VMS or not, we must move the gap to the next of newline
5239 when we must put designation sequences at beginning of line. */
5240 if (INTEGERP (start
)
5241 && coding
.type
== coding_type_iso2022
5242 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5243 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5245 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5246 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5247 move_gap_both (PT
, PT_BYTE
);
5248 SET_PT_BOTH (opoint
, opoint_byte
);
5255 if (STRINGP (start
))
5257 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5258 &annotations
, &coding
);
5261 else if (XINT (start
) != XINT (end
))
5263 tem
= CHAR_TO_BYTE (XINT (start
));
5265 if (XINT (start
) < GPT
)
5267 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5268 min (GPT
, XINT (end
)) - XINT (start
),
5269 &annotations
, &coding
);
5273 if (XINT (end
) > GPT
&& !failure
)
5275 tem
= max (XINT (start
), GPT
);
5276 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5277 &annotations
, &coding
);
5283 /* If file was empty, still need to write the annotations */
5284 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5285 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5289 if (CODING_REQUIRE_FLUSHING (&coding
)
5290 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5293 /* We have to flush out a data. */
5294 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5295 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5302 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5303 Disk full in NFS may be reported here. */
5304 /* mib says that closing the file will try to write as fast as NFS can do
5305 it, and that means the fsync here is not crucial for autosave files. */
5306 if (!auto_saving
&& !write_region_inhibit_fsync
&& fsync (desc
) < 0)
5308 /* If fsync fails with EINTR, don't treat that as serious. */
5310 failure
= 1, save_errno
= errno
;
5314 /* Spurious "file has changed on disk" warnings have been
5315 observed on Suns as well.
5316 It seems that `close' can change the modtime, under nfs.
5318 (This has supposedly been fixed in Sunos 4,
5319 but who knows about all the other machines with NFS?) */
5322 /* On VMS and APOLLO, must do the stat after the close
5323 since closing changes the modtime. */
5326 /* Recall that #if defined does not work on VMS. */
5333 /* NFS can report a write failure now. */
5334 if (emacs_close (desc
) < 0)
5335 failure
= 1, save_errno
= errno
;
5338 /* If we wrote to a temporary name and had no errors, rename to real name. */
5342 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5350 /* Discard the unwind protect for close_file_unwind. */
5351 specpdl_ptr
= specpdl
+ count1
;
5352 /* Restore the original current buffer. */
5353 visit_file
= unbind_to (count
, visit_file
);
5355 #ifdef CLASH_DETECTION
5357 unlock_file (lockname
);
5358 #endif /* CLASH_DETECTION */
5360 /* Do this before reporting IO error
5361 to avoid a "file has changed on disk" warning on
5362 next attempt to save. */
5364 current_buffer
->modtime
= st
.st_mtime
;
5367 error ("IO error writing %s: %s", SDATA (filename
),
5368 emacs_strerror (save_errno
));
5372 SAVE_MODIFF
= MODIFF
;
5373 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5374 current_buffer
->filename
= visit_file
;
5375 update_mode_lines
++;
5380 && ! NILP (Fstring_equal (current_buffer
->filename
,
5381 current_buffer
->auto_save_file_name
)))
5382 SAVE_MODIFF
= MODIFF
;
5388 message_with_string ((INTEGERP (append
)
5398 Lisp_Object
merge ();
5400 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5401 doc
: /* Return t if (car A) is numerically less than (car B). */)
5405 return Flss (Fcar (a
), Fcar (b
));
5408 /* Build the complete list of annotations appropriate for writing out
5409 the text between START and END, by calling all the functions in
5410 write-region-annotate-functions and merging the lists they return.
5411 If one of these functions switches to a different buffer, we assume
5412 that buffer contains altered text. Therefore, the caller must
5413 make sure to restore the current buffer in all cases,
5414 as save-excursion would do. */
5417 build_annotations (start
, end
)
5418 Lisp_Object start
, end
;
5420 Lisp_Object annotations
;
5422 struct gcpro gcpro1
, gcpro2
;
5423 Lisp_Object original_buffer
;
5424 int i
, used_global
= 0;
5426 XSETBUFFER (original_buffer
, current_buffer
);
5429 p
= Vwrite_region_annotate_functions
;
5430 GCPRO2 (annotations
, p
);
5433 struct buffer
*given_buffer
= current_buffer
;
5434 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5435 { /* Use the global value of the hook. */
5438 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5440 p
= Fappend (2, arg
);
5443 Vwrite_region_annotations_so_far
= annotations
;
5444 res
= call2 (XCAR (p
), start
, end
);
5445 /* If the function makes a different buffer current,
5446 assume that means this buffer contains altered text to be output.
5447 Reset START and END from the buffer bounds
5448 and discard all previous annotations because they should have
5449 been dealt with by this function. */
5450 if (current_buffer
!= given_buffer
)
5452 XSETFASTINT (start
, BEGV
);
5453 XSETFASTINT (end
, ZV
);
5456 Flength (res
); /* Check basic validity of return value */
5457 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5461 /* Now do the same for annotation functions implied by the file-format */
5462 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
5463 p
= current_buffer
->auto_save_file_format
;
5465 p
= current_buffer
->file_format
;
5466 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5468 struct buffer
*given_buffer
= current_buffer
;
5470 Vwrite_region_annotations_so_far
= annotations
;
5472 /* Value is either a list of annotations or nil if the function
5473 has written annotations to a temporary buffer, which is now
5475 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5476 original_buffer
, make_number (i
));
5477 if (current_buffer
!= given_buffer
)
5479 XSETFASTINT (start
, BEGV
);
5480 XSETFASTINT (end
, ZV
);
5485 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5493 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5494 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5496 struct gcpro gcpro1
;
5499 GCPRO1 (annotations
);
5500 /* At last, do the same for the function PRE_WRITE_CONVERSION
5501 implied by the current coding-system. */
5502 if (!NILP (pre_write_conversion
))
5504 struct buffer
*given_buffer
= current_buffer
;
5505 Vwrite_region_annotations_so_far
= annotations
;
5506 res
= call2 (pre_write_conversion
, start
, end
);
5508 annotations
= (current_buffer
!= given_buffer
5510 : merge (annotations
, res
, Qcar_less_than_car
));
5517 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5518 If STRING is nil, POS is the character position in the current buffer.
5519 Intersperse with them the annotations from *ANNOT
5520 which fall within the range of POS to POS + NCHARS,
5521 each at its appropriate position.
5523 We modify *ANNOT by discarding elements as we use them up.
5525 The return value is negative in case of system call failure. */
5528 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5531 register int nchars
;
5534 struct coding_system
*coding
;
5538 int lastpos
= pos
+ nchars
;
5540 while (NILP (*annot
) || CONSP (*annot
))
5542 tem
= Fcar_safe (Fcar (*annot
));
5545 nextpos
= XFASTINT (tem
);
5547 /* If there are no more annotations in this range,
5548 output the rest of the range all at once. */
5549 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5550 return e_write (desc
, string
, pos
, lastpos
, coding
);
5552 /* Output buffer text up to the next annotation's position. */
5555 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5559 /* Output the annotation. */
5560 tem
= Fcdr (Fcar (*annot
));
5563 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5566 *annot
= Fcdr (*annot
);
5571 #ifndef WRITE_BUF_SIZE
5572 #define WRITE_BUF_SIZE (16 * 1024)
5575 /* Write text in the range START and END into descriptor DESC,
5576 encoding them with coding system CODING. If STRING is nil, START
5577 and END are character positions of the current buffer, else they
5578 are indexes to the string STRING. */
5581 e_write (desc
, string
, start
, end
, coding
)
5585 struct coding_system
*coding
;
5587 register char *addr
;
5588 register int nbytes
;
5589 char buf
[WRITE_BUF_SIZE
];
5593 coding
->composing
= COMPOSITION_DISABLED
;
5594 if (coding
->composing
!= COMPOSITION_DISABLED
)
5595 coding_save_composition (coding
, start
, end
, string
);
5597 if (STRINGP (string
))
5599 addr
= SDATA (string
);
5600 nbytes
= SBYTES (string
);
5601 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5603 else if (start
< end
)
5605 /* It is assured that the gap is not in the range START and END-1. */
5606 addr
= CHAR_POS_ADDR (start
);
5607 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5608 coding
->src_multibyte
5609 = !NILP (current_buffer
->enable_multibyte_characters
);
5615 coding
->src_multibyte
= 1;
5618 /* We used to have a code for handling selective display here. But,
5619 now it is handled within encode_coding. */
5624 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5625 if (coding
->produced
> 0)
5627 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5628 if (coding
->produced
)
5634 nbytes
-= coding
->consumed
;
5635 addr
+= coding
->consumed
;
5636 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5639 /* The source text ends by an incomplete multibyte form.
5640 There's no way other than write it out as is. */
5641 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5650 start
+= coding
->consumed_char
;
5651 if (coding
->cmp_data
)
5652 coding_adjust_composition_offset (coding
, start
);
5655 if (coding
->cmp_data
)
5656 coding_free_composition_data (coding
);
5661 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5662 Sverify_visited_file_modtime
, 1, 1, 0,
5663 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5664 This means that the file has not been changed since it was visited or saved.
5665 See Info node `(elisp)Modification Time' for more details. */)
5671 Lisp_Object handler
;
5672 Lisp_Object filename
;
5677 if (!STRINGP (b
->filename
)) return Qt
;
5678 if (b
->modtime
== 0) return Qt
;
5680 /* If the file name has special constructs in it,
5681 call the corresponding file handler. */
5682 handler
= Ffind_file_name_handler (b
->filename
,
5683 Qverify_visited_file_modtime
);
5684 if (!NILP (handler
))
5685 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5687 filename
= ENCODE_FILE (b
->filename
);
5689 if (stat (SDATA (filename
), &st
) < 0)
5691 /* If the file doesn't exist now and didn't exist before,
5692 we say that it isn't modified, provided the error is a tame one. */
5693 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5698 if (st
.st_mtime
== b
->modtime
5699 /* If both are positive, accept them if they are off by one second. */
5700 || (st
.st_mtime
> 0 && b
->modtime
> 0
5701 && (st
.st_mtime
== b
->modtime
+ 1
5702 || st
.st_mtime
== b
->modtime
- 1)))
5707 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5708 Sclear_visited_file_modtime
, 0, 0, 0,
5709 doc
: /* Clear out records of last mod time of visited file.
5710 Next attempt to save will certainly not complain of a discrepancy. */)
5713 current_buffer
->modtime
= 0;
5717 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5718 Svisited_file_modtime
, 0, 0, 0,
5719 doc
: /* Return the current buffer's recorded visited file modification time.
5720 The value is a list of the form (HIGH LOW), like the time values
5721 that `file-attributes' returns. If the current buffer has no recorded
5722 file modification time, this function returns 0.
5723 See Info node `(elisp)Modification Time' for more details. */)
5727 tcons
= long_to_cons ((unsigned long) current_buffer
->modtime
);
5729 return list2 (XCAR (tcons
), XCDR (tcons
));
5733 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5734 Sset_visited_file_modtime
, 0, 1, 0,
5735 doc
: /* Update buffer's recorded modification time from the visited file's time.
5736 Useful if the buffer was not read from the file normally
5737 or if the file itself has been changed for some known benign reason.
5738 An argument specifies the modification time value to use
5739 \(instead of that of the visited file), in the form of a list
5740 \(HIGH . LOW) or (HIGH LOW). */)
5742 Lisp_Object time_list
;
5744 if (!NILP (time_list
))
5745 current_buffer
->modtime
= cons_to_long (time_list
);
5748 register Lisp_Object filename
;
5750 Lisp_Object handler
;
5752 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5754 /* If the file name has special constructs in it,
5755 call the corresponding file handler. */
5756 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5757 if (!NILP (handler
))
5758 /* The handler can find the file name the same way we did. */
5759 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5761 filename
= ENCODE_FILE (filename
);
5763 if (stat (SDATA (filename
), &st
) >= 0)
5764 current_buffer
->modtime
= st
.st_mtime
;
5771 auto_save_error (error
)
5774 Lisp_Object args
[3], msg
;
5776 struct gcpro gcpro1
;
5782 args
[0] = build_string ("Auto-saving %s: %s");
5783 args
[1] = current_buffer
->name
;
5784 args
[2] = Ferror_message_string (error
);
5785 msg
= Fformat (3, args
);
5787 nbytes
= SBYTES (msg
);
5788 SAFE_ALLOCA (msgbuf
, char *, nbytes
);
5789 bcopy (SDATA (msg
), msgbuf
, nbytes
);
5791 for (i
= 0; i
< 3; ++i
)
5794 message2 (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5796 message2_nolog (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5797 Fsleep_for (make_number (1), Qnil
);
5811 auto_save_mode_bits
= 0666;
5813 /* Get visited file's mode to become the auto save file's mode. */
5814 if (! NILP (current_buffer
->filename
))
5816 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5817 /* But make sure we can overwrite it later! */
5818 auto_save_mode_bits
= st
.st_mode
| 0600;
5819 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5821 /* Remote files don't cooperate with stat. */
5822 auto_save_mode_bits
= XINT (modes
) | 0600;
5826 Fwrite_region (Qnil
, Qnil
,
5827 current_buffer
->auto_save_file_name
,
5828 Qnil
, Qlambda
, Qnil
, Qnil
);
5832 do_auto_save_unwind (arg
) /* used as unwind-protect function */
5835 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
5843 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5846 minibuffer_auto_raise
= XINT (value
);
5851 do_auto_save_make_dir (dir
)
5854 return call2 (Qmake_directory
, dir
, Qt
);
5858 do_auto_save_eh (ignore
)
5864 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5865 doc
: /* Auto-save all buffers that need it.
5866 This is all buffers that have auto-saving enabled
5867 and are changed since last auto-saved.
5868 Auto-saving writes the buffer into a file
5869 so that your editing is not lost if the system crashes.
5870 This file is not the file you visited; that changes only when you save.
5871 Normally we run the normal hook `auto-save-hook' before saving.
5873 A non-nil NO-MESSAGE argument means do not print any message if successful.
5874 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5875 (no_message
, current_only
)
5876 Lisp_Object no_message
, current_only
;
5878 struct buffer
*old
= current_buffer
, *b
;
5879 Lisp_Object tail
, buf
;
5881 int do_handled_files
;
5883 FILE *stream
= NULL
;
5884 int count
= SPECPDL_INDEX ();
5885 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5886 int old_message_p
= 0;
5887 struct gcpro gcpro1
, gcpro2
;
5889 if (max_specpdl_size
< specpdl_size
+ 40)
5890 max_specpdl_size
= specpdl_size
+ 40;
5895 if (NILP (no_message
))
5897 old_message_p
= push_message ();
5898 record_unwind_protect (pop_message_unwind
, Qnil
);
5901 /* Ordinarily don't quit within this function,
5902 but don't make it impossible to quit (in case we get hung in I/O). */
5906 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5907 point to non-strings reached from Vbuffer_alist. */
5909 if (!NILP (Vrun_hooks
))
5910 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5912 if (STRINGP (Vauto_save_list_file_name
))
5914 Lisp_Object listfile
;
5916 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5918 /* Don't try to create the directory when shutting down Emacs,
5919 because creating the directory might signal an error, and
5920 that would leave Emacs in a strange state. */
5921 if (!NILP (Vrun_hooks
))
5925 GCPRO2 (dir
, listfile
);
5926 dir
= Ffile_name_directory (listfile
);
5927 if (NILP (Ffile_directory_p (dir
)))
5928 internal_condition_case_1 (do_auto_save_make_dir
,
5929 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5934 stream
= fopen (SDATA (listfile
), "w");
5937 record_unwind_protect (do_auto_save_unwind
,
5938 make_save_value (stream
, 0));
5939 record_unwind_protect (do_auto_save_unwind_1
,
5940 make_number (minibuffer_auto_raise
));
5941 minibuffer_auto_raise
= 0;
5944 /* On first pass, save all files that don't have handlers.
5945 On second pass, save all files that do have handlers.
5947 If Emacs is crashing, the handlers may tweak what is causing
5948 Emacs to crash in the first place, and it would be a shame if
5949 Emacs failed to autosave perfectly ordinary files because it
5950 couldn't handle some ange-ftp'd file. */
5952 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5953 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5955 buf
= XCDR (XCAR (tail
));
5958 /* Record all the buffers that have auto save mode
5959 in the special file that lists them. For each of these buffers,
5960 Record visited name (if any) and auto save name. */
5961 if (STRINGP (b
->auto_save_file_name
)
5962 && 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
);
5975 if (!NILP (current_only
)
5976 && b
!= current_buffer
)
5979 /* Don't auto-save indirect buffers.
5980 The base buffer takes care of it. */
5984 /* Check for auto save enabled
5985 and file changed since last auto save
5986 and file changed since last real save. */
5987 if (STRINGP (b
->auto_save_file_name
)
5988 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5989 && b
->auto_save_modified
< BUF_MODIFF (b
)
5990 /* -1 means we've turned off autosaving for a while--see below. */
5991 && XINT (b
->save_length
) >= 0
5992 && (do_handled_files
5993 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5996 EMACS_TIME before_time
, after_time
;
5998 EMACS_GET_TIME (before_time
);
6000 /* If we had a failure, don't try again for 20 minutes. */
6001 if (b
->auto_save_failure_time
>= 0
6002 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
6005 if ((XFASTINT (b
->save_length
) * 10
6006 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
6007 /* A short file is likely to change a large fraction;
6008 spare the user annoying messages. */
6009 && XFASTINT (b
->save_length
) > 5000
6010 /* These messages are frequent and annoying for `*mail*'. */
6011 && !EQ (b
->filename
, Qnil
)
6012 && NILP (no_message
))
6014 /* It has shrunk too much; turn off auto-saving here. */
6015 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
6016 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
6018 minibuffer_auto_raise
= 0;
6019 /* Turn off auto-saving until there's a real save,
6020 and prevent any more warnings. */
6021 XSETINT (b
->save_length
, -1);
6022 Fsleep_for (make_number (1), Qnil
);
6025 set_buffer_internal (b
);
6026 if (!auto_saved
&& NILP (no_message
))
6027 message1 ("Auto-saving...");
6028 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
6030 b
->auto_save_modified
= BUF_MODIFF (b
);
6031 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6032 set_buffer_internal (old
);
6034 EMACS_GET_TIME (after_time
);
6036 /* If auto-save took more than 60 seconds,
6037 assume it was an NFS failure that got a timeout. */
6038 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
6039 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
6043 /* Prevent another auto save till enough input events come in. */
6044 record_auto_save ();
6046 if (auto_saved
&& NILP (no_message
))
6050 /* If we are going to restore an old message,
6051 give time to read ours. */
6052 sit_for (1, 0, 0, 0, 0);
6056 /* If we displayed a message and then restored a state
6057 with no message, leave a "done" message on the screen. */
6058 message1 ("Auto-saving...done");
6063 /* This restores the message-stack status. */
6064 unbind_to (count
, Qnil
);
6068 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
6069 Sset_buffer_auto_saved
, 0, 0, 0,
6070 doc
: /* Mark current buffer as auto-saved with its current text.
6071 No auto-save file will be written until the buffer changes again. */)
6074 current_buffer
->auto_save_modified
= MODIFF
;
6075 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6076 current_buffer
->auto_save_failure_time
= -1;
6080 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
6081 Sclear_buffer_auto_save_failure
, 0, 0, 0,
6082 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
6085 current_buffer
->auto_save_failure_time
= -1;
6089 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6091 doc
: /* Return t if current buffer has been auto-saved recently.
6092 More precisely, if it has been auto-saved since last read from or saved
6093 in the visited file. If the buffer has no visited file,
6094 then any auto-save counts as "recent". */)
6097 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6100 /* Reading and completing file names */
6101 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
6103 /* In the string VAL, change each $ to $$ and return the result. */
6106 double_dollars (val
)
6109 register const unsigned char *old
;
6110 register unsigned char *new;
6114 osize
= SBYTES (val
);
6116 /* Count the number of $ characters. */
6117 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
6118 if (*old
++ == '$') count
++;
6122 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
6125 for (n
= osize
; n
> 0; n
--)
6139 read_file_name_cleanup (arg
)
6142 return (current_buffer
->directory
= arg
);
6145 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
6147 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
6148 (string
, dir
, action
)
6149 Lisp_Object string
, dir
, action
;
6150 /* action is nil for complete, t for return list of completions,
6151 lambda for verify final value */
6153 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
6155 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
6157 CHECK_STRING (string
);
6164 /* No need to protect ACTION--we only compare it with t and nil. */
6165 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6167 if (SCHARS (string
) == 0)
6169 if (EQ (action
, Qlambda
))
6177 orig_string
= string
;
6178 string
= Fsubstitute_in_file_name (string
);
6179 changed
= NILP (Fstring_equal (string
, orig_string
));
6180 name
= Ffile_name_nondirectory (string
);
6181 val
= Ffile_name_directory (string
);
6183 realdir
= Fexpand_file_name (val
, realdir
);
6188 specdir
= Ffile_name_directory (string
);
6189 val
= Ffile_name_completion (name
, realdir
);
6194 return double_dollars (string
);
6198 if (!NILP (specdir
))
6199 val
= concat2 (specdir
, val
);
6201 return double_dollars (val
);
6204 #endif /* not VMS */
6208 if (EQ (action
, Qt
))
6210 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6214 if (NILP (Vread_file_name_predicate
)
6215 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6219 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6221 /* Brute-force speed up for directory checking:
6222 Discard strings which don't end in a slash. */
6223 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6225 Lisp_Object tem
= XCAR (all
);
6227 if (STRINGP (tem
) &&
6228 (len
= SCHARS (tem
), len
> 0) &&
6229 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6230 comp
= Fcons (tem
, comp
);
6236 /* Must do it the hard (and slow) way. */
6237 GCPRO3 (all
, comp
, specdir
);
6238 count
= SPECPDL_INDEX ();
6239 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6240 current_buffer
->directory
= realdir
;
6241 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6242 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
6243 comp
= Fcons (XCAR (all
), comp
);
6244 unbind_to (count
, Qnil
);
6247 return Fnreverse (comp
);
6250 /* Only other case actually used is ACTION = lambda */
6252 /* Supposedly this helps commands such as `cd' that read directory names,
6253 but can someone explain how it helps them? -- RMS */
6254 if (SCHARS (name
) == 0)
6257 string
= Fexpand_file_name (string
, dir
);
6258 if (!NILP (Vread_file_name_predicate
))
6259 return call1 (Vread_file_name_predicate
, string
);
6260 return Ffile_exists_p (string
);
6263 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
6264 Snext_read_file_uses_dialog_p
, 0, 0, 0,
6265 doc
: /* Return t if a call to `read-file-name' will use a dialog.
6266 The return value is only relevant for a call to `read-file-name' that happens
6267 before any other event (mouse or keypress) is handeled. */)
6270 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6271 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6280 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6281 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6282 Value is not expanded---you must call `expand-file-name' yourself.
6283 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6284 the same non-empty string that was inserted by this function.
6285 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6286 except that if INITIAL is specified, that combined with DIR is used.)
6287 If the user exits with an empty minibuffer, this function returns
6288 an empty string. (This can only happen if the user erased the
6289 pre-inserted contents or if `insert-default-directory' is nil.)
6290 Fourth arg MUSTMATCH non-nil means require existing file's name.
6291 Non-nil and non-t means also require confirmation after completion.
6292 Fifth arg INITIAL specifies text to start with.
6293 If optional sixth arg PREDICATE is non-nil, possible completions and
6294 the resulting file name must satisfy (funcall PREDICATE NAME).
6295 DIR should be an absolute directory name. It defaults to the value of
6296 `default-directory'.
6298 If this command was invoked with the mouse, use a file dialog box if
6299 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6300 provides a file dialog box.
6302 See also `read-file-name-completion-ignore-case'
6303 and `read-file-name-function'. */)
6304 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6305 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6307 Lisp_Object val
, insdef
, tem
;
6308 struct gcpro gcpro1
, gcpro2
;
6309 register char *homedir
;
6310 Lisp_Object decoded_homedir
;
6311 int replace_in_history
= 0;
6312 int add_to_history
= 0;
6316 dir
= current_buffer
->directory
;
6317 if (NILP (Ffile_name_absolute_p (dir
)))
6318 dir
= Fexpand_file_name (dir
, Qnil
);
6319 if (NILP (default_filename
))
6322 ? Fexpand_file_name (initial
, dir
)
6323 : current_buffer
->filename
);
6325 /* If dir starts with user's homedir, change that to ~. */
6326 homedir
= (char *) egetenv ("HOME");
6328 /* homedir can be NULL in temacs, since Vprocess_environment is not
6329 yet set up. We shouldn't crash in that case. */
6332 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6333 CORRECT_DIR_SEPS (homedir
);
6338 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6341 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6342 SBYTES (decoded_homedir
))
6343 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6345 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6346 dir
= concat2 (build_string ("~"), dir
);
6348 /* Likewise for default_filename. */
6350 && STRINGP (default_filename
)
6351 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6352 SBYTES (decoded_homedir
))
6353 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6356 = Fsubstring (default_filename
,
6357 make_number (SCHARS (decoded_homedir
)), Qnil
);
6358 default_filename
= concat2 (build_string ("~"), default_filename
);
6360 if (!NILP (default_filename
))
6362 CHECK_STRING (default_filename
);
6363 default_filename
= double_dollars (default_filename
);
6366 if (insert_default_directory
&& STRINGP (dir
))
6369 if (!NILP (initial
))
6371 Lisp_Object args
[2], pos
;
6375 insdef
= Fconcat (2, args
);
6376 pos
= make_number (SCHARS (double_dollars (dir
)));
6377 insdef
= Fcons (double_dollars (insdef
), pos
);
6380 insdef
= double_dollars (insdef
);
6382 else if (STRINGP (initial
))
6383 insdef
= Fcons (double_dollars (initial
), make_number (0));
6387 if (!NILP (Vread_file_name_function
))
6389 Lisp_Object args
[7];
6391 GCPRO2 (insdef
, default_filename
);
6392 args
[0] = Vread_file_name_function
;
6395 args
[3] = default_filename
;
6396 args
[4] = mustmatch
;
6398 args
[6] = predicate
;
6399 RETURN_UNGCPRO (Ffuncall (7, args
));
6402 count
= SPECPDL_INDEX ();
6403 specbind (intern ("completion-ignore-case"),
6404 read_file_name_completion_ignore_case
? Qt
: Qnil
);
6405 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6406 specbind (intern ("read-file-name-predicate"),
6407 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6409 GCPRO2 (insdef
, default_filename
);
6411 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6412 if (! NILP (Fnext_read_file_uses_dialog_p ()))
6414 /* If DIR contains a file name, split it. */
6416 file
= Ffile_name_nondirectory (dir
);
6417 if (SCHARS (file
) && NILP (default_filename
))
6419 default_filename
= file
;
6420 dir
= Ffile_name_directory (dir
);
6422 if (!NILP(default_filename
))
6423 default_filename
= Fexpand_file_name (default_filename
, dir
);
6424 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
,
6425 EQ (predicate
, Qfile_directory_p
) ? Qt
: Qnil
);
6430 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6431 dir
, mustmatch
, insdef
,
6432 Qfile_name_history
, default_filename
, Qnil
);
6434 tem
= Fsymbol_value (Qfile_name_history
);
6435 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6436 replace_in_history
= 1;
6438 /* If Fcompleting_read returned the inserted default string itself
6439 (rather than a new string with the same contents),
6440 it has to mean that the user typed RET with the minibuffer empty.
6441 In that case, we really want to return ""
6442 so that commands such as set-visited-file-name can distinguish. */
6443 if (EQ (val
, default_filename
))
6445 /* In this case, Fcompleting_read has not added an element
6446 to the history. Maybe we should. */
6447 if (! replace_in_history
)
6453 unbind_to (count
, Qnil
);
6456 error ("No file name specified");
6458 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6460 if (!NILP (tem
) && !NILP (default_filename
))
6461 val
= default_filename
;
6462 val
= Fsubstitute_in_file_name (val
);
6464 if (replace_in_history
)
6465 /* Replace what Fcompleting_read added to the history
6466 with what we will actually return. */
6468 Lisp_Object val1
= double_dollars (val
);
6469 tem
= Fsymbol_value (Qfile_name_history
);
6470 if (history_delete_duplicates
)
6471 XSETCDR (tem
, Fdelete (val1
, XCDR(tem
)));
6472 XSETCAR (tem
, val1
);
6474 else if (add_to_history
)
6476 /* Add the value to the history--but not if it matches
6477 the last value already there. */
6478 Lisp_Object val1
= double_dollars (val
);
6479 tem
= Fsymbol_value (Qfile_name_history
);
6480 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6482 if (history_delete_duplicates
) tem
= Fdelete (val1
, tem
);
6483 Fset (Qfile_name_history
, Fcons (val1
, tem
));
6494 /* Must be set before any path manipulation is performed. */
6495 XSETFASTINT (Vdirectory_sep_char
, '/');
6502 Qoperations
= intern ("operations");
6503 Qexpand_file_name
= intern ("expand-file-name");
6504 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6505 Qdirectory_file_name
= intern ("directory-file-name");
6506 Qfile_name_directory
= intern ("file-name-directory");
6507 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6508 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6509 Qfile_name_as_directory
= intern ("file-name-as-directory");
6510 Qcopy_file
= intern ("copy-file");
6511 Qmake_directory_internal
= intern ("make-directory-internal");
6512 Qmake_directory
= intern ("make-directory");
6513 Qdelete_directory
= intern ("delete-directory");
6514 Qdelete_file
= intern ("delete-file");
6515 Qrename_file
= intern ("rename-file");
6516 Qadd_name_to_file
= intern ("add-name-to-file");
6517 Qmake_symbolic_link
= intern ("make-symbolic-link");
6518 Qfile_exists_p
= intern ("file-exists-p");
6519 Qfile_executable_p
= intern ("file-executable-p");
6520 Qfile_readable_p
= intern ("file-readable-p");
6521 Qfile_writable_p
= intern ("file-writable-p");
6522 Qfile_symlink_p
= intern ("file-symlink-p");
6523 Qaccess_file
= intern ("access-file");
6524 Qfile_directory_p
= intern ("file-directory-p");
6525 Qfile_regular_p
= intern ("file-regular-p");
6526 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6527 Qfile_modes
= intern ("file-modes");
6528 Qset_file_modes
= intern ("set-file-modes");
6529 Qset_file_times
= intern ("set-file-times");
6530 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6531 Qinsert_file_contents
= intern ("insert-file-contents");
6532 Qwrite_region
= intern ("write-region");
6533 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6534 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6535 Qauto_save_coding
= intern ("auto-save-coding");
6537 staticpro (&Qoperations
);
6538 staticpro (&Qexpand_file_name
);
6539 staticpro (&Qsubstitute_in_file_name
);
6540 staticpro (&Qdirectory_file_name
);
6541 staticpro (&Qfile_name_directory
);
6542 staticpro (&Qfile_name_nondirectory
);
6543 staticpro (&Qunhandled_file_name_directory
);
6544 staticpro (&Qfile_name_as_directory
);
6545 staticpro (&Qcopy_file
);
6546 staticpro (&Qmake_directory_internal
);
6547 staticpro (&Qmake_directory
);
6548 staticpro (&Qdelete_directory
);
6549 staticpro (&Qdelete_file
);
6550 staticpro (&Qrename_file
);
6551 staticpro (&Qadd_name_to_file
);
6552 staticpro (&Qmake_symbolic_link
);
6553 staticpro (&Qfile_exists_p
);
6554 staticpro (&Qfile_executable_p
);
6555 staticpro (&Qfile_readable_p
);
6556 staticpro (&Qfile_writable_p
);
6557 staticpro (&Qaccess_file
);
6558 staticpro (&Qfile_symlink_p
);
6559 staticpro (&Qfile_directory_p
);
6560 staticpro (&Qfile_regular_p
);
6561 staticpro (&Qfile_accessible_directory_p
);
6562 staticpro (&Qfile_modes
);
6563 staticpro (&Qset_file_modes
);
6564 staticpro (&Qset_file_times
);
6565 staticpro (&Qfile_newer_than_file_p
);
6566 staticpro (&Qinsert_file_contents
);
6567 staticpro (&Qwrite_region
);
6568 staticpro (&Qverify_visited_file_modtime
);
6569 staticpro (&Qset_visited_file_modtime
);
6570 staticpro (&Qauto_save_coding
);
6572 Qfile_name_history
= intern ("file-name-history");
6573 Fset (Qfile_name_history
, Qnil
);
6574 staticpro (&Qfile_name_history
);
6576 Qfile_error
= intern ("file-error");
6577 staticpro (&Qfile_error
);
6578 Qfile_already_exists
= intern ("file-already-exists");
6579 staticpro (&Qfile_already_exists
);
6580 Qfile_date_error
= intern ("file-date-error");
6581 staticpro (&Qfile_date_error
);
6582 Qexcl
= intern ("excl");
6586 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6587 staticpro (&Qfind_buffer_file_type
);
6590 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6591 doc
: /* *Coding system for encoding file names.
6592 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6593 Vfile_name_coding_system
= Qnil
;
6595 DEFVAR_LISP ("default-file-name-coding-system",
6596 &Vdefault_file_name_coding_system
,
6597 doc
: /* Default coding system for encoding file names.
6598 This variable is used only when `file-name-coding-system' is nil.
6600 This variable is set/changed by the command `set-language-environment'.
6601 User should not set this variable manually,
6602 instead use `file-name-coding-system' to get a constant encoding
6603 of file names regardless of the current language environment. */);
6604 Vdefault_file_name_coding_system
= Qnil
;
6606 Qformat_decode
= intern ("format-decode");
6607 staticpro (&Qformat_decode
);
6608 Qformat_annotate_function
= intern ("format-annotate-function");
6609 staticpro (&Qformat_annotate_function
);
6610 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6611 staticpro (&Qafter_insert_file_set_coding
);
6613 Qcar_less_than_car
= intern ("car-less-than-car");
6614 staticpro (&Qcar_less_than_car
);
6616 Fput (Qfile_error
, Qerror_conditions
,
6617 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6618 Fput (Qfile_error
, Qerror_message
,
6619 build_string ("File error"));
6621 Fput (Qfile_already_exists
, Qerror_conditions
,
6622 Fcons (Qfile_already_exists
,
6623 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6624 Fput (Qfile_already_exists
, Qerror_message
,
6625 build_string ("File already exists"));
6627 Fput (Qfile_date_error
, Qerror_conditions
,
6628 Fcons (Qfile_date_error
,
6629 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6630 Fput (Qfile_date_error
, Qerror_message
,
6631 build_string ("Cannot set file date"));
6633 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6634 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6635 Vread_file_name_function
= Qnil
;
6637 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6638 doc
: /* Current predicate used by `read-file-name-internal'. */);
6639 Vread_file_name_predicate
= Qnil
;
6641 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case
,
6642 doc
: /* *Non-nil means when reading a file name completion ignores case. */);
6643 #if defined VMS || defined DOS_NT || defined MAC_OS
6644 read_file_name_completion_ignore_case
= 1;
6646 read_file_name_completion_ignore_case
= 0;
6649 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6650 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6651 If the initial minibuffer contents are non-empty, you can usually
6652 request a default filename by typing RETURN without editing. For some
6653 commands, exiting with an empty minibuffer has a special meaning,
6654 such as making the current buffer visit no file in the case of
6655 `set-visited-file-name'.
6656 If this variable is non-nil, the minibuffer contents are always
6657 initially non-empty and typing RETURN without editing will fetch the
6658 default name, if one is provided. Note however that this default name
6659 is not necessarily the name originally inserted in the minibuffer, if
6660 that is just the default directory.
6661 If this variable is nil, the minibuffer often starts out empty. In
6662 that case you may have to explicitly fetch the next history element to
6663 request the default name. */);
6664 insert_default_directory
= 1;
6666 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6667 doc
: /* *Non-nil means write new files with record format `stmlf'.
6668 nil means use format `var'. This variable is meaningful only on VMS. */);
6669 vms_stmlf_recfm
= 0;
6671 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6672 doc
: /* Directory separator character for built-in functions that return file names.
6673 The value is always ?/. Don't use this variable, just use `/'. */);
6675 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6676 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6677 If a file name matches REGEXP, then all I/O on that file is done by calling
6680 The first argument given to HANDLER is the name of the I/O primitive
6681 to be handled; the remaining arguments are the arguments that were
6682 passed to that primitive. For example, if you do
6683 (file-exists-p FILENAME)
6684 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6685 (funcall HANDLER 'file-exists-p FILENAME)
6686 The function `find-file-name-handler' checks this list for a handler
6687 for its argument. */);
6688 Vfile_name_handler_alist
= Qnil
;
6690 DEFVAR_LISP ("set-auto-coding-function",
6691 &Vset_auto_coding_function
,
6692 doc
: /* If non-nil, a function to call to decide a coding system of file.
6693 Two arguments are passed to this function: the file name
6694 and the length of a file contents following the point.
6695 This function should return a coding system to decode the file contents.
6696 It should check the file name against `auto-coding-alist'.
6697 If no coding system is decided, it should check a coding system
6698 specified in the heading lines with the format:
6699 -*- ... coding: CODING-SYSTEM; ... -*-
6700 or local variable spec of the tailing lines with `coding:' tag. */);
6701 Vset_auto_coding_function
= Qnil
;
6703 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6704 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6705 Each is passed one argument, the number of characters inserted.
6706 It should return the new character count, and leave point the same.
6707 If `insert-file-contents' is intercepted by a handler from
6708 `file-name-handler-alist', that handler is responsible for calling the
6709 functions in `after-insert-file-functions' if appropriate. */);
6710 Vafter_insert_file_functions
= Qnil
;
6712 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6713 doc
: /* A list of functions to be called at the start of `write-region'.
6714 Each is passed two arguments, START and END as for `write-region'.
6715 These are usually two numbers but not always; see the documentation
6716 for `write-region'. The function should return a list of pairs
6717 of the form (POSITION . STRING), consisting of strings to be effectively
6718 inserted at the specified positions of the file being written (1 means to
6719 insert before the first byte written). The POSITIONs must be sorted into
6720 increasing order. If there are several functions in the list, the several
6721 lists are merged destructively. Alternatively, the function can return
6722 with a different buffer current; in that case it should pay attention
6723 to the annotations returned by previous functions and listed in
6724 `write-region-annotations-so-far'.*/);
6725 Vwrite_region_annotate_functions
= Qnil
;
6726 staticpro (&Qwrite_region_annotate_functions
);
6727 Qwrite_region_annotate_functions
6728 = intern ("write-region-annotate-functions");
6730 DEFVAR_LISP ("write-region-annotations-so-far",
6731 &Vwrite_region_annotations_so_far
,
6732 doc
: /* When an annotation function is called, this holds the previous annotations.
6733 These are the annotations made by other annotation functions
6734 that were already called. See also `write-region-annotate-functions'. */);
6735 Vwrite_region_annotations_so_far
= Qnil
;
6737 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6738 doc
: /* A list of file name handlers that temporarily should not be used.
6739 This applies only to the operation `inhibit-file-name-operation'. */);
6740 Vinhibit_file_name_handlers
= Qnil
;
6742 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6743 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6744 Vinhibit_file_name_operation
= Qnil
;
6746 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6747 doc
: /* File name in which we write a list of all auto save file names.
6748 This variable is initialized automatically from `auto-save-list-file-prefix'
6749 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6750 a non-nil value. */);
6751 Vauto_save_list_file_name
= Qnil
;
6754 DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync
,
6755 doc
: /* *Non-nil means don't call fsync in `write-region'.
6756 This variable affects calls to `write-region' as well as save commands.
6757 A non-nil value may result in data loss! */);
6758 write_region_inhibit_fsync
= 0;
6761 defsubr (&Sfind_file_name_handler
);
6762 defsubr (&Sfile_name_directory
);
6763 defsubr (&Sfile_name_nondirectory
);
6764 defsubr (&Sunhandled_file_name_directory
);
6765 defsubr (&Sfile_name_as_directory
);
6766 defsubr (&Sdirectory_file_name
);
6767 defsubr (&Smake_temp_name
);
6768 defsubr (&Sexpand_file_name
);
6769 defsubr (&Ssubstitute_in_file_name
);
6770 defsubr (&Scopy_file
);
6771 defsubr (&Smake_directory_internal
);
6772 defsubr (&Sdelete_directory
);
6773 defsubr (&Sdelete_file
);
6774 defsubr (&Srename_file
);
6775 defsubr (&Sadd_name_to_file
);
6777 defsubr (&Smake_symbolic_link
);
6778 #endif /* S_IFLNK */
6780 defsubr (&Sdefine_logical_name
);
6783 defsubr (&Ssysnetunam
);
6784 #endif /* HPUX_NET */
6785 defsubr (&Sfile_name_absolute_p
);
6786 defsubr (&Sfile_exists_p
);
6787 defsubr (&Sfile_executable_p
);
6788 defsubr (&Sfile_readable_p
);
6789 defsubr (&Sfile_writable_p
);
6790 defsubr (&Saccess_file
);
6791 defsubr (&Sfile_symlink_p
);
6792 defsubr (&Sfile_directory_p
);
6793 defsubr (&Sfile_accessible_directory_p
);
6794 defsubr (&Sfile_regular_p
);
6795 defsubr (&Sfile_modes
);
6796 defsubr (&Sset_file_modes
);
6797 defsubr (&Sset_file_times
);
6798 defsubr (&Sset_default_file_modes
);
6799 defsubr (&Sdefault_file_modes
);
6800 defsubr (&Sfile_newer_than_file_p
);
6801 defsubr (&Sinsert_file_contents
);
6802 defsubr (&Swrite_region
);
6803 defsubr (&Scar_less_than_car
);
6804 defsubr (&Sverify_visited_file_modtime
);
6805 defsubr (&Sclear_visited_file_modtime
);
6806 defsubr (&Svisited_file_modtime
);
6807 defsubr (&Sset_visited_file_modtime
);
6808 defsubr (&Sdo_auto_save
);
6809 defsubr (&Sset_buffer_auto_saved
);
6810 defsubr (&Sclear_buffer_auto_save_failure
);
6811 defsubr (&Srecent_auto_save_p
);
6813 defsubr (&Sread_file_name_internal
);
6814 defsubr (&Sread_file_name
);
6815 defsubr (&Snext_read_file_uses_dialog_p
);
6818 defsubr (&Sunix_sync
);
6822 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6823 (do not change this comment) */