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 file FILENAME is the name of a regular file.
3396 This is the sort of file that holds an ordinary stream of data bytes. */)
3398 Lisp_Object filename
;
3400 register Lisp_Object absname
;
3402 Lisp_Object handler
;
3404 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3406 /* If the file name has special constructs in it,
3407 call the corresponding file handler. */
3408 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3409 if (!NILP (handler
))
3410 return call2 (handler
, Qfile_regular_p
, absname
);
3412 absname
= ENCODE_FILE (absname
);
3417 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3419 /* Tell stat to use expensive method to get accurate info. */
3420 Vw32_get_true_file_attributes
= Qt
;
3421 result
= stat (SDATA (absname
), &st
);
3422 Vw32_get_true_file_attributes
= tem
;
3426 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3429 if (stat (SDATA (absname
), &st
) < 0)
3431 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3435 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3436 doc
: /* Return mode bits of file named FILENAME, as an integer.
3437 Return nil, if file does not exist or is not accessible. */)
3439 Lisp_Object filename
;
3441 Lisp_Object absname
;
3443 Lisp_Object handler
;
3445 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3447 /* If the file name has special constructs in it,
3448 call the corresponding file handler. */
3449 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3450 if (!NILP (handler
))
3451 return call2 (handler
, Qfile_modes
, absname
);
3453 absname
= ENCODE_FILE (absname
);
3455 if (stat (SDATA (absname
), &st
) < 0)
3457 #if defined (MSDOS) && __DJGPP__ < 2
3458 if (check_executable (SDATA (absname
)))
3459 st
.st_mode
|= S_IEXEC
;
3460 #endif /* MSDOS && __DJGPP__ < 2 */
3462 return make_number (st
.st_mode
& 07777);
3465 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3466 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3467 Only the 12 low bits of MODE are used. */)
3469 Lisp_Object filename
, mode
;
3471 Lisp_Object absname
, encoded_absname
;
3472 Lisp_Object handler
;
3474 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3475 CHECK_NUMBER (mode
);
3477 /* If the file name has special constructs in it,
3478 call the corresponding file handler. */
3479 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3480 if (!NILP (handler
))
3481 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3483 encoded_absname
= ENCODE_FILE (absname
);
3485 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3486 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3491 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3492 doc
: /* Set the file permission bits for newly created files.
3493 The argument MODE should be an integer; only the low 9 bits are used.
3494 This setting is inherited by subprocesses. */)
3498 CHECK_NUMBER (mode
);
3500 umask ((~ XINT (mode
)) & 0777);
3505 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3506 doc
: /* Return the default file protection for created files.
3507 The value is an integer. */)
3513 realmask
= umask (0);
3516 XSETINT (value
, (~ realmask
) & 0777);
3520 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3522 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3523 doc
: /* Set times of file FILENAME to TIME.
3524 Set both access and modification times.
3525 Return t on success, else nil.
3526 Use the current time if TIME is nil. TIME is in the format of
3529 Lisp_Object filename
, time
;
3531 Lisp_Object absname
, encoded_absname
;
3532 Lisp_Object handler
;
3536 if (! lisp_time_argument (time
, &sec
, &usec
))
3537 error ("Invalid time specification");
3539 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3541 /* If the file name has special constructs in it,
3542 call the corresponding file handler. */
3543 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3544 if (!NILP (handler
))
3545 return call3 (handler
, Qset_file_times
, absname
, time
);
3547 encoded_absname
= ENCODE_FILE (absname
);
3552 EMACS_SET_SECS (t
, sec
);
3553 EMACS_SET_USECS (t
, usec
);
3555 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3560 /* Setting times on a directory always fails. */
3561 if (stat (SDATA (encoded_absname
), &st
) == 0
3562 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3565 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3578 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3579 doc
: /* Tell Unix to finish all pending disk updates. */)
3588 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3589 doc
: /* Return t if file FILE1 is newer than file FILE2.
3590 If FILE1 does not exist, the answer is nil;
3591 otherwise, if FILE2 does not exist, the answer is t. */)
3593 Lisp_Object file1
, file2
;
3595 Lisp_Object absname1
, absname2
;
3598 Lisp_Object handler
;
3599 struct gcpro gcpro1
, gcpro2
;
3601 CHECK_STRING (file1
);
3602 CHECK_STRING (file2
);
3605 GCPRO2 (absname1
, file2
);
3606 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3607 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3610 /* If the file name has special constructs in it,
3611 call the corresponding file handler. */
3612 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3614 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3615 if (!NILP (handler
))
3616 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3618 GCPRO2 (absname1
, absname2
);
3619 absname1
= ENCODE_FILE (absname1
);
3620 absname2
= ENCODE_FILE (absname2
);
3623 if (stat (SDATA (absname1
), &st
) < 0)
3626 mtime1
= st
.st_mtime
;
3628 if (stat (SDATA (absname2
), &st
) < 0)
3631 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3635 Lisp_Object Qfind_buffer_file_type
;
3638 #ifndef READ_BUF_SIZE
3639 #define READ_BUF_SIZE (64 << 10)
3642 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3644 /* This function is called after Lisp functions to decide a coding
3645 system are called, or when they cause an error. Before they are
3646 called, the current buffer is set unibyte and it contains only a
3647 newly inserted text (thus the buffer was empty before the
3650 The functions may set markers, overlays, text properties, or even
3651 alter the buffer contents, change the current buffer.
3653 Here, we reset all those changes by:
3654 o set back the current buffer.
3655 o move all markers and overlays to BEG.
3656 o remove all text properties.
3657 o set back the buffer multibyteness. */
3660 decide_coding_unwind (unwind_data
)
3661 Lisp_Object unwind_data
;
3663 Lisp_Object multibyte
, undo_list
, buffer
;
3665 multibyte
= XCAR (unwind_data
);
3666 unwind_data
= XCDR (unwind_data
);
3667 undo_list
= XCAR (unwind_data
);
3668 buffer
= XCDR (unwind_data
);
3670 if (current_buffer
!= XBUFFER (buffer
))
3671 set_buffer_internal (XBUFFER (buffer
));
3672 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3673 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3674 BUF_INTERVALS (current_buffer
) = 0;
3675 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3677 /* Now we are safe to change the buffer's multibyteness directly. */
3678 current_buffer
->enable_multibyte_characters
= multibyte
;
3679 current_buffer
->undo_list
= undo_list
;
3685 /* Used to pass values from insert-file-contents to read_non_regular. */
3687 static int non_regular_fd
;
3688 static int non_regular_inserted
;
3689 static int non_regular_nbytes
;
3692 /* Read from a non-regular file.
3693 Read non_regular_trytry bytes max from non_regular_fd.
3694 Non_regular_inserted specifies where to put the read bytes.
3695 Value is the number of bytes read. */
3704 nbytes
= emacs_read (non_regular_fd
,
3705 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3706 non_regular_nbytes
);
3708 return make_number (nbytes
);
3712 /* Condition-case handler used when reading from non-regular files
3713 in insert-file-contents. */
3716 read_non_regular_quit ()
3722 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3724 doc
: /* Insert contents of file FILENAME after point.
3725 Returns list of absolute file name and number of characters inserted.
3726 If second argument VISIT is non-nil, the buffer's visited filename
3727 and last save file modtime are set, and it is marked unmodified.
3728 If visiting and the file does not exist, visiting is completed
3729 before the error is signaled.
3730 The optional third and fourth arguments BEG and END
3731 specify what portion of the file to insert.
3732 These arguments count bytes in the file, not characters in the buffer.
3733 If VISIT is non-nil, BEG and END must be nil.
3735 If optional fifth argument REPLACE is non-nil,
3736 it means replace the current buffer contents (in the accessible portion)
3737 with the file contents. This is better than simply deleting and inserting
3738 the whole thing because (1) it preserves some marker positions
3739 and (2) it puts less data in the undo list.
3740 When REPLACE is non-nil, the value is the number of characters actually read,
3741 which is often less than the number of characters to be read.
3743 This does code conversion according to the value of
3744 `coding-system-for-read' or `file-coding-system-alist',
3745 and sets the variable `last-coding-system-used' to the coding system
3747 (filename
, visit
, beg
, end
, replace
)
3748 Lisp_Object filename
, visit
, beg
, end
, replace
;
3753 register int how_much
;
3754 register int unprocessed
;
3755 int count
= SPECPDL_INDEX ();
3756 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3757 Lisp_Object handler
, val
, insval
, orig_filename
;
3760 int not_regular
= 0;
3761 unsigned char read_buf
[READ_BUF_SIZE
];
3762 struct coding_system coding
;
3763 unsigned char buffer
[1 << 14];
3764 int replace_handled
= 0;
3765 int set_coding_system
= 0;
3766 int coding_system_decided
= 0;
3768 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3769 int we_locked_file
= 0;
3771 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3772 error ("Cannot do file visiting in an indirect buffer");
3774 if (!NILP (current_buffer
->read_only
))
3775 Fbarf_if_buffer_read_only ();
3779 orig_filename
= Qnil
;
3781 GCPRO4 (filename
, val
, p
, orig_filename
);
3783 CHECK_STRING (filename
);
3784 filename
= Fexpand_file_name (filename
, Qnil
);
3786 /* If the file name has special constructs in it,
3787 call the corresponding file handler. */
3788 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3789 if (!NILP (handler
))
3791 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3792 visit
, beg
, end
, replace
);
3793 if (CONSP (val
) && CONSP (XCDR (val
)))
3794 inserted
= XINT (XCAR (XCDR (val
)));
3798 orig_filename
= filename
;
3799 filename
= ENCODE_FILE (filename
);
3805 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3807 /* Tell stat to use expensive method to get accurate info. */
3808 Vw32_get_true_file_attributes
= Qt
;
3809 total
= stat (SDATA (filename
), &st
);
3810 Vw32_get_true_file_attributes
= tem
;
3815 if (stat (SDATA (filename
), &st
) < 0)
3817 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3818 || fstat (fd
, &st
) < 0)
3819 #endif /* not APOLLO */
3820 #endif /* WINDOWSNT */
3822 if (fd
>= 0) emacs_close (fd
);
3825 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3828 if (!NILP (Vcoding_system_for_read
))
3829 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3834 /* This code will need to be changed in order to work on named
3835 pipes, and it's probably just not worth it. So we should at
3836 least signal an error. */
3837 if (!S_ISREG (st
.st_mode
))
3844 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3845 Fsignal (Qfile_error
,
3846 Fcons (build_string ("not a regular file"),
3847 Fcons (orig_filename
, Qnil
)));
3852 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3855 /* Replacement should preserve point as it preserves markers. */
3856 if (!NILP (replace
))
3857 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3859 record_unwind_protect (close_file_unwind
, make_number (fd
));
3861 /* Supposedly happens on VMS. */
3862 /* Can happen on any platform that uses long as type of off_t, but allows
3863 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3864 give a message suitable for the latter case. */
3865 if (! not_regular
&& st
.st_size
< 0)
3866 error ("Maximum buffer size exceeded");
3868 /* Prevent redisplay optimizations. */
3869 current_buffer
->clip_changed
= 1;
3873 if (!NILP (beg
) || !NILP (end
))
3874 error ("Attempt to visit less than an entire file");
3875 if (BEG
< Z
&& NILP (replace
))
3876 error ("Cannot do file visiting in a non-empty buffer");
3882 XSETFASTINT (beg
, 0);
3890 XSETINT (end
, st
.st_size
);
3892 /* Arithmetic overflow can occur if an Emacs integer cannot
3893 represent the file size, or if the calculations below
3894 overflow. The calculations below double the file size
3895 twice, so check that it can be multiplied by 4 safely. */
3896 if (XINT (end
) != st
.st_size
3897 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3898 error ("Maximum buffer size exceeded");
3900 /* The file size returned from stat may be zero, but data
3901 may be readable nonetheless, for example when this is a
3902 file in the /proc filesystem. */
3903 if (st
.st_size
== 0)
3904 XSETINT (end
, READ_BUF_SIZE
);
3908 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3910 /* We use emacs-mule for auto saving... */
3911 setup_coding_system (Qemacs_mule
, &coding
);
3912 /* ... but with the special flag to indicate to read in a
3913 multibyte sequence for eight-bit-control char as is. */
3915 coding
.src_multibyte
= 0;
3916 coding
.dst_multibyte
3917 = !NILP (current_buffer
->enable_multibyte_characters
);
3918 coding
.eol_type
= CODING_EOL_LF
;
3919 coding_system_decided
= 1;
3923 /* Decide the coding system to use for reading the file now
3924 because we can't use an optimized method for handling
3925 `coding:' tag if the current buffer is not empty. */
3929 if (!NILP (Vcoding_system_for_read
))
3930 val
= Vcoding_system_for_read
;
3933 /* Don't try looking inside a file for a coding system
3934 specification if it is not seekable. */
3935 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3937 /* Find a coding system specified in the heading two
3938 lines or in the tailing several lines of the file.
3939 We assume that the 1K-byte and 3K-byte for heading
3940 and tailing respectively are sufficient for this
3944 if (st
.st_size
<= (1024 * 4))
3945 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3948 nread
= emacs_read (fd
, read_buf
, 1024);
3951 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3952 report_file_error ("Setting file position",
3953 Fcons (orig_filename
, Qnil
));
3954 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3959 error ("IO error reading %s: %s",
3960 SDATA (orig_filename
), emacs_strerror (errno
));
3963 struct buffer
*prev
= current_buffer
;
3967 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3969 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3970 buf
= XBUFFER (buffer
);
3972 delete_all_overlays (buf
);
3973 buf
->directory
= current_buffer
->directory
;
3974 buf
->read_only
= Qnil
;
3975 buf
->filename
= Qnil
;
3976 buf
->undo_list
= Qt
;
3977 eassert (buf
->overlays_before
== NULL
);
3978 eassert (buf
->overlays_after
== NULL
);
3980 set_buffer_internal (buf
);
3982 buf
->enable_multibyte_characters
= Qnil
;
3984 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3985 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3986 val
= call2 (Vset_auto_coding_function
,
3987 filename
, make_number (nread
));
3988 set_buffer_internal (prev
);
3990 /* Discard the unwind protect for recovering the
3994 /* Rewind the file for the actual read done later. */
3995 if (lseek (fd
, 0, 0) < 0)
3996 report_file_error ("Setting file position",
3997 Fcons (orig_filename
, Qnil
));
4003 /* If we have not yet decided a coding system, check
4004 file-coding-system-alist. */
4005 Lisp_Object args
[6], coding_systems
;
4007 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4008 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
4009 coding_systems
= Ffind_operation_coding_system (6, args
);
4010 if (CONSP (coding_systems
))
4011 val
= XCAR (coding_systems
);
4015 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4016 /* Ensure we set Vlast_coding_system_used. */
4017 set_coding_system
= 1;
4019 if (NILP (current_buffer
->enable_multibyte_characters
)
4021 /* We must suppress all character code conversion except for
4022 end-of-line conversion. */
4023 setup_raw_text_coding_system (&coding
);
4025 coding
.src_multibyte
= 0;
4026 coding
.dst_multibyte
4027 = !NILP (current_buffer
->enable_multibyte_characters
);
4028 coding_system_decided
= 1;
4031 /* If requested, replace the accessible part of the buffer
4032 with the file contents. Avoid replacing text at the
4033 beginning or end of the buffer that matches the file contents;
4034 that preserves markers pointing to the unchanged parts.
4036 Here we implement this feature in an optimized way
4037 for the case where code conversion is NOT needed.
4038 The following if-statement handles the case of conversion
4039 in a less optimal way.
4041 If the code conversion is "automatic" then we try using this
4042 method and hope for the best.
4043 But if we discover the need for conversion, we give up on this method
4044 and let the following if-statement handle the replace job. */
4047 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
4049 /* same_at_start and same_at_end count bytes,
4050 because file access counts bytes
4051 and BEG and END count bytes. */
4052 int same_at_start
= BEGV_BYTE
;
4053 int same_at_end
= ZV_BYTE
;
4055 /* There is still a possibility we will find the need to do code
4056 conversion. If that happens, we set this variable to 1 to
4057 give up on handling REPLACE in the optimized way. */
4058 int giveup_match_end
= 0;
4060 if (XINT (beg
) != 0)
4062 if (lseek (fd
, XINT (beg
), 0) < 0)
4063 report_file_error ("Setting file position",
4064 Fcons (orig_filename
, Qnil
));
4069 /* Count how many chars at the start of the file
4070 match the text at the beginning of the buffer. */
4075 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4077 error ("IO error reading %s: %s",
4078 SDATA (orig_filename
), emacs_strerror (errno
));
4079 else if (nread
== 0)
4082 if (coding
.type
== coding_type_undecided
)
4083 detect_coding (&coding
, buffer
, nread
);
4084 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
4085 /* We found that the file should be decoded somehow.
4086 Let's give up here. */
4088 giveup_match_end
= 1;
4092 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
4093 detect_eol (&coding
, buffer
, nread
);
4094 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
4095 && coding
.eol_type
!= CODING_EOL_LF
)
4096 /* We found that the format of eol should be decoded.
4097 Let's give up here. */
4099 giveup_match_end
= 1;
4104 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4105 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4106 same_at_start
++, bufpos
++;
4107 /* If we found a discrepancy, stop the scan.
4108 Otherwise loop around and scan the next bufferful. */
4109 if (bufpos
!= nread
)
4113 /* If the file matches the buffer completely,
4114 there's no need to replace anything. */
4115 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4119 /* Truncate the buffer to the size of the file. */
4120 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4125 /* Count how many chars at the end of the file
4126 match the text at the end of the buffer. But, if we have
4127 already found that decoding is necessary, don't waste time. */
4128 while (!giveup_match_end
)
4130 int total_read
, nread
, bufpos
, curpos
, trial
;
4132 /* At what file position are we now scanning? */
4133 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4134 /* If the entire file matches the buffer tail, stop the scan. */
4137 /* How much can we scan in the next step? */
4138 trial
= min (curpos
, sizeof buffer
);
4139 if (lseek (fd
, curpos
- trial
, 0) < 0)
4140 report_file_error ("Setting file position",
4141 Fcons (orig_filename
, Qnil
));
4143 total_read
= nread
= 0;
4144 while (total_read
< trial
)
4146 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4148 error ("IO error reading %s: %s",
4149 SDATA (orig_filename
), emacs_strerror (errno
));
4150 else if (nread
== 0)
4152 total_read
+= nread
;
4155 /* Scan this bufferful from the end, comparing with
4156 the Emacs buffer. */
4157 bufpos
= total_read
;
4159 /* Compare with same_at_start to avoid counting some buffer text
4160 as matching both at the file's beginning and at the end. */
4161 while (bufpos
> 0 && same_at_end
> same_at_start
4162 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4163 same_at_end
--, bufpos
--;
4165 /* If we found a discrepancy, stop the scan.
4166 Otherwise loop around and scan the preceding bufferful. */
4169 /* If this discrepancy is because of code conversion,
4170 we cannot use this method; giveup and try the other. */
4171 if (same_at_end
> same_at_start
4172 && FETCH_BYTE (same_at_end
- 1) >= 0200
4173 && ! NILP (current_buffer
->enable_multibyte_characters
)
4174 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4175 giveup_match_end
= 1;
4184 if (! giveup_match_end
)
4188 /* We win! We can handle REPLACE the optimized way. */
4190 /* Extend the start of non-matching text area to multibyte
4191 character boundary. */
4192 if (! NILP (current_buffer
->enable_multibyte_characters
))
4193 while (same_at_start
> BEGV_BYTE
4194 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4197 /* Extend the end of non-matching text area to multibyte
4198 character boundary. */
4199 if (! NILP (current_buffer
->enable_multibyte_characters
))
4200 while (same_at_end
< ZV_BYTE
4201 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4204 /* Don't try to reuse the same piece of text twice. */
4205 overlap
= (same_at_start
- BEGV_BYTE
4206 - (same_at_end
+ st
.st_size
- ZV
));
4208 same_at_end
+= overlap
;
4210 /* Arrange to read only the nonmatching middle part of the file. */
4211 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4212 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4214 del_range_byte (same_at_start
, same_at_end
, 0);
4215 /* Insert from the file at the proper position. */
4216 temp
= BYTE_TO_CHAR (same_at_start
);
4217 SET_PT_BOTH (temp
, same_at_start
);
4219 /* If display currently starts at beginning of line,
4220 keep it that way. */
4221 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4222 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4224 replace_handled
= 1;
4228 /* If requested, replace the accessible part of the buffer
4229 with the file contents. Avoid replacing text at the
4230 beginning or end of the buffer that matches the file contents;
4231 that preserves markers pointing to the unchanged parts.
4233 Here we implement this feature for the case where code conversion
4234 is needed, in a simple way that needs a lot of memory.
4235 The preceding if-statement handles the case of no conversion
4236 in a more optimized way. */
4237 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4239 int same_at_start
= BEGV_BYTE
;
4240 int same_at_end
= ZV_BYTE
;
4243 /* Make sure that the gap is large enough. */
4244 int bufsize
= 2 * st
.st_size
;
4245 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4248 /* First read the whole file, performing code conversion into
4249 CONVERSION_BUFFER. */
4251 if (lseek (fd
, XINT (beg
), 0) < 0)
4253 xfree (conversion_buffer
);
4254 report_file_error ("Setting file position",
4255 Fcons (orig_filename
, Qnil
));
4258 total
= st
.st_size
; /* Total bytes in the file. */
4259 how_much
= 0; /* Bytes read from file so far. */
4260 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4261 unprocessed
= 0; /* Bytes not processed in previous loop. */
4263 while (how_much
< total
)
4265 /* try is reserved in some compilers (Microsoft C) */
4266 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4267 unsigned char *destination
= read_buf
+ unprocessed
;
4270 /* Allow quitting out of the actual I/O. */
4273 this = emacs_read (fd
, destination
, trytry
);
4276 if (this < 0 || this + unprocessed
== 0)
4284 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4286 int require
, result
;
4288 this += unprocessed
;
4290 /* If we are using more space than estimated,
4291 make CONVERSION_BUFFER bigger. */
4292 require
= decoding_buffer_size (&coding
, this);
4293 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4295 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4296 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4299 /* Convert this batch with results in CONVERSION_BUFFER. */
4300 if (how_much
>= total
) /* This is the last block. */
4301 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4302 if (coding
.composing
!= COMPOSITION_DISABLED
)
4303 coding_allocate_composition_data (&coding
, BEGV
);
4304 result
= decode_coding (&coding
, read_buf
,
4305 conversion_buffer
+ inserted
,
4306 this, bufsize
- inserted
);
4308 /* Save for next iteration whatever we didn't convert. */
4309 unprocessed
= this - coding
.consumed
;
4310 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4311 if (!NILP (current_buffer
->enable_multibyte_characters
))
4312 this = coding
.produced
;
4314 this = str_as_unibyte (conversion_buffer
+ inserted
,
4321 /* At this point, INSERTED is how many characters (i.e. bytes)
4322 are present in CONVERSION_BUFFER.
4323 HOW_MUCH should equal TOTAL,
4324 or should be <= 0 if we couldn't read the file. */
4328 xfree (conversion_buffer
);
4329 coding_free_composition_data (&coding
);
4331 error ("IO error reading %s: %s",
4332 SDATA (orig_filename
), emacs_strerror (errno
));
4333 else if (how_much
== -2)
4334 error ("maximum buffer size exceeded");
4337 /* Compare the beginning of the converted file
4338 with the buffer text. */
4341 while (bufpos
< inserted
&& same_at_start
< same_at_end
4342 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4343 same_at_start
++, bufpos
++;
4345 /* If the file matches the buffer completely,
4346 there's no need to replace anything. */
4348 if (bufpos
== inserted
)
4350 xfree (conversion_buffer
);
4351 coding_free_composition_data (&coding
);
4354 /* Truncate the buffer to the size of the file. */
4355 del_range_byte (same_at_start
, same_at_end
, 0);
4360 /* Extend the start of non-matching text area to multibyte
4361 character boundary. */
4362 if (! NILP (current_buffer
->enable_multibyte_characters
))
4363 while (same_at_start
> BEGV_BYTE
4364 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4367 /* Scan this bufferful from the end, comparing with
4368 the Emacs buffer. */
4371 /* Compare with same_at_start to avoid counting some buffer text
4372 as matching both at the file's beginning and at the end. */
4373 while (bufpos
> 0 && same_at_end
> same_at_start
4374 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4375 same_at_end
--, bufpos
--;
4377 /* Extend the end of non-matching text area to multibyte
4378 character boundary. */
4379 if (! NILP (current_buffer
->enable_multibyte_characters
))
4380 while (same_at_end
< ZV_BYTE
4381 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4384 /* Don't try to reuse the same piece of text twice. */
4385 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4387 same_at_end
+= overlap
;
4389 /* If display currently starts at beginning of line,
4390 keep it that way. */
4391 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4392 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4394 /* Replace the chars that we need to replace,
4395 and update INSERTED to equal the number of bytes
4396 we are taking from the file. */
4397 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4399 if (same_at_end
!= same_at_start
)
4401 del_range_byte (same_at_start
, same_at_end
, 0);
4403 same_at_start
= GPT_BYTE
;
4407 temp
= BYTE_TO_CHAR (same_at_start
);
4409 /* Insert from the file at the proper position. */
4410 SET_PT_BOTH (temp
, same_at_start
);
4411 insert_1 (conversion_buffer
+ same_at_start
- BEGV_BYTE
, inserted
,
4413 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4414 coding_restore_composition (&coding
, Fcurrent_buffer ());
4415 coding_free_composition_data (&coding
);
4417 /* Set `inserted' to the number of inserted characters. */
4418 inserted
= PT
- temp
;
4420 xfree (conversion_buffer
);
4429 register Lisp_Object temp
;
4431 total
= XINT (end
) - XINT (beg
);
4433 /* Make sure point-max won't overflow after this insertion. */
4434 XSETINT (temp
, total
);
4435 if (total
!= XINT (temp
))
4436 error ("Maximum buffer size exceeded");
4439 /* For a special file, all we can do is guess. */
4440 total
= READ_BUF_SIZE
;
4442 if (NILP (visit
) && inserted
> 0)
4444 #ifdef CLASH_DETECTION
4445 if (!NILP (current_buffer
->file_truename
)
4446 /* Make binding buffer-file-name to nil effective. */
4447 && !NILP (current_buffer
->filename
)
4448 && SAVE_MODIFF
>= MODIFF
)
4450 #endif /* CLASH_DETECTION */
4451 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
4455 if (GAP_SIZE
< total
)
4456 make_gap (total
- GAP_SIZE
);
4458 if (XINT (beg
) != 0 || !NILP (replace
))
4460 if (lseek (fd
, XINT (beg
), 0) < 0)
4461 report_file_error ("Setting file position",
4462 Fcons (orig_filename
, Qnil
));
4465 /* In the following loop, HOW_MUCH contains the total bytes read so
4466 far for a regular file, and not changed for a special file. But,
4467 before exiting the loop, it is set to a negative value if I/O
4471 /* Total bytes inserted. */
4474 /* Here, we don't do code conversion in the loop. It is done by
4475 code_convert_region after all data are read into the buffer. */
4477 int gap_size
= GAP_SIZE
;
4479 while (how_much
< total
)
4481 /* try is reserved in some compilers (Microsoft C) */
4482 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4489 /* Maybe make more room. */
4490 if (gap_size
< trytry
)
4492 make_gap (total
- gap_size
);
4493 gap_size
= GAP_SIZE
;
4496 /* Read from the file, capturing `quit'. When an
4497 error occurs, end the loop, and arrange for a quit
4498 to be signaled after decoding the text we read. */
4499 non_regular_fd
= fd
;
4500 non_regular_inserted
= inserted
;
4501 non_regular_nbytes
= trytry
;
4502 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4503 read_non_regular_quit
);
4514 /* Allow quitting out of the actual I/O. We don't make text
4515 part of the buffer until all the reading is done, so a C-g
4516 here doesn't do any harm. */
4519 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4531 /* For a regular file, where TOTAL is the real size,
4532 count HOW_MUCH to compare with it.
4533 For a special file, where TOTAL is just a buffer size,
4534 so don't bother counting in HOW_MUCH.
4535 (INSERTED is where we count the number of characters inserted.) */
4542 /* Now we have read all the file data into the gap.
4543 If it was empty, undo marking the buffer modified. */
4547 #ifdef CLASH_DETECTION
4549 unlock_file (current_buffer
->file_truename
);
4551 Vdeactivate_mark
= old_Vdeactivate_mark
;
4554 /* Make the text read part of the buffer. */
4555 GAP_SIZE
-= inserted
;
4557 GPT_BYTE
+= inserted
;
4559 ZV_BYTE
+= inserted
;
4564 /* Put an anchor to ensure multi-byte form ends at gap. */
4569 /* Discard the unwind protect for closing the file. */
4573 error ("IO error reading %s: %s",
4574 SDATA (orig_filename
), emacs_strerror (errno
));
4578 if (! coding_system_decided
)
4580 /* The coding system is not yet decided. Decide it by an
4581 optimized method for handling `coding:' tag.
4583 Note that we can get here only if the buffer was empty
4584 before the insertion. */
4588 if (!NILP (Vcoding_system_for_read
))
4589 val
= Vcoding_system_for_read
;
4592 /* Since we are sure that the current buffer was empty
4593 before the insertion, we can toggle
4594 enable-multibyte-characters directly here without taking
4595 care of marker adjustment and byte combining problem. By
4596 this way, we can run Lisp program safely before decoding
4597 the inserted text. */
4598 Lisp_Object unwind_data
;
4599 int count
= SPECPDL_INDEX ();
4601 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4602 Fcons (current_buffer
->undo_list
,
4603 Fcurrent_buffer ()));
4604 current_buffer
->enable_multibyte_characters
= Qnil
;
4605 current_buffer
->undo_list
= Qt
;
4606 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4608 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4610 val
= call2 (Vset_auto_coding_function
,
4611 filename
, make_number (inserted
));
4616 /* If the coding system is not yet decided, check
4617 file-coding-system-alist. */
4618 Lisp_Object args
[6], coding_systems
;
4620 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4621 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4622 coding_systems
= Ffind_operation_coding_system (6, args
);
4623 if (CONSP (coding_systems
))
4624 val
= XCAR (coding_systems
);
4626 unbind_to (count
, Qnil
);
4627 inserted
= Z_BYTE
- BEG_BYTE
;
4630 /* The following kludgy code is to avoid some compiler bug.
4632 setup_coding_system (val, &coding);
4635 struct coding_system temp_coding
;
4636 setup_coding_system (Fcheck_coding_system (val
), &temp_coding
);
4637 bcopy (&temp_coding
, &coding
, sizeof coding
);
4639 /* Ensure we set Vlast_coding_system_used. */
4640 set_coding_system
= 1;
4642 if (NILP (current_buffer
->enable_multibyte_characters
)
4644 /* We must suppress all character code conversion except for
4645 end-of-line conversion. */
4646 setup_raw_text_coding_system (&coding
);
4647 coding
.src_multibyte
= 0;
4648 coding
.dst_multibyte
4649 = !NILP (current_buffer
->enable_multibyte_characters
);
4653 /* Can't do this if part of the buffer might be preserved. */
4655 && (coding
.type
== coding_type_no_conversion
4656 || coding
.type
== coding_type_raw_text
))
4658 /* Visiting a file with these coding system makes the buffer
4660 current_buffer
->enable_multibyte_characters
= Qnil
;
4661 coding
.dst_multibyte
= 0;
4664 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4666 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4668 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4670 inserted
= coding
.produced_char
;
4673 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4677 /* Now INSERTED is measured in characters. */
4680 /* Use the conversion type to determine buffer-file-type
4681 (find-buffer-file-type is now used to help determine the
4683 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4684 || coding
.eol_type
== CODING_EOL_LF
)
4685 && ! CODING_REQUIRE_DECODING (&coding
))
4686 current_buffer
->buffer_file_type
= Qt
;
4688 current_buffer
->buffer_file_type
= Qnil
;
4695 if (!EQ (current_buffer
->undo_list
, Qt
))
4696 current_buffer
->undo_list
= Qnil
;
4698 stat (SDATA (filename
), &st
);
4703 current_buffer
->modtime
= st
.st_mtime
;
4704 current_buffer
->filename
= orig_filename
;
4707 SAVE_MODIFF
= MODIFF
;
4708 current_buffer
->auto_save_modified
= MODIFF
;
4709 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4710 #ifdef CLASH_DETECTION
4713 if (!NILP (current_buffer
->file_truename
))
4714 unlock_file (current_buffer
->file_truename
);
4715 unlock_file (filename
);
4717 #endif /* CLASH_DETECTION */
4719 Fsignal (Qfile_error
,
4720 Fcons (build_string ("not a regular file"),
4721 Fcons (orig_filename
, Qnil
)));
4724 if (set_coding_system
)
4725 Vlast_coding_system_used
= coding
.symbol
;
4727 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4729 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4731 if (! NILP (insval
))
4733 CHECK_NUMBER (insval
);
4734 inserted
= XFASTINT (insval
);
4738 /* Decode file format */
4741 int empty_undo_list_p
= 0;
4743 /* If we're anyway going to discard undo information, don't
4744 record it in the first place. The buffer's undo list at this
4745 point is either nil or t when visiting a file. */
4748 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4749 current_buffer
->undo_list
= Qt
;
4752 insval
= call3 (Qformat_decode
,
4753 Qnil
, make_number (inserted
), visit
);
4754 CHECK_NUMBER (insval
);
4755 inserted
= XFASTINT (insval
);
4758 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4761 /* Call after-change hooks for the inserted text, aside from the case
4762 of normal visiting (not with REPLACE), which is done in a new buffer
4763 "before" the buffer is changed. */
4764 if (inserted
> 0 && total
> 0
4765 && (NILP (visit
) || !NILP (replace
)))
4767 signal_after_change (PT
, 0, inserted
);
4768 update_compositions (PT
, PT
, CHECK_BORDER
);
4771 p
= Vafter_insert_file_functions
;
4774 insval
= call1 (XCAR (p
), make_number (inserted
));
4777 CHECK_NUMBER (insval
);
4778 inserted
= XFASTINT (insval
);
4785 && current_buffer
->modtime
== -1)
4787 /* If visiting nonexistent file, return nil. */
4788 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4792 Fsignal (Qquit
, Qnil
);
4794 /* ??? Retval needs to be dealt with in all cases consistently. */
4796 val
= Fcons (orig_filename
,
4797 Fcons (make_number (inserted
),
4800 RETURN_UNGCPRO (unbind_to (count
, val
));
4803 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4804 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4805 Lisp_Object
, Lisp_Object
));
4807 /* If build_annotations switched buffers, switch back to BUF.
4808 Kill the temporary buffer that was selected in the meantime.
4810 Since this kill only the last temporary buffer, some buffers remain
4811 not killed if build_annotations switched buffers more than once.
4815 build_annotations_unwind (buf
)
4820 if (XBUFFER (buf
) == current_buffer
)
4822 tembuf
= Fcurrent_buffer ();
4824 Fkill_buffer (tembuf
);
4828 /* Decide the coding-system to encode the data with. */
4831 choose_write_coding_system (start
, end
, filename
,
4832 append
, visit
, lockname
, coding
)
4833 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4834 struct coding_system
*coding
;
4839 && NILP (Fstring_equal (current_buffer
->filename
,
4840 current_buffer
->auto_save_file_name
)))
4842 /* We use emacs-mule for auto saving... */
4843 setup_coding_system (Qemacs_mule
, coding
);
4844 /* ... but with the special flag to indicate not to strip off
4845 leading code of eight-bit-control chars. */
4847 goto done_setup_coding
;
4849 else if (!NILP (Vcoding_system_for_write
))
4851 val
= Vcoding_system_for_write
;
4852 if (coding_system_require_warning
4853 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4854 /* Confirm that VAL can surely encode the current region. */
4855 val
= call5 (Vselect_safe_coding_system_function
,
4856 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4861 /* If the variable `buffer-file-coding-system' is set locally,
4862 it means that the file was read with some kind of code
4863 conversion or the variable is explicitly set by users. We
4864 had better write it out with the same coding system even if
4865 `enable-multibyte-characters' is nil.
4867 If it is not set locally, we anyway have to convert EOL
4868 format if the default value of `buffer-file-coding-system'
4869 tells that it is not Unix-like (LF only) format. */
4870 int using_default_coding
= 0;
4871 int force_raw_text
= 0;
4873 val
= current_buffer
->buffer_file_coding_system
;
4875 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4878 if (NILP (current_buffer
->enable_multibyte_characters
))
4884 /* Check file-coding-system-alist. */
4885 Lisp_Object args
[7], coding_systems
;
4887 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4888 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4890 coding_systems
= Ffind_operation_coding_system (7, args
);
4891 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4892 val
= XCDR (coding_systems
);
4896 && !NILP (current_buffer
->buffer_file_coding_system
))
4898 /* If we still have not decided a coding system, use the
4899 default value of buffer-file-coding-system. */
4900 val
= current_buffer
->buffer_file_coding_system
;
4901 using_default_coding
= 1;
4905 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4906 /* Confirm that VAL can surely encode the current region. */
4907 val
= call5 (Vselect_safe_coding_system_function
,
4908 start
, end
, val
, Qnil
, filename
);
4910 setup_coding_system (Fcheck_coding_system (val
), coding
);
4911 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4912 && !using_default_coding
)
4914 if (! EQ (default_buffer_file_coding
.symbol
,
4915 buffer_defaults
.buffer_file_coding_system
))
4916 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4917 &default_buffer_file_coding
);
4918 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4920 Lisp_Object subsidiaries
;
4922 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4923 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4924 if (VECTORP (subsidiaries
)
4925 && XVECTOR (subsidiaries
)->size
== 3)
4927 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4932 setup_raw_text_coding_system (coding
);
4933 goto done_setup_coding
;
4936 setup_coding_system (Fcheck_coding_system (val
), coding
);
4939 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4940 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4943 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4944 "r\nFWrite region to file: \ni\ni\ni\np",
4945 doc
: /* Write current region into specified file.
4946 When called from a program, requires three arguments:
4947 START, END and FILENAME. START and END are normally buffer positions
4948 specifying the part of the buffer to write.
4949 If START is nil, that means to use the entire buffer contents.
4950 If START is a string, then output that string to the file
4951 instead of any buffer contents; END is ignored.
4953 Optional fourth argument APPEND if non-nil means
4954 append to existing file contents (if any). If it is an integer,
4955 seek to that offset in the file before writing.
4956 Optional fifth argument VISIT, if t or a string, means
4957 set the last-save-file-modtime of buffer to this file's modtime
4958 and mark buffer not modified.
4959 If VISIT is a string, it is a second file name;
4960 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4961 VISIT is also the file name to lock and unlock for clash detection.
4962 If VISIT is neither t nor nil nor a string,
4963 that means do not display the \"Wrote file\" message.
4964 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4965 use for locking and unlocking, overriding FILENAME and VISIT.
4966 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4967 for an existing file with the same name. If MUSTBENEW is `excl',
4968 that means to get an error if the file already exists; never overwrite.
4969 If MUSTBENEW is neither nil nor `excl', that means ask for
4970 confirmation before overwriting, but do go ahead and overwrite the file
4971 if the user confirms.
4973 This does code conversion according to the value of
4974 `coding-system-for-write', `buffer-file-coding-system', or
4975 `file-coding-system-alist', and sets the variable
4976 `last-coding-system-used' to the coding system actually used. */)
4977 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4978 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4983 const unsigned char *fn
;
4986 int count
= SPECPDL_INDEX ();
4989 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4991 Lisp_Object handler
;
4992 Lisp_Object visit_file
;
4993 Lisp_Object annotations
;
4994 Lisp_Object encoded_filename
;
4995 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4996 int quietly
= !NILP (visit
);
4997 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4998 struct buffer
*given_buffer
;
5000 int buffer_file_type
= O_BINARY
;
5002 struct coding_system coding
;
5004 if (current_buffer
->base_buffer
&& visiting
)
5005 error ("Cannot do file visiting in an indirect buffer");
5007 if (!NILP (start
) && !STRINGP (start
))
5008 validate_region (&start
, &end
);
5010 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
5012 filename
= Fexpand_file_name (filename
, Qnil
);
5014 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
5015 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
5017 if (STRINGP (visit
))
5018 visit_file
= Fexpand_file_name (visit
, Qnil
);
5020 visit_file
= filename
;
5022 if (NILP (lockname
))
5023 lockname
= visit_file
;
5027 /* If the file name has special constructs in it,
5028 call the corresponding file handler. */
5029 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
5030 /* If FILENAME has no handler, see if VISIT has one. */
5031 if (NILP (handler
) && STRINGP (visit
))
5032 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
5034 if (!NILP (handler
))
5037 val
= call6 (handler
, Qwrite_region
, start
, end
,
5038 filename
, append
, visit
);
5042 SAVE_MODIFF
= MODIFF
;
5043 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5044 current_buffer
->filename
= visit_file
;
5050 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
5052 /* Special kludge to simplify auto-saving. */
5055 XSETFASTINT (start
, BEG
);
5056 XSETFASTINT (end
, Z
);
5060 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
5061 count1
= SPECPDL_INDEX ();
5063 given_buffer
= current_buffer
;
5065 if (!STRINGP (start
))
5067 annotations
= build_annotations (start
, end
);
5069 if (current_buffer
!= given_buffer
)
5071 XSETFASTINT (start
, BEGV
);
5072 XSETFASTINT (end
, ZV
);
5078 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
5080 /* Decide the coding-system to encode the data with.
5081 We used to make this choice before calling build_annotations, but that
5082 leads to problems when a write-annotate-function takes care of
5083 unsavable chars (as was the case with X-Symbol). */
5084 choose_write_coding_system (start
, end
, filename
,
5085 append
, visit
, lockname
, &coding
);
5086 Vlast_coding_system_used
= coding
.symbol
;
5088 given_buffer
= current_buffer
;
5089 if (! STRINGP (start
))
5091 annotations
= build_annotations_2 (start
, end
,
5092 coding
.pre_write_conversion
, annotations
);
5093 if (current_buffer
!= given_buffer
)
5095 XSETFASTINT (start
, BEGV
);
5096 XSETFASTINT (end
, ZV
);
5100 #ifdef CLASH_DETECTION
5103 #if 0 /* This causes trouble for GNUS. */
5104 /* If we've locked this file for some other buffer,
5105 query before proceeding. */
5106 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5107 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5110 lock_file (lockname
);
5112 #endif /* CLASH_DETECTION */
5114 encoded_filename
= ENCODE_FILE (filename
);
5116 fn
= SDATA (encoded_filename
);
5120 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5121 #else /* not DOS_NT */
5122 desc
= emacs_open (fn
, O_WRONLY
, 0);
5123 #endif /* not DOS_NT */
5125 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5127 if (auto_saving
) /* Overwrite any previous version of autosave file */
5129 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5130 desc
= emacs_open (fn
, O_RDWR
, 0);
5132 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5133 ? SDATA (current_buffer
->filename
) : 0,
5136 else /* Write to temporary name and rename if no errors */
5138 Lisp_Object temp_name
;
5139 temp_name
= Ffile_name_directory (filename
);
5141 if (!NILP (temp_name
))
5143 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5144 build_string ("$$SAVE$$")));
5145 fname
= SDATA (filename
);
5146 fn
= SDATA (temp_name
);
5147 desc
= creat_copy_attrs (fname
, fn
);
5150 /* If we can't open the temporary file, try creating a new
5151 version of the original file. VMS "creat" creates a
5152 new version rather than truncating an existing file. */
5155 desc
= creat (fn
, 0666);
5156 #if 0 /* This can clobber an existing file and fail to replace it,
5157 if the user runs out of space. */
5160 /* We can't make a new version;
5161 try to truncate and rewrite existing version if any. */
5163 desc
= emacs_open (fn
, O_RDWR
, 0);
5169 desc
= creat (fn
, 0666);
5173 desc
= emacs_open (fn
,
5174 O_WRONLY
| O_CREAT
| buffer_file_type
5175 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5176 S_IREAD
| S_IWRITE
);
5177 #else /* not DOS_NT */
5178 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5179 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5180 auto_saving
? auto_save_mode_bits
: 0666);
5181 #endif /* not DOS_NT */
5182 #endif /* not VMS */
5186 #ifdef CLASH_DETECTION
5188 if (!auto_saving
) unlock_file (lockname
);
5190 #endif /* CLASH_DETECTION */
5192 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5195 record_unwind_protect (close_file_unwind
, make_number (desc
));
5197 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5201 if (NUMBERP (append
))
5202 ret
= lseek (desc
, XINT (append
), 1);
5204 ret
= lseek (desc
, 0, 2);
5207 #ifdef CLASH_DETECTION
5208 if (!auto_saving
) unlock_file (lockname
);
5209 #endif /* CLASH_DETECTION */
5211 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5219 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5220 * if we do writes that don't end with a carriage return. Furthermore
5221 * it cannot handle writes of more then 16K. The modified
5222 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5223 * this EXCEPT for the last record (iff it doesn't end with a carriage
5224 * return). This implies that if your buffer doesn't end with a carriage
5225 * return, you get one free... tough. However it also means that if
5226 * we make two calls to sys_write (a la the following code) you can
5227 * get one at the gap as well. The easiest way to fix this (honest)
5228 * is to move the gap to the next newline (or the end of the buffer).
5233 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5234 move_gap (find_next_newline (GPT
, 1));
5236 /* Whether VMS or not, we must move the gap to the next of newline
5237 when we must put designation sequences at beginning of line. */
5238 if (INTEGERP (start
)
5239 && coding
.type
== coding_type_iso2022
5240 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5241 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5243 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5244 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5245 move_gap_both (PT
, PT_BYTE
);
5246 SET_PT_BOTH (opoint
, opoint_byte
);
5253 if (STRINGP (start
))
5255 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5256 &annotations
, &coding
);
5259 else if (XINT (start
) != XINT (end
))
5261 tem
= CHAR_TO_BYTE (XINT (start
));
5263 if (XINT (start
) < GPT
)
5265 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5266 min (GPT
, XINT (end
)) - XINT (start
),
5267 &annotations
, &coding
);
5271 if (XINT (end
) > GPT
&& !failure
)
5273 tem
= max (XINT (start
), GPT
);
5274 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5275 &annotations
, &coding
);
5281 /* If file was empty, still need to write the annotations */
5282 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5283 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5287 if (CODING_REQUIRE_FLUSHING (&coding
)
5288 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5291 /* We have to flush out a data. */
5292 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5293 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5300 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5301 Disk full in NFS may be reported here. */
5302 /* mib says that closing the file will try to write as fast as NFS can do
5303 it, and that means the fsync here is not crucial for autosave files. */
5304 if (!auto_saving
&& !write_region_inhibit_fsync
&& fsync (desc
) < 0)
5306 /* If fsync fails with EINTR, don't treat that as serious. */
5308 failure
= 1, save_errno
= errno
;
5312 /* Spurious "file has changed on disk" warnings have been
5313 observed on Suns as well.
5314 It seems that `close' can change the modtime, under nfs.
5316 (This has supposedly been fixed in Sunos 4,
5317 but who knows about all the other machines with NFS?) */
5320 /* On VMS and APOLLO, must do the stat after the close
5321 since closing changes the modtime. */
5324 /* Recall that #if defined does not work on VMS. */
5331 /* NFS can report a write failure now. */
5332 if (emacs_close (desc
) < 0)
5333 failure
= 1, save_errno
= errno
;
5336 /* If we wrote to a temporary name and had no errors, rename to real name. */
5340 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5348 /* Discard the unwind protect for close_file_unwind. */
5349 specpdl_ptr
= specpdl
+ count1
;
5350 /* Restore the original current buffer. */
5351 visit_file
= unbind_to (count
, visit_file
);
5353 #ifdef CLASH_DETECTION
5355 unlock_file (lockname
);
5356 #endif /* CLASH_DETECTION */
5358 /* Do this before reporting IO error
5359 to avoid a "file has changed on disk" warning on
5360 next attempt to save. */
5362 current_buffer
->modtime
= st
.st_mtime
;
5365 error ("IO error writing %s: %s", SDATA (filename
),
5366 emacs_strerror (save_errno
));
5370 SAVE_MODIFF
= MODIFF
;
5371 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5372 current_buffer
->filename
= visit_file
;
5373 update_mode_lines
++;
5378 && ! NILP (Fstring_equal (current_buffer
->filename
,
5379 current_buffer
->auto_save_file_name
)))
5380 SAVE_MODIFF
= MODIFF
;
5386 message_with_string ((INTEGERP (append
)
5396 Lisp_Object
merge ();
5398 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5399 doc
: /* Return t if (car A) is numerically less than (car B). */)
5403 return Flss (Fcar (a
), Fcar (b
));
5406 /* Build the complete list of annotations appropriate for writing out
5407 the text between START and END, by calling all the functions in
5408 write-region-annotate-functions and merging the lists they return.
5409 If one of these functions switches to a different buffer, we assume
5410 that buffer contains altered text. Therefore, the caller must
5411 make sure to restore the current buffer in all cases,
5412 as save-excursion would do. */
5415 build_annotations (start
, end
)
5416 Lisp_Object start
, end
;
5418 Lisp_Object annotations
;
5420 struct gcpro gcpro1
, gcpro2
;
5421 Lisp_Object original_buffer
;
5422 int i
, used_global
= 0;
5424 XSETBUFFER (original_buffer
, current_buffer
);
5427 p
= Vwrite_region_annotate_functions
;
5428 GCPRO2 (annotations
, p
);
5431 struct buffer
*given_buffer
= current_buffer
;
5432 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5433 { /* Use the global value of the hook. */
5436 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5438 p
= Fappend (2, arg
);
5441 Vwrite_region_annotations_so_far
= annotations
;
5442 res
= call2 (XCAR (p
), start
, end
);
5443 /* If the function makes a different buffer current,
5444 assume that means this buffer contains altered text to be output.
5445 Reset START and END from the buffer bounds
5446 and discard all previous annotations because they should have
5447 been dealt with by this function. */
5448 if (current_buffer
!= given_buffer
)
5450 XSETFASTINT (start
, BEGV
);
5451 XSETFASTINT (end
, ZV
);
5454 Flength (res
); /* Check basic validity of return value */
5455 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5459 /* Now do the same for annotation functions implied by the file-format */
5460 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
5461 p
= current_buffer
->auto_save_file_format
;
5463 p
= current_buffer
->file_format
;
5464 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5466 struct buffer
*given_buffer
= current_buffer
;
5468 Vwrite_region_annotations_so_far
= annotations
;
5470 /* Value is either a list of annotations or nil if the function
5471 has written annotations to a temporary buffer, which is now
5473 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5474 original_buffer
, make_number (i
));
5475 if (current_buffer
!= given_buffer
)
5477 XSETFASTINT (start
, BEGV
);
5478 XSETFASTINT (end
, ZV
);
5483 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5491 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5492 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5494 struct gcpro gcpro1
;
5497 GCPRO1 (annotations
);
5498 /* At last, do the same for the function PRE_WRITE_CONVERSION
5499 implied by the current coding-system. */
5500 if (!NILP (pre_write_conversion
))
5502 struct buffer
*given_buffer
= current_buffer
;
5503 Vwrite_region_annotations_so_far
= annotations
;
5504 res
= call2 (pre_write_conversion
, start
, end
);
5506 annotations
= (current_buffer
!= given_buffer
5508 : merge (annotations
, res
, Qcar_less_than_car
));
5515 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5516 If STRING is nil, POS is the character position in the current buffer.
5517 Intersperse with them the annotations from *ANNOT
5518 which fall within the range of POS to POS + NCHARS,
5519 each at its appropriate position.
5521 We modify *ANNOT by discarding elements as we use them up.
5523 The return value is negative in case of system call failure. */
5526 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5529 register int nchars
;
5532 struct coding_system
*coding
;
5536 int lastpos
= pos
+ nchars
;
5538 while (NILP (*annot
) || CONSP (*annot
))
5540 tem
= Fcar_safe (Fcar (*annot
));
5543 nextpos
= XFASTINT (tem
);
5545 /* If there are no more annotations in this range,
5546 output the rest of the range all at once. */
5547 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5548 return e_write (desc
, string
, pos
, lastpos
, coding
);
5550 /* Output buffer text up to the next annotation's position. */
5553 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5557 /* Output the annotation. */
5558 tem
= Fcdr (Fcar (*annot
));
5561 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5564 *annot
= Fcdr (*annot
);
5569 #ifndef WRITE_BUF_SIZE
5570 #define WRITE_BUF_SIZE (16 * 1024)
5573 /* Write text in the range START and END into descriptor DESC,
5574 encoding them with coding system CODING. If STRING is nil, START
5575 and END are character positions of the current buffer, else they
5576 are indexes to the string STRING. */
5579 e_write (desc
, string
, start
, end
, coding
)
5583 struct coding_system
*coding
;
5585 register char *addr
;
5586 register int nbytes
;
5587 char buf
[WRITE_BUF_SIZE
];
5591 coding
->composing
= COMPOSITION_DISABLED
;
5592 if (coding
->composing
!= COMPOSITION_DISABLED
)
5593 coding_save_composition (coding
, start
, end
, string
);
5595 if (STRINGP (string
))
5597 addr
= SDATA (string
);
5598 nbytes
= SBYTES (string
);
5599 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5601 else if (start
< end
)
5603 /* It is assured that the gap is not in the range START and END-1. */
5604 addr
= CHAR_POS_ADDR (start
);
5605 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5606 coding
->src_multibyte
5607 = !NILP (current_buffer
->enable_multibyte_characters
);
5613 coding
->src_multibyte
= 1;
5616 /* We used to have a code for handling selective display here. But,
5617 now it is handled within encode_coding. */
5622 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5623 if (coding
->produced
> 0)
5625 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5626 if (coding
->produced
)
5632 nbytes
-= coding
->consumed
;
5633 addr
+= coding
->consumed
;
5634 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5637 /* The source text ends by an incomplete multibyte form.
5638 There's no way other than write it out as is. */
5639 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5648 start
+= coding
->consumed_char
;
5649 if (coding
->cmp_data
)
5650 coding_adjust_composition_offset (coding
, start
);
5653 if (coding
->cmp_data
)
5654 coding_free_composition_data (coding
);
5659 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5660 Sverify_visited_file_modtime
, 1, 1, 0,
5661 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5662 This means that the file has not been changed since it was visited or saved.
5663 See Info node `(elisp)Modification Time' for more details. */)
5669 Lisp_Object handler
;
5670 Lisp_Object filename
;
5675 if (!STRINGP (b
->filename
)) return Qt
;
5676 if (b
->modtime
== 0) return Qt
;
5678 /* If the file name has special constructs in it,
5679 call the corresponding file handler. */
5680 handler
= Ffind_file_name_handler (b
->filename
,
5681 Qverify_visited_file_modtime
);
5682 if (!NILP (handler
))
5683 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5685 filename
= ENCODE_FILE (b
->filename
);
5687 if (stat (SDATA (filename
), &st
) < 0)
5689 /* If the file doesn't exist now and didn't exist before,
5690 we say that it isn't modified, provided the error is a tame one. */
5691 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5696 if (st
.st_mtime
== b
->modtime
5697 /* If both are positive, accept them if they are off by one second. */
5698 || (st
.st_mtime
> 0 && b
->modtime
> 0
5699 && (st
.st_mtime
== b
->modtime
+ 1
5700 || st
.st_mtime
== b
->modtime
- 1)))
5705 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5706 Sclear_visited_file_modtime
, 0, 0, 0,
5707 doc
: /* Clear out records of last mod time of visited file.
5708 Next attempt to save will certainly not complain of a discrepancy. */)
5711 current_buffer
->modtime
= 0;
5715 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5716 Svisited_file_modtime
, 0, 0, 0,
5717 doc
: /* Return the current buffer's recorded visited file modification time.
5718 The value is a list of the form (HIGH LOW), like the time values
5719 that `file-attributes' returns. If the current buffer has no recorded
5720 file modification time, this function returns 0.
5721 See Info node `(elisp)Modification Time' for more details. */)
5725 tcons
= long_to_cons ((unsigned long) current_buffer
->modtime
);
5727 return list2 (XCAR (tcons
), XCDR (tcons
));
5731 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5732 Sset_visited_file_modtime
, 0, 1, 0,
5733 doc
: /* Update buffer's recorded modification time from the visited file's time.
5734 Useful if the buffer was not read from the file normally
5735 or if the file itself has been changed for some known benign reason.
5736 An argument specifies the modification time value to use
5737 \(instead of that of the visited file), in the form of a list
5738 \(HIGH . LOW) or (HIGH LOW). */)
5740 Lisp_Object time_list
;
5742 if (!NILP (time_list
))
5743 current_buffer
->modtime
= cons_to_long (time_list
);
5746 register Lisp_Object filename
;
5748 Lisp_Object handler
;
5750 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5752 /* If the file name has special constructs in it,
5753 call the corresponding file handler. */
5754 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5755 if (!NILP (handler
))
5756 /* The handler can find the file name the same way we did. */
5757 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5759 filename
= ENCODE_FILE (filename
);
5761 if (stat (SDATA (filename
), &st
) >= 0)
5762 current_buffer
->modtime
= st
.st_mtime
;
5769 auto_save_error (error
)
5772 Lisp_Object args
[3], msg
;
5774 struct gcpro gcpro1
;
5780 args
[0] = build_string ("Auto-saving %s: %s");
5781 args
[1] = current_buffer
->name
;
5782 args
[2] = Ferror_message_string (error
);
5783 msg
= Fformat (3, args
);
5785 nbytes
= SBYTES (msg
);
5786 SAFE_ALLOCA (msgbuf
, char *, nbytes
);
5787 bcopy (SDATA (msg
), msgbuf
, nbytes
);
5789 for (i
= 0; i
< 3; ++i
)
5792 message2 (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5794 message2_nolog (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5795 Fsleep_for (make_number (1), Qnil
);
5808 auto_save_mode_bits
= 0666;
5810 /* Get visited file's mode to become the auto save file's mode. */
5811 if (! NILP (current_buffer
->filename
))
5813 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5814 /* But make sure we can overwrite it later! */
5815 auto_save_mode_bits
= st
.st_mode
| 0600;
5816 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5818 /* Remote files don't cooperate with stat. */
5819 auto_save_mode_bits
= XINT (modes
) | 0600;
5823 Fwrite_region (Qnil
, Qnil
,
5824 current_buffer
->auto_save_file_name
,
5825 Qnil
, Qlambda
, Qnil
, Qnil
);
5829 do_auto_save_unwind (arg
) /* used as unwind-protect function */
5832 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
5840 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5843 minibuffer_auto_raise
= XINT (value
);
5848 do_auto_save_make_dir (dir
)
5851 return call2 (Qmake_directory
, dir
, Qt
);
5855 do_auto_save_eh (ignore
)
5861 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5862 doc
: /* Auto-save all buffers that need it.
5863 This is all buffers that have auto-saving enabled
5864 and are changed since last auto-saved.
5865 Auto-saving writes the buffer into a file
5866 so that your editing is not lost if the system crashes.
5867 This file is not the file you visited; that changes only when you save.
5868 Normally we run the normal hook `auto-save-hook' before saving.
5870 A non-nil NO-MESSAGE argument means do not print any message if successful.
5871 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5872 (no_message
, current_only
)
5873 Lisp_Object no_message
, current_only
;
5875 struct buffer
*old
= current_buffer
, *b
;
5876 Lisp_Object tail
, buf
;
5878 int do_handled_files
;
5880 FILE *stream
= NULL
;
5881 int count
= SPECPDL_INDEX ();
5882 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5883 int old_message_p
= 0;
5884 struct gcpro gcpro1
, gcpro2
;
5886 if (max_specpdl_size
< specpdl_size
+ 40)
5887 max_specpdl_size
= specpdl_size
+ 40;
5892 if (NILP (no_message
))
5894 old_message_p
= push_message ();
5895 record_unwind_protect (pop_message_unwind
, Qnil
);
5898 /* Ordinarily don't quit within this function,
5899 but don't make it impossible to quit (in case we get hung in I/O). */
5903 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5904 point to non-strings reached from Vbuffer_alist. */
5906 if (!NILP (Vrun_hooks
))
5907 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5909 if (STRINGP (Vauto_save_list_file_name
))
5911 Lisp_Object listfile
;
5913 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5915 /* Don't try to create the directory when shutting down Emacs,
5916 because creating the directory might signal an error, and
5917 that would leave Emacs in a strange state. */
5918 if (!NILP (Vrun_hooks
))
5922 GCPRO2 (dir
, listfile
);
5923 dir
= Ffile_name_directory (listfile
);
5924 if (NILP (Ffile_directory_p (dir
)))
5925 internal_condition_case_1 (do_auto_save_make_dir
,
5926 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5931 stream
= fopen (SDATA (listfile
), "w");
5934 record_unwind_protect (do_auto_save_unwind
,
5935 make_save_value (stream
, 0));
5936 record_unwind_protect (do_auto_save_unwind_1
,
5937 make_number (minibuffer_auto_raise
));
5938 minibuffer_auto_raise
= 0;
5941 /* On first pass, save all files that don't have handlers.
5942 On second pass, save all files that do have handlers.
5944 If Emacs is crashing, the handlers may tweak what is causing
5945 Emacs to crash in the first place, and it would be a shame if
5946 Emacs failed to autosave perfectly ordinary files because it
5947 couldn't handle some ange-ftp'd file. */
5949 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5950 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5952 buf
= XCDR (XCAR (tail
));
5955 /* Record all the buffers that have auto save mode
5956 in the special file that lists them. For each of these buffers,
5957 Record visited name (if any) and auto save name. */
5958 if (STRINGP (b
->auto_save_file_name
)
5959 && stream
!= NULL
&& do_handled_files
== 0)
5961 if (!NILP (b
->filename
))
5963 fwrite (SDATA (b
->filename
), 1,
5964 SBYTES (b
->filename
), stream
);
5966 putc ('\n', stream
);
5967 fwrite (SDATA (b
->auto_save_file_name
), 1,
5968 SBYTES (b
->auto_save_file_name
), stream
);
5969 putc ('\n', stream
);
5972 if (!NILP (current_only
)
5973 && b
!= current_buffer
)
5976 /* Don't auto-save indirect buffers.
5977 The base buffer takes care of it. */
5981 /* Check for auto save enabled
5982 and file changed since last auto save
5983 and file changed since last real save. */
5984 if (STRINGP (b
->auto_save_file_name
)
5985 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5986 && b
->auto_save_modified
< BUF_MODIFF (b
)
5987 /* -1 means we've turned off autosaving for a while--see below. */
5988 && XINT (b
->save_length
) >= 0
5989 && (do_handled_files
5990 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5993 EMACS_TIME before_time
, after_time
;
5995 EMACS_GET_TIME (before_time
);
5997 /* If we had a failure, don't try again for 20 minutes. */
5998 if (b
->auto_save_failure_time
>= 0
5999 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
6002 if ((XFASTINT (b
->save_length
) * 10
6003 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
6004 /* A short file is likely to change a large fraction;
6005 spare the user annoying messages. */
6006 && XFASTINT (b
->save_length
) > 5000
6007 /* These messages are frequent and annoying for `*mail*'. */
6008 && !EQ (b
->filename
, Qnil
)
6009 && NILP (no_message
))
6011 /* It has shrunk too much; turn off auto-saving here. */
6012 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
6013 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
6015 minibuffer_auto_raise
= 0;
6016 /* Turn off auto-saving until there's a real save,
6017 and prevent any more warnings. */
6018 XSETINT (b
->save_length
, -1);
6019 Fsleep_for (make_number (1), Qnil
);
6022 set_buffer_internal (b
);
6023 if (!auto_saved
&& NILP (no_message
))
6024 message1 ("Auto-saving...");
6025 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
6027 b
->auto_save_modified
= BUF_MODIFF (b
);
6028 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6029 set_buffer_internal (old
);
6031 EMACS_GET_TIME (after_time
);
6033 /* If auto-save took more than 60 seconds,
6034 assume it was an NFS failure that got a timeout. */
6035 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
6036 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
6040 /* Prevent another auto save till enough input events come in. */
6041 record_auto_save ();
6043 if (auto_saved
&& NILP (no_message
))
6047 /* If we are going to restore an old message,
6048 give time to read ours. */
6049 sit_for (1, 0, 0, 0, 0);
6053 /* If we displayed a message and then restored a state
6054 with no message, leave a "done" message on the screen. */
6055 message1 ("Auto-saving...done");
6060 /* This restores the message-stack status. */
6061 unbind_to (count
, Qnil
);
6065 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
6066 Sset_buffer_auto_saved
, 0, 0, 0,
6067 doc
: /* Mark current buffer as auto-saved with its current text.
6068 No auto-save file will be written until the buffer changes again. */)
6071 current_buffer
->auto_save_modified
= MODIFF
;
6072 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6073 current_buffer
->auto_save_failure_time
= -1;
6077 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
6078 Sclear_buffer_auto_save_failure
, 0, 0, 0,
6079 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
6082 current_buffer
->auto_save_failure_time
= -1;
6086 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6088 doc
: /* Return t if current buffer has been auto-saved recently.
6089 More precisely, if it has been auto-saved since last read from or saved
6090 in the visited file. If the buffer has no visited file,
6091 then any auto-save counts as "recent". */)
6094 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6097 /* Reading and completing file names */
6098 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
6100 /* In the string VAL, change each $ to $$ and return the result. */
6103 double_dollars (val
)
6106 register const unsigned char *old
;
6107 register unsigned char *new;
6111 osize
= SBYTES (val
);
6113 /* Count the number of $ characters. */
6114 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
6115 if (*old
++ == '$') count
++;
6119 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
6122 for (n
= osize
; n
> 0; n
--)
6136 read_file_name_cleanup (arg
)
6139 return (current_buffer
->directory
= arg
);
6142 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
6144 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
6145 (string
, dir
, action
)
6146 Lisp_Object string
, dir
, action
;
6147 /* action is nil for complete, t for return list of completions,
6148 lambda for verify final value */
6150 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
6152 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
6154 CHECK_STRING (string
);
6161 /* No need to protect ACTION--we only compare it with t and nil. */
6162 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6164 if (SCHARS (string
) == 0)
6166 if (EQ (action
, Qlambda
))
6174 orig_string
= string
;
6175 string
= Fsubstitute_in_file_name (string
);
6176 changed
= NILP (Fstring_equal (string
, orig_string
));
6177 name
= Ffile_name_nondirectory (string
);
6178 val
= Ffile_name_directory (string
);
6180 realdir
= Fexpand_file_name (val
, realdir
);
6185 specdir
= Ffile_name_directory (string
);
6186 val
= Ffile_name_completion (name
, realdir
);
6191 return double_dollars (string
);
6195 if (!NILP (specdir
))
6196 val
= concat2 (specdir
, val
);
6198 return double_dollars (val
);
6201 #endif /* not VMS */
6205 if (EQ (action
, Qt
))
6207 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6211 if (NILP (Vread_file_name_predicate
)
6212 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6216 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6218 /* Brute-force speed up for directory checking:
6219 Discard strings which don't end in a slash. */
6220 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6222 Lisp_Object tem
= XCAR (all
);
6224 if (STRINGP (tem
) &&
6225 (len
= SCHARS (tem
), len
> 0) &&
6226 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6227 comp
= Fcons (tem
, comp
);
6233 /* Must do it the hard (and slow) way. */
6234 GCPRO3 (all
, comp
, specdir
);
6235 count
= SPECPDL_INDEX ();
6236 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6237 current_buffer
->directory
= realdir
;
6238 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6239 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
6240 comp
= Fcons (XCAR (all
), comp
);
6241 unbind_to (count
, Qnil
);
6244 return Fnreverse (comp
);
6247 /* Only other case actually used is ACTION = lambda */
6249 /* Supposedly this helps commands such as `cd' that read directory names,
6250 but can someone explain how it helps them? -- RMS */
6251 if (SCHARS (name
) == 0)
6254 string
= Fexpand_file_name (string
, dir
);
6255 if (!NILP (Vread_file_name_predicate
))
6256 return call1 (Vread_file_name_predicate
, string
);
6257 return Ffile_exists_p (string
);
6260 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
6261 Snext_read_file_uses_dialog_p
, 0, 0, 0,
6262 doc
: /* Return t if a call to `read-file-name' will use a dialog.
6263 The return value is only relevant for a call to `read-file-name' that happens
6264 before any other event (mouse or keypress) is handeled. */)
6267 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6268 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6277 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6278 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6279 Value is not expanded---you must call `expand-file-name' yourself.
6280 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6281 the same non-empty string that was inserted by this function.
6282 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6283 except that if INITIAL is specified, that combined with DIR is used.)
6284 If the user exits with an empty minibuffer, this function returns
6285 an empty string. (This can only happen if the user erased the
6286 pre-inserted contents or if `insert-default-directory' is nil.)
6287 Fourth arg MUSTMATCH non-nil means require existing file's name.
6288 Non-nil and non-t means also require confirmation after completion.
6289 Fifth arg INITIAL specifies text to start with.
6290 If optional sixth arg PREDICATE is non-nil, possible completions and
6291 the resulting file name must satisfy (funcall PREDICATE NAME).
6292 DIR should be an absolute directory name. It defaults to the value of
6293 `default-directory'.
6295 If this command was invoked with the mouse, use a file dialog box if
6296 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6297 provides a file dialog box.
6299 See also `read-file-name-completion-ignore-case'
6300 and `read-file-name-function'. */)
6301 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6302 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6304 Lisp_Object val
, insdef
, tem
;
6305 struct gcpro gcpro1
, gcpro2
;
6306 register char *homedir
;
6307 Lisp_Object decoded_homedir
;
6308 int replace_in_history
= 0;
6309 int add_to_history
= 0;
6313 dir
= current_buffer
->directory
;
6314 if (NILP (Ffile_name_absolute_p (dir
)))
6315 dir
= Fexpand_file_name (dir
, Qnil
);
6316 if (NILP (default_filename
))
6319 ? Fexpand_file_name (initial
, dir
)
6320 : current_buffer
->filename
);
6322 /* If dir starts with user's homedir, change that to ~. */
6323 homedir
= (char *) egetenv ("HOME");
6325 /* homedir can be NULL in temacs, since Vprocess_environment is not
6326 yet set up. We shouldn't crash in that case. */
6329 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6330 CORRECT_DIR_SEPS (homedir
);
6335 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6338 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6339 SBYTES (decoded_homedir
))
6340 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6342 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6343 dir
= concat2 (build_string ("~"), dir
);
6345 /* Likewise for default_filename. */
6347 && STRINGP (default_filename
)
6348 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6349 SBYTES (decoded_homedir
))
6350 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6353 = Fsubstring (default_filename
,
6354 make_number (SCHARS (decoded_homedir
)), Qnil
);
6355 default_filename
= concat2 (build_string ("~"), default_filename
);
6357 if (!NILP (default_filename
))
6359 CHECK_STRING (default_filename
);
6360 default_filename
= double_dollars (default_filename
);
6363 if (insert_default_directory
&& STRINGP (dir
))
6366 if (!NILP (initial
))
6368 Lisp_Object args
[2], pos
;
6372 insdef
= Fconcat (2, args
);
6373 pos
= make_number (SCHARS (double_dollars (dir
)));
6374 insdef
= Fcons (double_dollars (insdef
), pos
);
6377 insdef
= double_dollars (insdef
);
6379 else if (STRINGP (initial
))
6380 insdef
= Fcons (double_dollars (initial
), make_number (0));
6384 if (!NILP (Vread_file_name_function
))
6386 Lisp_Object args
[7];
6388 GCPRO2 (insdef
, default_filename
);
6389 args
[0] = Vread_file_name_function
;
6392 args
[3] = default_filename
;
6393 args
[4] = mustmatch
;
6395 args
[6] = predicate
;
6396 RETURN_UNGCPRO (Ffuncall (7, args
));
6399 count
= SPECPDL_INDEX ();
6400 specbind (intern ("completion-ignore-case"),
6401 read_file_name_completion_ignore_case
? Qt
: Qnil
);
6402 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6403 specbind (intern ("read-file-name-predicate"),
6404 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6406 GCPRO2 (insdef
, default_filename
);
6408 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6409 if (! NILP (Fnext_read_file_uses_dialog_p ()))
6411 /* If DIR contains a file name, split it. */
6413 file
= Ffile_name_nondirectory (dir
);
6414 if (SCHARS (file
) && NILP (default_filename
))
6416 default_filename
= file
;
6417 dir
= Ffile_name_directory (dir
);
6419 if (!NILP(default_filename
))
6420 default_filename
= Fexpand_file_name (default_filename
, dir
);
6421 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
,
6422 EQ (predicate
, Qfile_directory_p
) ? Qt
: Qnil
);
6427 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6428 dir
, mustmatch
, insdef
,
6429 Qfile_name_history
, default_filename
, Qnil
);
6431 tem
= Fsymbol_value (Qfile_name_history
);
6432 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6433 replace_in_history
= 1;
6435 /* If Fcompleting_read returned the inserted default string itself
6436 (rather than a new string with the same contents),
6437 it has to mean that the user typed RET with the minibuffer empty.
6438 In that case, we really want to return ""
6439 so that commands such as set-visited-file-name can distinguish. */
6440 if (EQ (val
, default_filename
))
6442 /* In this case, Fcompleting_read has not added an element
6443 to the history. Maybe we should. */
6444 if (! replace_in_history
)
6450 unbind_to (count
, Qnil
);
6453 error ("No file name specified");
6455 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6457 if (!NILP (tem
) && !NILP (default_filename
))
6458 val
= default_filename
;
6459 val
= Fsubstitute_in_file_name (val
);
6461 if (replace_in_history
)
6462 /* Replace what Fcompleting_read added to the history
6463 with what we will actually return. */
6465 Lisp_Object val1
= double_dollars (val
);
6466 tem
= Fsymbol_value (Qfile_name_history
);
6467 if (history_delete_duplicates
)
6468 XSETCDR (tem
, Fdelete (val1
, XCDR(tem
)));
6469 XSETCAR (tem
, val1
);
6471 else if (add_to_history
)
6473 /* Add the value to the history--but not if it matches
6474 the last value already there. */
6475 Lisp_Object val1
= double_dollars (val
);
6476 tem
= Fsymbol_value (Qfile_name_history
);
6477 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6479 if (history_delete_duplicates
) tem
= Fdelete (val1
, tem
);
6480 Fset (Qfile_name_history
, Fcons (val1
, tem
));
6491 /* Must be set before any path manipulation is performed. */
6492 XSETFASTINT (Vdirectory_sep_char
, '/');
6499 Qoperations
= intern ("operations");
6500 Qexpand_file_name
= intern ("expand-file-name");
6501 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6502 Qdirectory_file_name
= intern ("directory-file-name");
6503 Qfile_name_directory
= intern ("file-name-directory");
6504 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6505 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6506 Qfile_name_as_directory
= intern ("file-name-as-directory");
6507 Qcopy_file
= intern ("copy-file");
6508 Qmake_directory_internal
= intern ("make-directory-internal");
6509 Qmake_directory
= intern ("make-directory");
6510 Qdelete_directory
= intern ("delete-directory");
6511 Qdelete_file
= intern ("delete-file");
6512 Qrename_file
= intern ("rename-file");
6513 Qadd_name_to_file
= intern ("add-name-to-file");
6514 Qmake_symbolic_link
= intern ("make-symbolic-link");
6515 Qfile_exists_p
= intern ("file-exists-p");
6516 Qfile_executable_p
= intern ("file-executable-p");
6517 Qfile_readable_p
= intern ("file-readable-p");
6518 Qfile_writable_p
= intern ("file-writable-p");
6519 Qfile_symlink_p
= intern ("file-symlink-p");
6520 Qaccess_file
= intern ("access-file");
6521 Qfile_directory_p
= intern ("file-directory-p");
6522 Qfile_regular_p
= intern ("file-regular-p");
6523 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6524 Qfile_modes
= intern ("file-modes");
6525 Qset_file_modes
= intern ("set-file-modes");
6526 Qset_file_times
= intern ("set-file-times");
6527 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6528 Qinsert_file_contents
= intern ("insert-file-contents");
6529 Qwrite_region
= intern ("write-region");
6530 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6531 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6532 Qauto_save_coding
= intern ("auto-save-coding");
6534 staticpro (&Qoperations
);
6535 staticpro (&Qexpand_file_name
);
6536 staticpro (&Qsubstitute_in_file_name
);
6537 staticpro (&Qdirectory_file_name
);
6538 staticpro (&Qfile_name_directory
);
6539 staticpro (&Qfile_name_nondirectory
);
6540 staticpro (&Qunhandled_file_name_directory
);
6541 staticpro (&Qfile_name_as_directory
);
6542 staticpro (&Qcopy_file
);
6543 staticpro (&Qmake_directory_internal
);
6544 staticpro (&Qmake_directory
);
6545 staticpro (&Qdelete_directory
);
6546 staticpro (&Qdelete_file
);
6547 staticpro (&Qrename_file
);
6548 staticpro (&Qadd_name_to_file
);
6549 staticpro (&Qmake_symbolic_link
);
6550 staticpro (&Qfile_exists_p
);
6551 staticpro (&Qfile_executable_p
);
6552 staticpro (&Qfile_readable_p
);
6553 staticpro (&Qfile_writable_p
);
6554 staticpro (&Qaccess_file
);
6555 staticpro (&Qfile_symlink_p
);
6556 staticpro (&Qfile_directory_p
);
6557 staticpro (&Qfile_regular_p
);
6558 staticpro (&Qfile_accessible_directory_p
);
6559 staticpro (&Qfile_modes
);
6560 staticpro (&Qset_file_modes
);
6561 staticpro (&Qset_file_times
);
6562 staticpro (&Qfile_newer_than_file_p
);
6563 staticpro (&Qinsert_file_contents
);
6564 staticpro (&Qwrite_region
);
6565 staticpro (&Qverify_visited_file_modtime
);
6566 staticpro (&Qset_visited_file_modtime
);
6567 staticpro (&Qauto_save_coding
);
6569 Qfile_name_history
= intern ("file-name-history");
6570 Fset (Qfile_name_history
, Qnil
);
6571 staticpro (&Qfile_name_history
);
6573 Qfile_error
= intern ("file-error");
6574 staticpro (&Qfile_error
);
6575 Qfile_already_exists
= intern ("file-already-exists");
6576 staticpro (&Qfile_already_exists
);
6577 Qfile_date_error
= intern ("file-date-error");
6578 staticpro (&Qfile_date_error
);
6579 Qexcl
= intern ("excl");
6583 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6584 staticpro (&Qfind_buffer_file_type
);
6587 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6588 doc
: /* *Coding system for encoding file names.
6589 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6590 Vfile_name_coding_system
= Qnil
;
6592 DEFVAR_LISP ("default-file-name-coding-system",
6593 &Vdefault_file_name_coding_system
,
6594 doc
: /* Default coding system for encoding file names.
6595 This variable is used only when `file-name-coding-system' is nil.
6597 This variable is set/changed by the command `set-language-environment'.
6598 User should not set this variable manually,
6599 instead use `file-name-coding-system' to get a constant encoding
6600 of file names regardless of the current language environment. */);
6601 Vdefault_file_name_coding_system
= Qnil
;
6603 Qformat_decode
= intern ("format-decode");
6604 staticpro (&Qformat_decode
);
6605 Qformat_annotate_function
= intern ("format-annotate-function");
6606 staticpro (&Qformat_annotate_function
);
6607 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6608 staticpro (&Qafter_insert_file_set_coding
);
6610 Qcar_less_than_car
= intern ("car-less-than-car");
6611 staticpro (&Qcar_less_than_car
);
6613 Fput (Qfile_error
, Qerror_conditions
,
6614 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6615 Fput (Qfile_error
, Qerror_message
,
6616 build_string ("File error"));
6618 Fput (Qfile_already_exists
, Qerror_conditions
,
6619 Fcons (Qfile_already_exists
,
6620 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6621 Fput (Qfile_already_exists
, Qerror_message
,
6622 build_string ("File already exists"));
6624 Fput (Qfile_date_error
, Qerror_conditions
,
6625 Fcons (Qfile_date_error
,
6626 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6627 Fput (Qfile_date_error
, Qerror_message
,
6628 build_string ("Cannot set file date"));
6630 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6631 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6632 Vread_file_name_function
= Qnil
;
6634 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6635 doc
: /* Current predicate used by `read-file-name-internal'. */);
6636 Vread_file_name_predicate
= Qnil
;
6638 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case
,
6639 doc
: /* *Non-nil means when reading a file name completion ignores case. */);
6640 #if defined VMS || defined DOS_NT || defined MAC_OS
6641 read_file_name_completion_ignore_case
= 1;
6643 read_file_name_completion_ignore_case
= 0;
6646 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6647 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6648 If the initial minibuffer contents are non-empty, you can usually
6649 request a default filename by typing RETURN without editing. For some
6650 commands, exiting with an empty minibuffer has a special meaning,
6651 such as making the current buffer visit no file in the case of
6652 `set-visited-file-name'.
6653 If this variable is non-nil, the minibuffer contents are always
6654 initially non-empty and typing RETURN without editing will fetch the
6655 default name, if one is provided. Note however that this default name
6656 is not necessarily the name originally inserted in the minibuffer, if
6657 that is just the default directory.
6658 If this variable is nil, the minibuffer often starts out empty. In
6659 that case you may have to explicitly fetch the next history element to
6660 request the default name. */);
6661 insert_default_directory
= 1;
6663 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6664 doc
: /* *Non-nil means write new files with record format `stmlf'.
6665 nil means use format `var'. This variable is meaningful only on VMS. */);
6666 vms_stmlf_recfm
= 0;
6668 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6669 doc
: /* Directory separator character for built-in functions that return file names.
6670 The value is always ?/. Don't use this variable, just use `/'. */);
6672 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6673 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6674 If a file name matches REGEXP, then all I/O on that file is done by calling
6677 The first argument given to HANDLER is the name of the I/O primitive
6678 to be handled; the remaining arguments are the arguments that were
6679 passed to that primitive. For example, if you do
6680 (file-exists-p FILENAME)
6681 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6682 (funcall HANDLER 'file-exists-p FILENAME)
6683 The function `find-file-name-handler' checks this list for a handler
6684 for its argument. */);
6685 Vfile_name_handler_alist
= Qnil
;
6687 DEFVAR_LISP ("set-auto-coding-function",
6688 &Vset_auto_coding_function
,
6689 doc
: /* If non-nil, a function to call to decide a coding system of file.
6690 Two arguments are passed to this function: the file name
6691 and the length of a file contents following the point.
6692 This function should return a coding system to decode the file contents.
6693 It should check the file name against `auto-coding-alist'.
6694 If no coding system is decided, it should check a coding system
6695 specified in the heading lines with the format:
6696 -*- ... coding: CODING-SYSTEM; ... -*-
6697 or local variable spec of the tailing lines with `coding:' tag. */);
6698 Vset_auto_coding_function
= Qnil
;
6700 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6701 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6702 Each is passed one argument, the number of characters inserted.
6703 It should return the new character count, and leave point the same.
6704 If `insert-file-contents' is intercepted by a handler from
6705 `file-name-handler-alist', that handler is responsible for calling the
6706 functions in `after-insert-file-functions' if appropriate. */);
6707 Vafter_insert_file_functions
= Qnil
;
6709 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6710 doc
: /* A list of functions to be called at the start of `write-region'.
6711 Each is passed two arguments, START and END as for `write-region'.
6712 These are usually two numbers but not always; see the documentation
6713 for `write-region'. The function should return a list of pairs
6714 of the form (POSITION . STRING), consisting of strings to be effectively
6715 inserted at the specified positions of the file being written (1 means to
6716 insert before the first byte written). The POSITIONs must be sorted into
6717 increasing order. If there are several functions in the list, the several
6718 lists are merged destructively. Alternatively, the function can return
6719 with a different buffer current; in that case it should pay attention
6720 to the annotations returned by previous functions and listed in
6721 `write-region-annotations-so-far'.*/);
6722 Vwrite_region_annotate_functions
= Qnil
;
6723 staticpro (&Qwrite_region_annotate_functions
);
6724 Qwrite_region_annotate_functions
6725 = intern ("write-region-annotate-functions");
6727 DEFVAR_LISP ("write-region-annotations-so-far",
6728 &Vwrite_region_annotations_so_far
,
6729 doc
: /* When an annotation function is called, this holds the previous annotations.
6730 These are the annotations made by other annotation functions
6731 that were already called. See also `write-region-annotate-functions'. */);
6732 Vwrite_region_annotations_so_far
= Qnil
;
6734 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6735 doc
: /* A list of file name handlers that temporarily should not be used.
6736 This applies only to the operation `inhibit-file-name-operation'. */);
6737 Vinhibit_file_name_handlers
= Qnil
;
6739 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6740 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6741 Vinhibit_file_name_operation
= Qnil
;
6743 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6744 doc
: /* File name in which we write a list of all auto save file names.
6745 This variable is initialized automatically from `auto-save-list-file-prefix'
6746 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6747 a non-nil value. */);
6748 Vauto_save_list_file_name
= Qnil
;
6751 DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync
,
6752 doc
: /* *Non-nil means don't call fsync in `write-region'.
6753 This variable affects calls to `write-region' as well as save commands.
6754 A non-nil value may result in data loss! */);
6755 write_region_inhibit_fsync
= 0;
6758 defsubr (&Sfind_file_name_handler
);
6759 defsubr (&Sfile_name_directory
);
6760 defsubr (&Sfile_name_nondirectory
);
6761 defsubr (&Sunhandled_file_name_directory
);
6762 defsubr (&Sfile_name_as_directory
);
6763 defsubr (&Sdirectory_file_name
);
6764 defsubr (&Smake_temp_name
);
6765 defsubr (&Sexpand_file_name
);
6766 defsubr (&Ssubstitute_in_file_name
);
6767 defsubr (&Scopy_file
);
6768 defsubr (&Smake_directory_internal
);
6769 defsubr (&Sdelete_directory
);
6770 defsubr (&Sdelete_file
);
6771 defsubr (&Srename_file
);
6772 defsubr (&Sadd_name_to_file
);
6774 defsubr (&Smake_symbolic_link
);
6775 #endif /* S_IFLNK */
6777 defsubr (&Sdefine_logical_name
);
6780 defsubr (&Ssysnetunam
);
6781 #endif /* HPUX_NET */
6782 defsubr (&Sfile_name_absolute_p
);
6783 defsubr (&Sfile_exists_p
);
6784 defsubr (&Sfile_executable_p
);
6785 defsubr (&Sfile_readable_p
);
6786 defsubr (&Sfile_writable_p
);
6787 defsubr (&Saccess_file
);
6788 defsubr (&Sfile_symlink_p
);
6789 defsubr (&Sfile_directory_p
);
6790 defsubr (&Sfile_accessible_directory_p
);
6791 defsubr (&Sfile_regular_p
);
6792 defsubr (&Sfile_modes
);
6793 defsubr (&Sset_file_modes
);
6794 defsubr (&Sset_file_times
);
6795 defsubr (&Sset_default_file_modes
);
6796 defsubr (&Sdefault_file_modes
);
6797 defsubr (&Sfile_newer_than_file_p
);
6798 defsubr (&Sinsert_file_contents
);
6799 defsubr (&Swrite_region
);
6800 defsubr (&Scar_less_than_car
);
6801 defsubr (&Sverify_visited_file_modtime
);
6802 defsubr (&Sclear_visited_file_modtime
);
6803 defsubr (&Svisited_file_modtime
);
6804 defsubr (&Sset_visited_file_modtime
);
6805 defsubr (&Sdo_auto_save
);
6806 defsubr (&Sset_buffer_auto_saved
);
6807 defsubr (&Sclear_buffer_auto_save_failure
);
6808 defsubr (&Srecent_auto_save_p
);
6810 defsubr (&Sread_file_name_internal
);
6811 defsubr (&Sread_file_name
);
6812 defsubr (&Snext_read_file_uses_dialog_p
);
6815 defsubr (&Sunix_sync
);
6819 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6820 (do not change this comment) */