1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996,
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3, or (at your option)
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
30 #include <sys/types.h>
37 #if !defined (S_ISLNK) && defined (S_IFLNK)
38 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
41 #if !defined (S_ISFIFO) && defined (S_IFIFO)
42 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
45 #if !defined (S_ISREG) && defined (S_IFREG)
46 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
75 #include "intervals.h"
80 #include "blockinput.h"
87 #endif /* not WINDOWSNT */
91 #include <sys/param.h>
99 #define CORRECT_DIR_SEPS(s) \
100 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
101 else unixtodos_filename (s); \
103 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
104 redirector allows the six letters between 'Z' and 'a' as well. */
106 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
109 #define IS_DRIVE(x) isalpha (x)
111 /* Need to lower-case the drive letter, or else expanded
112 filenames will sometimes compare inequal, because
113 `expand-file-name' doesn't always down-case the drive letter. */
114 #define DRIVE_LETTER(x) (tolower (x))
135 #include "commands.h"
136 extern int use_dialog_box
;
137 extern int use_file_dialog
;
151 #ifndef FILE_SYSTEM_CASE
152 #define FILE_SYSTEM_CASE(filename) (filename)
155 /* Nonzero during writing of auto-save files */
158 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
159 a new file with the same mode as the original */
160 int auto_save_mode_bits
;
162 /* The symbol bound to coding-system-for-read when
163 insert-file-contents is called for recovering a file. This is not
164 an actual coding system name, but just an indicator to tell
165 insert-file-contents to use `emacs-mule' with a special flag for
166 auto saving and recovering a file. */
167 Lisp_Object Qauto_save_coding
;
169 /* Coding system for file names, or nil if none. */
170 Lisp_Object Vfile_name_coding_system
;
172 /* Coding system for file names used only when
173 Vfile_name_coding_system is nil. */
174 Lisp_Object Vdefault_file_name_coding_system
;
176 /* Alist of elements (REGEXP . HANDLER) for file names
177 whose I/O is done with a special handler. */
178 Lisp_Object Vfile_name_handler_alist
;
180 /* Property name of a file name handler,
181 which gives a list of operations it handles.. */
182 Lisp_Object Qoperations
;
184 /* Lisp functions for translating file formats */
185 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
187 /* Function to be called to decide a coding system of a reading file. */
188 Lisp_Object Vset_auto_coding_function
;
190 /* Functions to be called to process text properties in inserted file. */
191 Lisp_Object Vafter_insert_file_functions
;
193 /* Lisp function for setting buffer-file-coding-system and the
194 multibyteness of the current buffer after inserting a file. */
195 Lisp_Object Qafter_insert_file_set_coding
;
197 /* Functions to be called to create text property annotations for file. */
198 Lisp_Object Vwrite_region_annotate_functions
;
199 Lisp_Object Qwrite_region_annotate_functions
;
201 /* During build_annotations, each time an annotation function is called,
202 this holds the annotations made by the previous functions. */
203 Lisp_Object Vwrite_region_annotations_so_far
;
205 /* File name in which we write a list of all our auto save files. */
206 Lisp_Object Vauto_save_list_file_name
;
208 /* Function to call to read a file name. */
209 Lisp_Object Vread_file_name_function
;
211 /* Current predicate used by read_file_name_internal. */
212 Lisp_Object Vread_file_name_predicate
;
214 /* Nonzero means completion ignores case when reading file name. */
215 int read_file_name_completion_ignore_case
;
217 /* Nonzero means, when reading a filename in the minibuffer,
218 start out by inserting the default directory into the minibuffer. */
219 int insert_default_directory
;
221 /* On VMS, nonzero means write new files with record format stmlf.
222 Zero means use var format. */
225 /* On NT, specifies the directory separator character, used (eg.) when
226 expanding file names. This can be bound to / or \. */
227 Lisp_Object Vdirectory_sep_char
;
230 /* Nonzero means skip the call to fsync in Fwrite-region. */
231 int write_region_inhibit_fsync
;
234 extern Lisp_Object Vuser_login_name
;
237 extern Lisp_Object Vw32_get_true_file_attributes
;
240 extern int minibuf_level
;
242 extern int minibuffer_auto_raise
;
244 extern int history_delete_duplicates
;
246 /* These variables describe handlers that have "already" had a chance
247 to handle the current operation.
249 Vinhibit_file_name_handlers is a list of file name handlers.
250 Vinhibit_file_name_operation is the operation being handled.
251 If we try to handle that operation, we ignore those handlers. */
253 static Lisp_Object Vinhibit_file_name_handlers
;
254 static Lisp_Object Vinhibit_file_name_operation
;
256 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
258 Lisp_Object Qfile_name_history
;
260 Lisp_Object Qcar_less_than_car
;
262 static int a_write
P_ ((int, Lisp_Object
, int, int,
263 Lisp_Object
*, struct coding_system
*));
264 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
268 report_file_error (string
, data
)
272 Lisp_Object errstring
;
275 synchronize_system_messages_locale ();
276 errstring
= code_convert_string_norecord (build_string (strerror (errorno
)),
277 Vlocale_coding_system
, 0);
283 xsignal (Qfile_already_exists
, Fcons (errstring
, data
));
286 /* System error messages are capitalized. Downcase the initial
287 unless it is followed by a slash. */
288 if (SREF (errstring
, 1) != '/')
289 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
291 xsignal (Qfile_error
,
292 Fcons (build_string (string
), Fcons (errstring
, data
)));
297 close_file_unwind (fd
)
300 emacs_close (XFASTINT (fd
));
304 /* Restore point, having saved it as a marker. */
307 restore_point_unwind (location
)
308 Lisp_Object location
;
310 Fgoto_char (location
);
311 Fset_marker (location
, Qnil
, Qnil
);
315 Lisp_Object Qexpand_file_name
;
316 Lisp_Object Qsubstitute_in_file_name
;
317 Lisp_Object Qdirectory_file_name
;
318 Lisp_Object Qfile_name_directory
;
319 Lisp_Object Qfile_name_nondirectory
;
320 Lisp_Object Qunhandled_file_name_directory
;
321 Lisp_Object Qfile_name_as_directory
;
322 Lisp_Object Qcopy_file
;
323 Lisp_Object Qmake_directory_internal
;
324 Lisp_Object Qmake_directory
;
325 Lisp_Object Qdelete_directory
;
326 Lisp_Object Qdelete_file
;
327 Lisp_Object Qrename_file
;
328 Lisp_Object Qadd_name_to_file
;
329 Lisp_Object Qmake_symbolic_link
;
330 Lisp_Object Qfile_exists_p
;
331 Lisp_Object Qfile_executable_p
;
332 Lisp_Object Qfile_readable_p
;
333 Lisp_Object Qfile_writable_p
;
334 Lisp_Object Qfile_symlink_p
;
335 Lisp_Object Qaccess_file
;
336 Lisp_Object Qfile_directory_p
;
337 Lisp_Object Qfile_regular_p
;
338 Lisp_Object Qfile_accessible_directory_p
;
339 Lisp_Object Qfile_modes
;
340 Lisp_Object Qset_file_modes
;
341 Lisp_Object Qset_file_times
;
342 Lisp_Object Qfile_newer_than_file_p
;
343 Lisp_Object Qinsert_file_contents
;
344 Lisp_Object Qwrite_region
;
345 Lisp_Object Qverify_visited_file_modtime
;
346 Lisp_Object Qset_visited_file_modtime
;
348 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
349 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
350 Otherwise, return nil.
351 A file name is handled if one of the regular expressions in
352 `file-name-handler-alist' matches it.
354 If OPERATION equals `inhibit-file-name-operation', then we ignore
355 any handlers that are members of `inhibit-file-name-handlers',
356 but we still do run any other handlers. This lets handlers
357 use the standard functions without calling themselves recursively. */)
358 (filename
, operation
)
359 Lisp_Object filename
, operation
;
361 /* This function must not munge the match data. */
362 Lisp_Object chain
, inhibited_handlers
, result
;
366 CHECK_STRING (filename
);
368 if (EQ (operation
, Vinhibit_file_name_operation
))
369 inhibited_handlers
= Vinhibit_file_name_handlers
;
371 inhibited_handlers
= Qnil
;
373 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
374 chain
= XCDR (chain
))
380 Lisp_Object string
= XCAR (elt
);
382 Lisp_Object handler
= XCDR (elt
);
383 Lisp_Object operations
= Qnil
;
385 if (SYMBOLP (handler
))
386 operations
= Fget (handler
, Qoperations
);
389 && (match_pos
= fast_string_match (string
, filename
)) > pos
390 && (NILP (operations
) || ! NILP (Fmemq (operation
, operations
))))
394 handler
= XCDR (elt
);
395 tem
= Fmemq (handler
, inhibited_handlers
);
409 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
411 doc
: /* Return the directory component in file name FILENAME.
412 Return nil if FILENAME does not include a directory.
413 Otherwise return a directory name.
414 Given a Unix syntax file name, returns a string ending in slash;
415 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
417 Lisp_Object filename
;
420 register const unsigned char *beg
;
422 register unsigned char *beg
;
424 register const unsigned char *p
;
427 CHECK_STRING (filename
);
429 /* If the file name has special constructs in it,
430 call the corresponding file handler. */
431 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
433 return call2 (handler
, Qfile_name_directory
, filename
);
435 filename
= FILE_SYSTEM_CASE (filename
);
436 beg
= SDATA (filename
);
438 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
440 p
= beg
+ SBYTES (filename
);
442 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
444 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
447 /* only recognise drive specifier at the beginning */
449 /* handle the "/:d:foo" and "/:foo" cases correctly */
450 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
451 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
458 /* Expansion of "c:" to drive and default directory. */
461 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
462 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
463 unsigned char *r
= res
;
465 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
467 strncpy (res
, beg
, 2);
472 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
474 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
477 p
= beg
+ strlen (beg
);
480 CORRECT_DIR_SEPS (beg
);
483 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
486 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
487 Sfile_name_nondirectory
, 1, 1, 0,
488 doc
: /* Return file name FILENAME sans its directory.
489 For example, in a Unix-syntax file name,
490 this is everything after the last slash,
491 or the entire name if it contains no slash. */)
493 Lisp_Object filename
;
495 register const unsigned char *beg
, *p
, *end
;
498 CHECK_STRING (filename
);
500 /* If the file name has special constructs in it,
501 call the corresponding file handler. */
502 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
504 return call2 (handler
, Qfile_name_nondirectory
, filename
);
506 beg
= SDATA (filename
);
507 end
= p
= beg
+ SBYTES (filename
);
509 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
511 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
514 /* only recognise drive specifier at beginning */
516 /* handle the "/:d:foo" case correctly */
517 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
522 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
525 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
526 Sunhandled_file_name_directory
, 1, 1, 0,
527 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
528 A `directly usable' directory name is one that may be used without the
529 intervention of any file handler.
530 If FILENAME is a directly usable file itself, return
531 \(file-name-directory FILENAME).
532 The `call-process' and `start-process' functions use this function to
533 get a current directory to run processes in. */)
535 Lisp_Object filename
;
539 /* If the file name has special constructs in it,
540 call the corresponding file handler. */
541 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
543 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
545 return Ffile_name_directory (filename
);
550 file_name_as_directory (out
, in
)
553 int size
= strlen (in
) - 1;
566 /* Is it already a directory string? */
567 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
569 /* Is it a VMS directory file name? If so, hack VMS syntax. */
570 else if (! index (in
, '/')
571 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
572 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
573 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
574 || ! strncmp (&in
[size
- 5], ".dir", 4))
575 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
576 && in
[size
] == '1')))
578 register char *p
, *dot
;
582 dir:x.dir --> dir:[x]
583 dir:[x]y.dir --> dir:[x.y] */
585 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
588 strncpy (out
, in
, p
- in
);
607 dot
= index (p
, '.');
610 /* blindly remove any extension */
611 size
= strlen (out
) + (dot
- p
);
612 strncat (out
, p
, dot
- p
);
623 /* For Unix syntax, Append a slash if necessary */
624 if (!IS_DIRECTORY_SEP (out
[size
]))
626 /* Cannot use DIRECTORY_SEP, which could have any value */
628 out
[size
+ 2] = '\0';
631 CORRECT_DIR_SEPS (out
);
637 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
638 Sfile_name_as_directory
, 1, 1, 0,
639 doc
: /* Return a string representing the file name FILE interpreted as a directory.
640 This operation exists because a directory is also a file, but its name as
641 a directory is different from its name as a file.
642 The result can be used as the value of `default-directory'
643 or passed as second argument to `expand-file-name'.
644 For a Unix-syntax file name, just appends a slash.
645 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
656 /* If the file name has special constructs in it,
657 call the corresponding file handler. */
658 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
660 return call2 (handler
, Qfile_name_as_directory
, file
);
662 buf
= (char *) alloca (SBYTES (file
) + 10);
663 file_name_as_directory (buf
, SDATA (file
));
664 return make_specified_string (buf
, -1, strlen (buf
),
665 STRING_MULTIBYTE (file
));
669 * Convert from directory name to filename.
671 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
672 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
673 * On UNIX, it's simple: just make sure there isn't a terminating /
675 * Value is nonzero if the string output is different from the input.
679 directory_file_name (src
, dst
)
687 struct FAB fab
= cc$rms_fab
;
688 struct NAM nam
= cc$rms_nam
;
689 char esa
[NAM$C_MAXRSS
];
694 if (! index (src
, '/')
695 && (src
[slen
- 1] == ']'
696 || src
[slen
- 1] == ':'
697 || src
[slen
- 1] == '>'))
699 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
701 fab
.fab$b_fns
= slen
;
702 fab
.fab$l_nam
= &nam
;
703 fab
.fab$l_fop
= FAB$M_NAM
;
706 nam
.nam$b_ess
= sizeof esa
;
707 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
709 /* We call SYS$PARSE to handle such things as [--] for us. */
710 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
712 slen
= nam
.nam$b_esl
;
713 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
718 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
720 /* what about when we have logical_name:???? */
721 if (src
[slen
- 1] == ':')
722 { /* Xlate logical name and see what we get */
723 ptr
= strcpy (dst
, src
); /* upper case for getenv */
726 if ('a' <= *ptr
&& *ptr
<= 'z')
730 dst
[slen
- 1] = 0; /* remove colon */
731 if (!(src
= egetenv (dst
)))
733 /* should we jump to the beginning of this procedure?
734 Good points: allows us to use logical names that xlate
736 Bad points: can be a problem if we just translated to a device
738 For now, I'll punt and always expect VMS names, and hope for
741 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
742 { /* no recursion here! */
748 { /* not a directory spec */
753 bracket
= src
[slen
- 1];
755 /* If bracket is ']' or '>', bracket - 2 is the corresponding
757 ptr
= index (src
, bracket
- 2);
759 { /* no opening bracket */
763 if (!(rptr
= rindex (src
, '.')))
766 strncpy (dst
, src
, slen
);
770 dst
[slen
++] = bracket
;
775 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
776 then translate the device and recurse. */
777 if (dst
[slen
- 1] == ':'
778 && dst
[slen
- 2] != ':' /* skip decnet nodes */
779 && strcmp (src
+ slen
, "[000000]") == 0)
781 dst
[slen
- 1] = '\0';
782 if ((ptr
= egetenv (dst
))
783 && (rlen
= strlen (ptr
) - 1) > 0
784 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
785 && ptr
[rlen
- 1] == '.')
787 char * buf
= (char *) alloca (strlen (ptr
) + 1);
791 return directory_file_name (buf
, dst
);
796 strcat (dst
, "[000000]");
800 rlen
= strlen (rptr
) - 1;
801 strncat (dst
, rptr
, rlen
);
802 dst
[slen
+ rlen
] = '\0';
803 strcat (dst
, ".DIR.1");
807 /* Process as Unix format: just remove any final slash.
808 But leave "/" unchanged; do not change it to "". */
811 /* Handle // as root for apollo's. */
812 if ((slen
> 2 && dst
[slen
- 1] == '/')
813 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
817 && IS_DIRECTORY_SEP (dst
[slen
- 1])
819 && !IS_ANY_SEP (dst
[slen
- 2])
825 CORRECT_DIR_SEPS (dst
);
830 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
832 doc
: /* Returns the file name of the directory named DIRECTORY.
833 This is the name of the file that holds the data for the directory DIRECTORY.
834 This operation exists because a directory is also a file, but its name as
835 a directory is different from its name as a file.
836 In Unix-syntax, this function just removes the final slash.
837 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
838 it returns a file name such as \"[X]Y.DIR.1\". */)
840 Lisp_Object directory
;
845 CHECK_STRING (directory
);
847 if (NILP (directory
))
850 /* If the file name has special constructs in it,
851 call the corresponding file handler. */
852 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
854 return call2 (handler
, Qdirectory_file_name
, directory
);
857 /* 20 extra chars is insufficient for VMS, since we might perform a
858 logical name translation. an equivalence string can be up to 255
859 chars long, so grab that much extra space... - sss */
860 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
862 buf
= (char *) alloca (SBYTES (directory
) + 20);
864 directory_file_name (SDATA (directory
), buf
);
865 return make_specified_string (buf
, -1, strlen (buf
),
866 STRING_MULTIBYTE (directory
));
869 static char make_temp_name_tbl
[64] =
871 'A','B','C','D','E','F','G','H',
872 'I','J','K','L','M','N','O','P',
873 'Q','R','S','T','U','V','W','X',
874 'Y','Z','a','b','c','d','e','f',
875 'g','h','i','j','k','l','m','n',
876 'o','p','q','r','s','t','u','v',
877 'w','x','y','z','0','1','2','3',
878 '4','5','6','7','8','9','-','_'
881 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
883 /* Value is a temporary file name starting with PREFIX, a string.
885 The Emacs process number forms part of the result, so there is
886 no danger of generating a name being used by another process.
887 In addition, this function makes an attempt to choose a name
888 which has no existing file. To make this work, PREFIX should be
889 an absolute file name.
891 BASE64_P non-zero means add the pid as 3 characters in base64
892 encoding. In this case, 6 characters will be added to PREFIX to
893 form the file name. Otherwise, if Emacs is running on a system
894 with long file names, add the pid as a decimal number.
896 This function signals an error if no unique file name could be
900 make_temp_name (prefix
, base64_p
)
907 unsigned char *p
, *data
;
911 CHECK_STRING (prefix
);
913 /* VAL is created by adding 6 characters to PREFIX. The first
914 three are the PID of this process, in base 64, and the second
915 three are incremented if the file already exists. This ensures
916 262144 unique file names per PID per PREFIX. */
918 pid
= (int) getpid ();
922 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
923 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
924 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
929 #ifdef HAVE_LONG_FILE_NAMES
930 sprintf (pidbuf
, "%d", pid
);
931 pidlen
= strlen (pidbuf
);
933 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
934 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
935 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
940 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
941 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
942 if (!STRING_MULTIBYTE (prefix
))
943 STRING_SET_UNIBYTE (val
);
945 bcopy(SDATA (prefix
), data
, len
);
948 bcopy (pidbuf
, p
, pidlen
);
951 /* Here we try to minimize useless stat'ing when this function is
952 invoked many times successively with the same PREFIX. We achieve
953 this by initializing count to a random value, and incrementing it
956 We don't want make-temp-name to be called while dumping,
957 because then make_temp_name_count_initialized_p would get set
958 and then make_temp_name_count would not be set when Emacs starts. */
960 if (!make_temp_name_count_initialized_p
)
962 make_temp_name_count
= (unsigned) time (NULL
);
963 make_temp_name_count_initialized_p
= 1;
969 unsigned num
= make_temp_name_count
;
971 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
972 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
973 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
975 /* Poor man's congruential RN generator. Replace with
976 ++make_temp_name_count for debugging. */
977 make_temp_name_count
+= 25229;
978 make_temp_name_count
%= 225307;
980 if (stat (data
, &ignored
) < 0)
982 /* We want to return only if errno is ENOENT. */
986 /* The error here is dubious, but there is little else we
987 can do. The alternatives are to return nil, which is
988 as bad as (and in many cases worse than) throwing the
989 error, or to ignore the error, which will likely result
990 in looping through 225307 stat's, which is not only
991 dog-slow, but also useless since it will fallback to
992 the errow below, anyway. */
993 report_file_error ("Cannot create temporary name for prefix",
994 Fcons (prefix
, Qnil
));
999 error ("Cannot create temporary name for prefix `%s'",
1005 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
1006 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
1007 The Emacs process number forms part of the result,
1008 so there is no danger of generating a name being used by another process.
1010 In addition, this function makes an attempt to choose a name
1011 which has no existing file. To make this work,
1012 PREFIX should be an absolute file name.
1014 There is a race condition between calling `make-temp-name' and creating the
1015 file which opens all kinds of security holes. For that reason, you should
1016 probably use `make-temp-file' instead, except in three circumstances:
1018 * If you are creating the file in the user's home directory.
1019 * If you are creating a directory rather than an ordinary file.
1020 * If you are taking special precautions as `make-temp-file' does. */)
1024 return make_temp_name (prefix
, 0);
1029 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1030 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1031 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1032 \(does not start with slash or tilde); if DEFAULT-DIRECTORY is nil or missing,
1033 the current buffer's value of `default-directory' is used.
1034 File name components that are `.' are removed, and
1035 so are file name components followed by `..', along with the `..' itself;
1036 note that these simplifications are done without checking the resulting
1037 file names in the file system.
1038 An initial `~/' expands to your home directory.
1039 An initial `~USER/' expands to USER's home directory.
1040 See also the function `substitute-in-file-name'. */)
1041 (name
, default_directory
)
1042 Lisp_Object name
, default_directory
;
1046 register unsigned char *newdir
, *p
, *o
;
1048 unsigned char *target
;
1051 unsigned char * colon
= 0;
1052 unsigned char * close
= 0;
1053 unsigned char * slash
= 0;
1054 unsigned char * brack
= 0;
1055 int lbrack
= 0, rbrack
= 0;
1060 int collapse_newdir
= 1;
1064 Lisp_Object handler
, result
;
1067 CHECK_STRING (name
);
1069 /* If the file name has special constructs in it,
1070 call the corresponding file handler. */
1071 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1072 if (!NILP (handler
))
1073 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1075 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1076 if (NILP (default_directory
))
1077 default_directory
= current_buffer
->directory
;
1078 if (! STRINGP (default_directory
))
1081 /* "/" is not considered a root directory on DOS_NT, so using "/"
1082 here causes an infinite recursion in, e.g., the following:
1084 (let (default-directory)
1085 (expand-file-name "a"))
1087 To avoid this, we set default_directory to the root of the
1089 extern char *emacs_root_dir (void);
1091 default_directory
= build_string (emacs_root_dir ());
1093 default_directory
= build_string ("/");
1097 if (!NILP (default_directory
))
1099 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1100 if (!NILP (handler
))
1101 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1104 o
= SDATA (default_directory
);
1106 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1107 It would be better to do this down below where we actually use
1108 default_directory. Unfortunately, calling Fexpand_file_name recursively
1109 could invoke GC, and the strings might be relocated. This would
1110 be annoying because we have pointers into strings lying around
1111 that would need adjusting, and people would add new pointers to
1112 the code and forget to adjust them, resulting in intermittent bugs.
1113 Putting this call here avoids all that crud.
1115 The EQ test avoids infinite recursion. */
1116 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1117 /* Save time in some common cases - as long as default_directory
1118 is not relative, it can be canonicalized with name below (if it
1119 is needed at all) without requiring it to be expanded now. */
1121 /* Detect MSDOS file names with drive specifiers. */
1122 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1124 /* Detect Windows file names in UNC format. */
1125 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1127 #else /* not DOS_NT */
1128 /* Detect Unix absolute file names (/... alone is not absolute on
1130 && ! (IS_DIRECTORY_SEP (o
[0]))
1131 #endif /* not DOS_NT */
1134 struct gcpro gcpro1
;
1137 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1141 name
= FILE_SYSTEM_CASE (name
);
1143 multibyte
= STRING_MULTIBYTE (name
);
1146 /* We will force directory separators to be either all \ or /, so make
1147 a local copy to modify, even if there ends up being no change. */
1148 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1150 /* Note if special escape prefix is present, but remove for now. */
1151 if (nm
[0] == '/' && nm
[1] == ':')
1157 /* Find and remove drive specifier if present; this makes nm absolute
1158 even if the rest of the name appears to be relative. Only look for
1159 drive specifier at the beginning. */
1160 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1167 /* If we see "c://somedir", we want to strip the first slash after the
1168 colon when stripping the drive letter. Otherwise, this expands to
1170 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1172 #endif /* WINDOWSNT */
1176 /* Discard any previous drive specifier if nm is now in UNC format. */
1177 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1183 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1184 none are found, we can probably return right away. We will avoid
1185 allocating a new string if name is already fully expanded. */
1187 IS_DIRECTORY_SEP (nm
[0])
1189 && drive
&& !is_escaped
1192 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1199 /* If it turns out that the filename we want to return is just a
1200 suffix of FILENAME, we don't need to go through and edit
1201 things; we just need to construct a new string using data
1202 starting at the middle of FILENAME. If we set lose to a
1203 non-zero value, that means we've discovered that we can't do
1210 /* Since we know the name is absolute, we can assume that each
1211 element starts with a "/". */
1213 /* "." and ".." are hairy. */
1214 if (IS_DIRECTORY_SEP (p
[0])
1216 && (IS_DIRECTORY_SEP (p
[2])
1218 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1221 /* We want to replace multiple `/' in a row with a single
1224 && IS_DIRECTORY_SEP (p
[0])
1225 && IS_DIRECTORY_SEP (p
[1]))
1232 /* if dev:[dir]/, move nm to / */
1233 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1234 nm
= (brack
? brack
+ 1 : colon
+ 1);
1235 lbrack
= rbrack
= 0;
1242 #ifdef NO_HYPHENS_IN_FILENAMES
1243 if (lbrack
== rbrack
)
1245 /* Avoid clobbering negative version numbers. */
1250 #endif /* NO_HYPHENS_IN_FILENAMES */
1252 && ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<')
1253 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1255 #ifdef NO_HYPHENS_IN_FILENAMES
1258 #endif /* NO_HYPHENS_IN_FILENAMES */
1259 /* count open brackets, reset close bracket pointer */
1260 if (p
[0] == '[' || p
[0] == '<')
1261 lbrack
++, brack
= 0;
1262 /* count close brackets, set close bracket pointer */
1263 if (p
[0] == ']' || p
[0] == '>')
1264 rbrack
++, brack
= p
;
1265 /* detect ][ or >< */
1266 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1268 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1269 nm
= p
+ 1, lose
= 1;
1270 if (p
[0] == ':' && (colon
|| slash
))
1271 /* if dev1:[dir]dev2:, move nm to dev2: */
1277 /* if /name/dev:, move nm to dev: */
1280 /* if node::dev:, move colon following dev */
1281 else if (colon
&& colon
[-1] == ':')
1283 /* if dev1:dev2:, move nm to dev2: */
1284 else if (colon
&& colon
[-1] != ':')
1289 if (p
[0] == ':' && !colon
)
1295 if (lbrack
== rbrack
)
1298 else if (p
[0] == '.')
1306 if (index (nm
, '/'))
1308 nm
= sys_translate_unix (nm
);
1309 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1313 /* Make sure directories are all separated with / or \ as
1314 desired, but avoid allocation of a new string when not
1316 CORRECT_DIR_SEPS (nm
);
1318 if (IS_DIRECTORY_SEP (nm
[1]))
1320 if (strcmp (nm
, SDATA (name
)) != 0)
1321 name
= make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1325 /* drive must be set, so this is okay */
1326 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1330 name
= make_specified_string (nm
, -1, p
- nm
, multibyte
);
1331 temp
[0] = DRIVE_LETTER (drive
);
1332 name
= concat2 (build_string (temp
), name
);
1335 #else /* not DOS_NT */
1336 if (nm
== SDATA (name
))
1338 return make_specified_string (nm
, -1, strlen (nm
), multibyte
);
1339 #endif /* not DOS_NT */
1343 /* At this point, nm might or might not be an absolute file name. We
1344 need to expand ~ or ~user if present, otherwise prefix nm with
1345 default_directory if nm is not absolute, and finally collapse /./
1346 and /foo/../ sequences.
1348 We set newdir to be the appropriate prefix if one is needed:
1349 - the relevant user directory if nm starts with ~ or ~user
1350 - the specified drive's working dir (DOS/NT only) if nm does not
1352 - the value of default_directory.
1354 Note that these prefixes are not guaranteed to be absolute (except
1355 for the working dir of a drive). Therefore, to ensure we always
1356 return an absolute name, if the final prefix is not absolute we
1357 append it to the current working directory. */
1361 if (nm
[0] == '~') /* prefix ~ */
1363 if (IS_DIRECTORY_SEP (nm
[1])
1367 || nm
[1] == 0) /* ~ by itself */
1369 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1370 newdir
= (unsigned char *) "";
1373 collapse_newdir
= 0;
1376 nm
++; /* Don't leave the slash in nm. */
1379 else /* ~user/filename */
1381 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1386 o
= (unsigned char *) alloca (p
- nm
+ 1);
1387 bcopy ((char *) nm
, o
, p
- nm
);
1391 pw
= (struct passwd
*) getpwnam (o
+ 1);
1395 newdir
= (unsigned char *) pw
-> pw_dir
;
1397 nm
= p
+ 1; /* skip the terminator */
1401 collapse_newdir
= 0;
1406 /* If we don't find a user of that name, leave the name
1407 unchanged; don't move nm forward to p. */
1412 /* On DOS and Windows, nm is absolute if a drive name was specified;
1413 use the drive's current directory as the prefix if needed. */
1414 if (!newdir
&& drive
)
1416 /* Get default directory if needed to make nm absolute. */
1417 if (!IS_DIRECTORY_SEP (nm
[0]))
1419 newdir
= alloca (MAXPATHLEN
+ 1);
1420 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1425 /* Either nm starts with /, or drive isn't mounted. */
1426 newdir
= alloca (4);
1427 newdir
[0] = DRIVE_LETTER (drive
);
1435 /* Finally, if no prefix has been specified and nm is not absolute,
1436 then it must be expanded relative to default_directory. */
1440 /* /... alone is not absolute on DOS and Windows. */
1441 && !IS_DIRECTORY_SEP (nm
[0])
1444 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1451 newdir
= SDATA (default_directory
);
1452 multibyte
|= STRING_MULTIBYTE (default_directory
);
1454 /* Note if special escape prefix is present, but remove for now. */
1455 if (newdir
[0] == '/' && newdir
[1] == ':')
1466 /* First ensure newdir is an absolute name. */
1468 /* Detect MSDOS file names with drive specifiers. */
1469 ! (IS_DRIVE (newdir
[0])
1470 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1472 /* Detect Windows file names in UNC format. */
1473 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1477 /* Effectively, let newdir be (expand-file-name newdir cwd).
1478 Because of the admonition against calling expand-file-name
1479 when we have pointers into lisp strings, we accomplish this
1480 indirectly by prepending newdir to nm if necessary, and using
1481 cwd (or the wd of newdir's drive) as the new newdir. */
1483 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1488 if (!IS_DIRECTORY_SEP (nm
[0]))
1490 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1491 file_name_as_directory (tmp
, newdir
);
1495 newdir
= alloca (MAXPATHLEN
+ 1);
1498 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1505 /* Strip off drive name from prefix, if present. */
1506 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1512 /* Keep only a prefix from newdir if nm starts with slash
1513 (//server/share for UNC, nothing otherwise). */
1514 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1517 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1519 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1521 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1523 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1535 /* Get rid of any slash at the end of newdir, unless newdir is
1536 just / or // (an incomplete UNC name). */
1537 length
= strlen (newdir
);
1538 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1540 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1544 unsigned char *temp
= (unsigned char *) alloca (length
);
1545 bcopy (newdir
, temp
, length
- 1);
1546 temp
[length
- 1] = 0;
1554 /* Now concatenate the directory and name to new space in the stack frame */
1555 tlen
+= strlen (nm
) + 1;
1557 /* Reserve space for drive specifier and escape prefix, since either
1558 or both may need to be inserted. (The Microsoft x86 compiler
1559 produces incorrect code if the following two lines are combined.) */
1560 target
= (unsigned char *) alloca (tlen
+ 4);
1562 #else /* not DOS_NT */
1563 target
= (unsigned char *) alloca (tlen
);
1564 #endif /* not DOS_NT */
1570 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1573 /* If newdir is effectively "C:/", then the drive letter will have
1574 been stripped and newdir will be "/". Concatenating with an
1575 absolute directory in nm produces "//", which will then be
1576 incorrectly treated as a network share. Ignore newdir in
1577 this case (keeping the drive letter). */
1578 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1579 && newdir
[1] == '\0'))
1581 strcpy (target
, newdir
);
1585 file_name_as_directory (target
, newdir
);
1588 strcat (target
, nm
);
1590 if (index (target
, '/'))
1591 strcpy (target
, sys_translate_unix (target
));
1594 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1596 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1605 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1611 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1612 /* brackets are offset from each other by 2 */
1615 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1616 /* convert [foo][bar] to [bar] */
1617 while (o
[-1] != '[' && o
[-1] != '<')
1619 else if (*p
== '-' && *o
!= '.')
1622 else if (p
[0] == '-' && o
[-1] == '.'
1623 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1624 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1628 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1629 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1631 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1633 /* else [foo.-] ==> [-] */
1637 #ifdef NO_HYPHENS_IN_FILENAMES
1639 && o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.'
1640 && p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1642 #endif /* NO_HYPHENS_IN_FILENAMES */
1646 if (!IS_DIRECTORY_SEP (*p
))
1650 else if (p
[1] == '.'
1651 && (IS_DIRECTORY_SEP (p
[2])
1654 /* If "/." is the entire filename, keep the "/". Otherwise,
1655 just delete the whole "/.". */
1656 if (o
== target
&& p
[2] == '\0')
1660 else if (p
[1] == '.' && p
[2] == '.'
1661 /* `/../' is the "superroot" on certain file systems.
1662 Turned off on DOS_NT systems because they have no
1663 "superroot" and because this causes us to produce
1664 file names like "d:/../foo" which fail file-related
1665 functions of the underlying OS. (To reproduce, try a
1666 long series of "../../" in default_directory, longer
1667 than the number of levels from the root.) */
1671 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1673 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1675 /* Keep initial / only if this is the whole name. */
1676 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1680 else if (p
> target
&& IS_DIRECTORY_SEP (p
[1]))
1681 /* Collapse multiple `/' in a row. */
1687 #endif /* not VMS */
1691 /* At last, set drive name. */
1693 /* Except for network file name. */
1694 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1695 #endif /* WINDOWSNT */
1697 if (!drive
) abort ();
1699 target
[0] = DRIVE_LETTER (drive
);
1702 /* Reinsert the escape prefix if required. */
1709 CORRECT_DIR_SEPS (target
);
1712 result
= make_specified_string (target
, -1, o
- target
, multibyte
);
1714 /* Again look to see if the file name has special constructs in it
1715 and perhaps call the corresponding file handler. This is needed
1716 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1717 the ".." component gives us "/user@host:/bar/../baz" which needs
1718 to be expanded again. */
1719 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1720 if (!NILP (handler
))
1721 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1727 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1728 This is the old version of expand-file-name, before it was thoroughly
1729 rewritten for Emacs 10.31. We leave this version here commented-out,
1730 because the code is very complex and likely to have subtle bugs. If
1731 bugs _are_ found, it might be of interest to look at the old code and
1732 see what did it do in the relevant situation.
1734 Don't remove this code: it's true that it will be accessible via CVS,
1735 but a few years from deletion, people will forget it is there. */
1737 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1738 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1739 "Convert FILENAME to absolute, and canonicalize it.\n\
1740 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1741 \(does not start with slash); if DEFAULT is nil or missing,\n\
1742 the current buffer's value of default-directory is used.\n\
1743 Filenames containing `.' or `..' as components are simplified;\n\
1744 initial `~/' expands to your home directory.\n\
1745 See also the function `substitute-in-file-name'.")
1747 Lisp_Object name
, defalt
;
1751 register unsigned char *newdir
, *p
, *o
;
1753 unsigned char *target
;
1757 unsigned char * colon
= 0;
1758 unsigned char * close
= 0;
1759 unsigned char * slash
= 0;
1760 unsigned char * brack
= 0;
1761 int lbrack
= 0, rbrack
= 0;
1765 CHECK_STRING (name
);
1768 /* Filenames on VMS are always upper case. */
1769 name
= Fupcase (name
);
1774 /* If nm is absolute, flush ...// and detect /./ and /../.
1775 If no /./ or /../ we can return right away. */
1787 if (p
[0] == '/' && p
[1] == '/'
1789 /* // at start of filename is meaningful on Apollo system. */
1794 if (p
[0] == '/' && p
[1] == '~')
1795 nm
= p
+ 1, lose
= 1;
1796 if (p
[0] == '/' && p
[1] == '.'
1797 && (p
[2] == '/' || p
[2] == 0
1798 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1804 /* if dev:[dir]/, move nm to / */
1805 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1806 nm
= (brack
? brack
+ 1 : colon
+ 1);
1807 lbrack
= rbrack
= 0;
1815 /* VMS pre V4.4,convert '-'s in filenames. */
1816 if (lbrack
== rbrack
)
1818 if (dots
< 2) /* this is to allow negative version numbers */
1824 && ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<')
1825 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1831 /* count open brackets, reset close bracket pointer */
1832 if (p
[0] == '[' || p
[0] == '<')
1833 lbrack
++, brack
= 0;
1834 /* count close brackets, set close bracket pointer */
1835 if (p
[0] == ']' || p
[0] == '>')
1836 rbrack
++, brack
= p
;
1837 /* detect ][ or >< */
1838 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1840 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1841 nm
= p
+ 1, lose
= 1;
1842 if (p
[0] == ':' && (colon
|| slash
))
1843 /* if dev1:[dir]dev2:, move nm to dev2: */
1849 /* If /name/dev:, move nm to dev: */
1852 /* If node::dev:, move colon following dev */
1853 else if (colon
&& colon
[-1] == ':')
1855 /* If dev1:dev2:, move nm to dev2: */
1856 else if (colon
&& colon
[-1] != ':')
1861 if (p
[0] == ':' && !colon
)
1867 if (lbrack
== rbrack
)
1870 else if (p
[0] == '.')
1878 if (index (nm
, '/'))
1879 return build_string (sys_translate_unix (nm
));
1881 if (nm
== SDATA (name
))
1883 return build_string (nm
);
1887 /* Now determine directory to start with and put it in NEWDIR */
1891 if (nm
[0] == '~') /* prefix ~ */
1896 || nm
[1] == 0)/* ~/filename */
1898 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1899 newdir
= (unsigned char *) "";
1902 nm
++; /* Don't leave the slash in nm. */
1905 else /* ~user/filename */
1907 /* Get past ~ to user */
1908 unsigned char *user
= nm
+ 1;
1909 /* Find end of name. */
1910 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1911 int len
= ptr
? ptr
- user
: strlen (user
);
1913 unsigned char *ptr1
= index (user
, ':');
1914 if (ptr1
!= 0 && ptr1
- user
< len
)
1917 /* Copy the user name into temp storage. */
1918 o
= (unsigned char *) alloca (len
+ 1);
1919 bcopy ((char *) user
, o
, len
);
1922 /* Look up the user name. */
1924 pw
= (struct passwd
*) getpwnam (o
+ 1);
1927 error ("\"%s\" isn't a registered user", o
+ 1);
1929 newdir
= (unsigned char *) pw
->pw_dir
;
1931 /* Discard the user name from NM. */
1938 #endif /* not VMS */
1942 defalt
= current_buffer
->directory
;
1943 CHECK_STRING (defalt
);
1944 newdir
= SDATA (defalt
);
1947 /* Now concatenate the directory and name to new space in the stack frame */
1949 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1950 target
= (unsigned char *) alloca (tlen
);
1956 if (nm
[0] == 0 || nm
[0] == '/')
1957 strcpy (target
, newdir
);
1960 file_name_as_directory (target
, newdir
);
1963 strcat (target
, nm
);
1965 if (index (target
, '/'))
1966 strcpy (target
, sys_translate_unix (target
));
1969 /* Now canonicalize by removing /. and /foo/.. if they appear */
1977 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1983 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1984 /* brackets are offset from each other by 2 */
1987 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1988 /* convert [foo][bar] to [bar] */
1989 while (o
[-1] != '[' && o
[-1] != '<')
1991 else if (*p
== '-' && *o
!= '.')
1994 else if (p
[0] == '-' && o
[-1] == '.'
1995 && (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1996 /* flush .foo.- ; leave - if stopped by '[' or '<' */
2000 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
2001 if (p
[1] == '.') /* foo.-.bar ==> bar. */
2003 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
2005 /* else [foo.-] ==> [-] */
2011 && o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.'
2012 && p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2022 else if (!strncmp (p
, "//", 2)
2024 /* // at start of filename is meaningful in Apollo system. */
2032 else if (p
[0] == '/' && p
[1] == '.'
2033 && (p
[2] == '/' || p
[2] == 0))
2035 else if (!strncmp (p
, "/..", 3)
2036 /* `/../' is the "superroot" on certain file systems. */
2038 && (p
[3] == '/' || p
[3] == 0))
2040 while (o
!= target
&& *--o
!= '/')
2043 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2047 if (o
== target
&& *o
== '/')
2055 #endif /* not VMS */
2058 return make_string (target
, o
- target
);
2062 /* If /~ or // appears, discard everything through first slash. */
2064 file_name_absolute_p (filename
)
2065 const unsigned char *filename
;
2068 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
2070 /* ??? This criterion is probably wrong for '<'. */
2071 || index (filename
, ':') || index (filename
, '<')
2072 || (*filename
== '[' && (filename
[1] != '-'
2073 || (filename
[2] != '.' && filename
[2] != ']'))
2074 && filename
[1] != '.')
2077 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
2078 && IS_DIRECTORY_SEP (filename
[2]))
2083 static unsigned char *
2084 search_embedded_absfilename (nm
, endp
)
2085 unsigned char *nm
, *endp
;
2087 unsigned char *p
, *s
;
2089 for (p
= nm
+ 1; p
< endp
; p
++)
2093 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2095 || IS_DIRECTORY_SEP (p
[-1]))
2096 && file_name_absolute_p (p
)
2097 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2098 /* // at start of file name is meaningful in Apollo,
2099 WindowsNT and Cygwin systems. */
2100 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
2101 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2104 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2109 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2111 unsigned char *o
= alloca (s
- p
+ 1);
2113 bcopy (p
, o
, s
- p
);
2116 /* If we have ~user and `user' exists, discard
2117 everything up to ~. But if `user' does not exist, leave
2118 ~user alone, it might be a literal file name. */
2120 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 xsignal2 (Qfile_already_exists
,
2388 build_string ("File already exists"), absname
);
2390 tem
= format2 ("File %s already exists; %s anyway? ",
2391 absname
, build_string (querystring
));
2393 tem
= Fy_or_n_p (tem
);
2395 tem
= do_yes_or_no_p (tem
);
2398 xsignal2 (Qfile_already_exists
,
2399 build_string ("File already exists"), absname
);
2406 statptr
->st_mode
= 0;
2411 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 5,
2412 "fCopy file: \nGCopy %s to file: \np\nP",
2413 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2414 If NEWNAME names a directory, copy FILE there.
2416 This function always sets the file modes of the output file to match
2419 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
2420 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
2421 signal a `file-already-exists' error without overwriting. If
2422 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
2423 about overwriting; this is what happens in interactive use with M-x.
2424 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
2427 Fourth arg KEEP-TIME non-nil means give the output file the same
2428 last-modified time as the old one. (This works on only some systems.)
2430 A prefix arg makes KEEP-TIME non-nil.
2432 If PRESERVE-UID-GID is non-nil, we try to transfer the
2433 uid and gid of FILE to NEWNAME. */)
2434 (file
, newname
, ok_if_already_exists
, keep_time
, preserve_uid_gid
)
2435 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2436 Lisp_Object preserve_uid_gid
;
2439 char buf
[16 * 1024];
2440 struct stat st
, out_st
;
2441 Lisp_Object handler
;
2442 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2443 int count
= SPECPDL_INDEX ();
2444 int input_file_statable_p
;
2445 Lisp_Object encoded_file
, encoded_newname
;
2447 encoded_file
= encoded_newname
= Qnil
;
2448 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2449 CHECK_STRING (file
);
2450 CHECK_STRING (newname
);
2452 if (!NILP (Ffile_directory_p (newname
)))
2453 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2455 newname
= Fexpand_file_name (newname
, Qnil
);
2457 file
= Fexpand_file_name (file
, Qnil
);
2459 /* If the input file name has special constructs in it,
2460 call the corresponding file handler. */
2461 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2462 /* Likewise for output file name. */
2464 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2465 if (!NILP (handler
))
2466 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2467 ok_if_already_exists
, keep_time
));
2469 encoded_file
= ENCODE_FILE (file
);
2470 encoded_newname
= ENCODE_FILE (newname
);
2472 if (NILP (ok_if_already_exists
)
2473 || INTEGERP (ok_if_already_exists
))
2474 barf_or_query_if_file_exists (newname
, "copy to it",
2475 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2476 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2480 if (!CopyFile (SDATA (encoded_file
),
2481 SDATA (encoded_newname
),
2483 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2484 /* CopyFile retains the timestamp by default. */
2485 else if (NILP (keep_time
))
2491 EMACS_GET_TIME (now
);
2492 filename
= SDATA (encoded_newname
);
2494 /* Ensure file is writable while its modified time is set. */
2495 attributes
= GetFileAttributes (filename
);
2496 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2497 if (set_file_times (filename
, now
, now
))
2499 /* Restore original attributes. */
2500 SetFileAttributes (filename
, attributes
);
2501 xsignal2 (Qfile_date_error
,
2502 build_string ("Cannot set file date"), newname
);
2504 /* Restore original attributes. */
2505 SetFileAttributes (filename
, attributes
);
2507 #else /* not WINDOWSNT */
2509 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2513 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2515 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2517 /* We can only copy regular files and symbolic links. Other files are not
2519 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2521 #if !defined (MSDOS) || __DJGPP__ > 1
2522 if (out_st
.st_mode
!= 0
2523 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2526 report_file_error ("Input and output files are the same",
2527 Fcons (file
, Fcons (newname
, Qnil
)));
2531 #if defined (S_ISREG) && defined (S_ISLNK)
2532 if (input_file_statable_p
)
2534 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2536 #if defined (EISDIR)
2537 /* Get a better looking error message. */
2540 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2543 #endif /* S_ISREG && S_ISLNK */
2546 /* Create the copy file with the same record format as the input file */
2547 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2550 /* System's default file type was set to binary by _fmode in emacs.c. */
2551 ofd
= emacs_open (SDATA (encoded_newname
),
2552 O_WRONLY
| O_TRUNC
| O_CREAT
2553 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2554 S_IREAD
| S_IWRITE
);
2555 #else /* not MSDOS */
2556 ofd
= emacs_open (SDATA (encoded_newname
),
2557 O_WRONLY
| O_TRUNC
| O_CREAT
2558 | (NILP (ok_if_already_exists
) ? O_EXCL
: 0),
2560 #endif /* not MSDOS */
2563 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2565 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2569 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2570 if (emacs_write (ofd
, buf
, n
) != n
)
2571 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2575 /* Preserve the original file modes, and if requested, also its
2577 if (input_file_statable_p
)
2579 if (! NILP (preserve_uid_gid
))
2580 fchown (ofd
, st
.st_uid
, st
.st_gid
);
2581 fchmod (ofd
, st
.st_mode
& 07777);
2583 #endif /* not MSDOS */
2585 /* Closing the output clobbers the file times on some systems. */
2586 if (emacs_close (ofd
) < 0)
2587 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2589 if (input_file_statable_p
)
2591 if (!NILP (keep_time
))
2593 EMACS_TIME atime
, mtime
;
2594 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2595 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2596 if (set_file_times (SDATA (encoded_newname
),
2598 xsignal2 (Qfile_date_error
,
2599 build_string ("Cannot set file date"), newname
);
2605 #if defined (__DJGPP__) && __DJGPP__ > 1
2606 if (input_file_statable_p
)
2608 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2609 and if it can't, it tells so. Otherwise, under MSDOS we usually
2610 get only the READ bit, which will make the copied file read-only,
2611 so it's better not to chmod at all. */
2612 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2613 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2615 #endif /* DJGPP version 2 or newer */
2616 #endif /* not WINDOWSNT */
2618 /* Discard the unwind protects. */
2619 specpdl_ptr
= specpdl
+ count
;
2625 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2626 Smake_directory_internal
, 1, 1, 0,
2627 doc
: /* Create a new directory named DIRECTORY. */)
2629 Lisp_Object directory
;
2631 const unsigned char *dir
;
2632 Lisp_Object handler
;
2633 Lisp_Object encoded_dir
;
2635 CHECK_STRING (directory
);
2636 directory
= Fexpand_file_name (directory
, Qnil
);
2638 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2639 if (!NILP (handler
))
2640 return call2 (handler
, Qmake_directory_internal
, directory
);
2642 encoded_dir
= ENCODE_FILE (directory
);
2644 dir
= SDATA (encoded_dir
);
2647 if (mkdir (dir
) != 0)
2649 if (mkdir (dir
, 0777) != 0)
2651 report_file_error ("Creating directory", list1 (directory
));
2656 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2657 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2659 Lisp_Object directory
;
2661 const unsigned char *dir
;
2662 Lisp_Object handler
;
2663 Lisp_Object encoded_dir
;
2665 CHECK_STRING (directory
);
2666 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2668 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2669 if (!NILP (handler
))
2670 return call2 (handler
, Qdelete_directory
, directory
);
2672 encoded_dir
= ENCODE_FILE (directory
);
2674 dir
= SDATA (encoded_dir
);
2676 if (rmdir (dir
) != 0)
2677 report_file_error ("Removing directory", list1 (directory
));
2682 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2683 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2684 If file has multiple names, it continues to exist with the other names. */)
2686 Lisp_Object filename
;
2688 Lisp_Object handler
;
2689 Lisp_Object encoded_file
;
2690 struct gcpro gcpro1
;
2693 if (!NILP (Ffile_directory_p (filename
))
2694 && NILP (Ffile_symlink_p (filename
)))
2695 xsignal2 (Qfile_error
,
2696 build_string ("Removing old name: is a directory"),
2699 filename
= Fexpand_file_name (filename
, Qnil
);
2701 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2702 if (!NILP (handler
))
2703 return call2 (handler
, Qdelete_file
, filename
);
2705 encoded_file
= ENCODE_FILE (filename
);
2707 if (0 > unlink (SDATA (encoded_file
)))
2708 report_file_error ("Removing old name", list1 (filename
));
2713 internal_delete_file_1 (ignore
)
2719 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2722 internal_delete_file (filename
)
2723 Lisp_Object filename
;
2726 tem
= internal_condition_case_1 (Fdelete_file
, filename
,
2727 Qt
, internal_delete_file_1
);
2731 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2732 "fRename file: \nGRename %s to file: \np",
2733 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2734 If file has names other than FILE, it continues to have those names.
2735 Signals a `file-already-exists' error if a file NEWNAME already exists
2736 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2737 A number as third arg means request confirmation if NEWNAME already exists.
2738 This is what happens in interactive use with M-x. */)
2739 (file
, newname
, ok_if_already_exists
)
2740 Lisp_Object file
, newname
, ok_if_already_exists
;
2742 Lisp_Object handler
;
2743 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2744 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2746 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2747 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2748 CHECK_STRING (file
);
2749 CHECK_STRING (newname
);
2750 file
= Fexpand_file_name (file
, Qnil
);
2752 if ((!NILP (Ffile_directory_p (newname
)))
2754 /* If the file names are identical but for the case,
2755 don't attempt to move directory to itself. */
2756 && (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2759 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2761 newname
= Fexpand_file_name (newname
, Qnil
);
2763 /* If the file name has special constructs in it,
2764 call the corresponding file handler. */
2765 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2767 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2768 if (!NILP (handler
))
2769 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2770 file
, newname
, ok_if_already_exists
));
2772 encoded_file
= ENCODE_FILE (file
);
2773 encoded_newname
= ENCODE_FILE (newname
);
2776 /* If the file names are identical but for the case, don't ask for
2777 confirmation: they simply want to change the letter-case of the
2779 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2781 if (NILP (ok_if_already_exists
)
2782 || INTEGERP (ok_if_already_exists
))
2783 barf_or_query_if_file_exists (newname
, "rename to it",
2784 INTEGERP (ok_if_already_exists
), 0, 0);
2786 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2788 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2789 || 0 > unlink (SDATA (encoded_file
)))
2795 symlink_target
= Ffile_symlink_p (file
);
2796 if (! NILP (symlink_target
))
2797 Fmake_symbolic_link (symlink_target
, newname
,
2798 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2801 Fcopy_file (file
, newname
,
2802 /* We have already prompted if it was an integer,
2803 so don't have copy-file prompt again. */
2804 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2807 Fdelete_file (file
);
2810 report_file_error ("Renaming", list2 (file
, newname
));
2816 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2817 "fAdd name to file: \nGName to add to %s: \np",
2818 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2819 Signals a `file-already-exists' error if a file NEWNAME already exists
2820 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2821 A number as third arg means request confirmation if NEWNAME already exists.
2822 This is what happens in interactive use with M-x. */)
2823 (file
, newname
, ok_if_already_exists
)
2824 Lisp_Object file
, newname
, ok_if_already_exists
;
2826 Lisp_Object handler
;
2827 Lisp_Object encoded_file
, encoded_newname
;
2828 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2830 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2831 encoded_file
= encoded_newname
= Qnil
;
2832 CHECK_STRING (file
);
2833 CHECK_STRING (newname
);
2834 file
= Fexpand_file_name (file
, Qnil
);
2836 if (!NILP (Ffile_directory_p (newname
)))
2837 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2839 newname
= Fexpand_file_name (newname
, Qnil
);
2841 /* If the file name has special constructs in it,
2842 call the corresponding file handler. */
2843 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2844 if (!NILP (handler
))
2845 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2846 newname
, ok_if_already_exists
));
2848 /* If the new name has special constructs in it,
2849 call the corresponding file handler. */
2850 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2851 if (!NILP (handler
))
2852 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2853 newname
, ok_if_already_exists
));
2855 encoded_file
= ENCODE_FILE (file
);
2856 encoded_newname
= ENCODE_FILE (newname
);
2858 if (NILP (ok_if_already_exists
)
2859 || INTEGERP (ok_if_already_exists
))
2860 barf_or_query_if_file_exists (newname
, "make it a new name",
2861 INTEGERP (ok_if_already_exists
), 0, 0);
2863 unlink (SDATA (newname
));
2864 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2865 report_file_error ("Adding new name", list2 (file
, newname
));
2872 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2873 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2874 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2875 Both args must be strings.
2876 Signals a `file-already-exists' error if a file LINKNAME already exists
2877 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2878 A number as third arg means request confirmation if LINKNAME already exists.
2879 This happens for interactive use with M-x. */)
2880 (filename
, linkname
, ok_if_already_exists
)
2881 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2883 Lisp_Object handler
;
2884 Lisp_Object encoded_filename
, encoded_linkname
;
2885 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2887 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2888 encoded_filename
= encoded_linkname
= Qnil
;
2889 CHECK_STRING (filename
);
2890 CHECK_STRING (linkname
);
2891 /* If the link target has a ~, we must expand it to get
2892 a truly valid file name. Otherwise, do not expand;
2893 we want to permit links to relative file names. */
2894 if (SREF (filename
, 0) == '~')
2895 filename
= Fexpand_file_name (filename
, Qnil
);
2897 if (!NILP (Ffile_directory_p (linkname
)))
2898 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2900 linkname
= Fexpand_file_name (linkname
, Qnil
);
2902 /* If the file name has special constructs in it,
2903 call the corresponding file handler. */
2904 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2905 if (!NILP (handler
))
2906 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2907 linkname
, ok_if_already_exists
));
2909 /* If the new link name has special constructs in it,
2910 call the corresponding file handler. */
2911 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2912 if (!NILP (handler
))
2913 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2914 linkname
, ok_if_already_exists
));
2916 encoded_filename
= ENCODE_FILE (filename
);
2917 encoded_linkname
= ENCODE_FILE (linkname
);
2919 if (NILP (ok_if_already_exists
)
2920 || INTEGERP (ok_if_already_exists
))
2921 barf_or_query_if_file_exists (linkname
, "make it a link",
2922 INTEGERP (ok_if_already_exists
), 0, 0);
2923 if (0 > symlink (SDATA (encoded_filename
),
2924 SDATA (encoded_linkname
)))
2926 /* If we didn't complain already, silently delete existing file. */
2927 if (errno
== EEXIST
)
2929 unlink (SDATA (encoded_linkname
));
2930 if (0 <= symlink (SDATA (encoded_filename
),
2931 SDATA (encoded_linkname
)))
2938 report_file_error ("Making symbolic link", list2 (filename
, linkname
));
2943 #endif /* S_IFLNK */
2947 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2948 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2949 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2950 If STRING is nil or a null string, the logical name NAME is deleted. */)
2955 CHECK_STRING (name
);
2957 delete_logical_name (SDATA (name
));
2960 CHECK_STRING (string
);
2962 if (SCHARS (string
) == 0)
2963 delete_logical_name (SDATA (name
));
2965 define_logical_name (SDATA (name
), SDATA (string
));
2974 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2975 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2977 Lisp_Object path
, login
;
2981 CHECK_STRING (path
);
2982 CHECK_STRING (login
);
2984 netresult
= netunam (SDATA (path
), SDATA (login
));
2986 if (netresult
== -1)
2991 #endif /* HPUX_NET */
2993 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2995 doc
: /* Return t if file FILENAME specifies an absolute file name.
2996 On Unix, this is a name starting with a `/' or a `~'. */)
2998 Lisp_Object filename
;
3000 CHECK_STRING (filename
);
3001 return file_name_absolute_p (SDATA (filename
)) ? Qt
: Qnil
;
3004 /* Return nonzero if file FILENAME exists and can be executed. */
3007 check_executable (filename
)
3011 int len
= strlen (filename
);
3014 if (stat (filename
, &st
) < 0)
3016 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
3017 return ((st
.st_mode
& S_IEXEC
) != 0);
3019 return (S_ISREG (st
.st_mode
)
3021 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
3022 || stricmp (suffix
, ".exe") == 0
3023 || stricmp (suffix
, ".bat") == 0)
3024 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3025 #endif /* not WINDOWSNT */
3026 #else /* not DOS_NT */
3027 #ifdef HAVE_EUIDACCESS
3028 return (euidaccess (filename
, 1) >= 0);
3030 /* Access isn't quite right because it uses the real uid
3031 and we really want to test with the effective uid.
3032 But Unix doesn't give us a right way to do it. */
3033 return (access (filename
, 1) >= 0);
3035 #endif /* not DOS_NT */
3038 /* Return nonzero if file FILENAME exists and can be written. */
3041 check_writable (filename
)
3046 if (stat (filename
, &st
) < 0)
3048 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3049 #else /* not MSDOS */
3050 #ifdef HAVE_EUIDACCESS
3051 return (euidaccess (filename
, 2) >= 0);
3053 /* Access isn't quite right because it uses the real uid
3054 and we really want to test with the effective uid.
3055 But Unix doesn't give us a right way to do it.
3056 Opening with O_WRONLY could work for an ordinary file,
3057 but would lose for directories. */
3058 return (access (filename
, 2) >= 0);
3060 #endif /* not MSDOS */
3063 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3064 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
3065 See also `file-readable-p' and `file-attributes'.
3066 This returns nil for a symlink to a nonexistent file.
3067 Use `file-symlink-p' to test for such links. */)
3069 Lisp_Object filename
;
3071 Lisp_Object absname
;
3072 Lisp_Object handler
;
3073 struct stat statbuf
;
3075 CHECK_STRING (filename
);
3076 absname
= Fexpand_file_name (filename
, Qnil
);
3078 /* If the file name has special constructs in it,
3079 call the corresponding file handler. */
3080 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3081 if (!NILP (handler
))
3082 return call2 (handler
, Qfile_exists_p
, absname
);
3084 absname
= ENCODE_FILE (absname
);
3086 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3089 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3090 doc
: /* Return t if FILENAME can be executed by you.
3091 For a directory, this means you can access files in that directory. */)
3093 Lisp_Object filename
;
3095 Lisp_Object absname
;
3096 Lisp_Object handler
;
3098 CHECK_STRING (filename
);
3099 absname
= Fexpand_file_name (filename
, Qnil
);
3101 /* If the file name has special constructs in it,
3102 call the corresponding file handler. */
3103 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3104 if (!NILP (handler
))
3105 return call2 (handler
, Qfile_executable_p
, absname
);
3107 absname
= ENCODE_FILE (absname
);
3109 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3112 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3113 doc
: /* Return t if file FILENAME exists and you can read it.
3114 See also `file-exists-p' and `file-attributes'. */)
3116 Lisp_Object filename
;
3118 Lisp_Object absname
;
3119 Lisp_Object handler
;
3122 struct stat statbuf
;
3124 CHECK_STRING (filename
);
3125 absname
= Fexpand_file_name (filename
, Qnil
);
3127 /* If the file name has special constructs in it,
3128 call the corresponding file handler. */
3129 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3130 if (!NILP (handler
))
3131 return call2 (handler
, Qfile_readable_p
, absname
);
3133 absname
= ENCODE_FILE (absname
);
3135 #if defined(DOS_NT) || defined(macintosh)
3136 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3138 if (access (SDATA (absname
), 0) == 0)
3141 #else /* not DOS_NT and not macintosh */
3143 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3144 /* Opening a fifo without O_NONBLOCK can wait.
3145 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3146 except in the case of a fifo, on a system which handles it. */
3147 desc
= stat (SDATA (absname
), &statbuf
);
3150 if (S_ISFIFO (statbuf
.st_mode
))
3151 flags
|= O_NONBLOCK
;
3153 desc
= emacs_open (SDATA (absname
), flags
, 0);
3158 #endif /* not DOS_NT and not macintosh */
3161 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3163 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3164 doc
: /* Return t if file FILENAME can be written or created by you. */)
3166 Lisp_Object filename
;
3168 Lisp_Object absname
, dir
, encoded
;
3169 Lisp_Object handler
;
3170 struct stat statbuf
;
3172 CHECK_STRING (filename
);
3173 absname
= Fexpand_file_name (filename
, Qnil
);
3175 /* If the file name has special constructs in it,
3176 call the corresponding file handler. */
3177 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3178 if (!NILP (handler
))
3179 return call2 (handler
, Qfile_writable_p
, absname
);
3181 encoded
= ENCODE_FILE (absname
);
3182 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3183 return (check_writable (SDATA (encoded
))
3186 dir
= Ffile_name_directory (absname
);
3189 dir
= Fdirectory_file_name (dir
);
3193 dir
= Fdirectory_file_name (dir
);
3196 dir
= ENCODE_FILE (dir
);
3198 /* The read-only attribute of the parent directory doesn't affect
3199 whether a file or directory can be created within it. Some day we
3200 should check ACLs though, which do affect this. */
3201 if (stat (SDATA (dir
), &statbuf
) < 0)
3203 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3205 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3210 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3211 doc
: /* Access file FILENAME, and get an error if that does not work.
3212 The second argument STRING is used in the error message.
3213 If there is no error, returns nil. */)
3215 Lisp_Object filename
, string
;
3217 Lisp_Object handler
, encoded_filename
, absname
;
3220 CHECK_STRING (filename
);
3221 absname
= Fexpand_file_name (filename
, Qnil
);
3223 CHECK_STRING (string
);
3225 /* If the file name has special constructs in it,
3226 call the corresponding file handler. */
3227 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3228 if (!NILP (handler
))
3229 return call3 (handler
, Qaccess_file
, absname
, string
);
3231 encoded_filename
= ENCODE_FILE (absname
);
3233 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3235 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3241 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3242 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3243 The value is the link target, as a string.
3244 Otherwise it returns nil.
3246 This function returns t when given the name of a symlink that
3247 points to a nonexistent file. */)
3249 Lisp_Object filename
;
3251 Lisp_Object handler
;
3253 CHECK_STRING (filename
);
3254 filename
= Fexpand_file_name (filename
, Qnil
);
3256 /* If the file name has special constructs in it,
3257 call the corresponding file handler. */
3258 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3259 if (!NILP (handler
))
3260 return call2 (handler
, Qfile_symlink_p
, filename
);
3269 filename
= ENCODE_FILE (filename
);
3276 buf
= (char *) xrealloc (buf
, bufsize
);
3277 bzero (buf
, bufsize
);
3280 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3284 /* HP-UX reports ERANGE if buffer is too small. */
3285 if (errno
== ERANGE
)
3295 while (valsize
>= bufsize
);
3297 val
= make_string (buf
, valsize
);
3298 if (buf
[0] == '/' && index (buf
, ':'))
3299 val
= concat2 (build_string ("/:"), val
);
3301 val
= DECODE_FILE (val
);
3304 #else /* not S_IFLNK */
3306 #endif /* not S_IFLNK */
3309 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3310 doc
: /* Return t if FILENAME names an existing directory.
3311 Symbolic links to directories count as directories.
3312 See `file-symlink-p' to distinguish symlinks. */)
3314 Lisp_Object filename
;
3316 register Lisp_Object absname
;
3318 Lisp_Object handler
;
3320 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3322 /* If the file name has special constructs in it,
3323 call the corresponding file handler. */
3324 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3325 if (!NILP (handler
))
3326 return call2 (handler
, Qfile_directory_p
, absname
);
3328 absname
= ENCODE_FILE (absname
);
3330 if (stat (SDATA (absname
), &st
) < 0)
3332 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3335 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3336 doc
: /* Return t if file FILENAME names a directory you can open.
3337 For the value to be t, FILENAME must specify the name of a directory as a file,
3338 and the directory must allow you to open files in it. In order to use a
3339 directory as a buffer's current directory, this predicate must return true.
3340 A directory name spec may be given instead; then the value is t
3341 if the directory so specified exists and really is a readable and
3342 searchable directory. */)
3344 Lisp_Object filename
;
3346 Lisp_Object handler
;
3348 struct gcpro gcpro1
;
3350 /* If the file name has special constructs in it,
3351 call the corresponding file handler. */
3352 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3353 if (!NILP (handler
))
3354 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3357 tem
= (NILP (Ffile_directory_p (filename
))
3358 || NILP (Ffile_executable_p (filename
)));
3360 return tem
? Qnil
: Qt
;
3363 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3364 doc
: /* Return t if FILENAME names a regular file.
3365 This is the sort of file that holds an ordinary stream of data bytes.
3366 Symbolic links to regular files count as regular files.
3367 See `file-symlink-p' to distinguish symlinks. */)
3369 Lisp_Object filename
;
3371 register Lisp_Object absname
;
3373 Lisp_Object handler
;
3375 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3377 /* If the file name has special constructs in it,
3378 call the corresponding file handler. */
3379 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3380 if (!NILP (handler
))
3381 return call2 (handler
, Qfile_regular_p
, absname
);
3383 absname
= ENCODE_FILE (absname
);
3388 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3390 /* Tell stat to use expensive method to get accurate info. */
3391 Vw32_get_true_file_attributes
= Qt
;
3392 result
= stat (SDATA (absname
), &st
);
3393 Vw32_get_true_file_attributes
= tem
;
3397 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3400 if (stat (SDATA (absname
), &st
) < 0)
3402 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3406 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3407 doc
: /* Return mode bits of file named FILENAME, as an integer.
3408 Return nil, if file does not exist or is not accessible. */)
3410 Lisp_Object filename
;
3412 Lisp_Object absname
;
3414 Lisp_Object handler
;
3416 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3418 /* If the file name has special constructs in it,
3419 call the corresponding file handler. */
3420 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3421 if (!NILP (handler
))
3422 return call2 (handler
, Qfile_modes
, absname
);
3424 absname
= ENCODE_FILE (absname
);
3426 if (stat (SDATA (absname
), &st
) < 0)
3428 #if defined (MSDOS) && __DJGPP__ < 2
3429 if (check_executable (SDATA (absname
)))
3430 st
.st_mode
|= S_IEXEC
;
3431 #endif /* MSDOS && __DJGPP__ < 2 */
3433 return make_number (st
.st_mode
& 07777);
3436 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3437 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3438 Only the 12 low bits of MODE are used. */)
3440 Lisp_Object filename
, mode
;
3442 Lisp_Object absname
, encoded_absname
;
3443 Lisp_Object handler
;
3445 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3446 CHECK_NUMBER (mode
);
3448 /* If the file name has special constructs in it,
3449 call the corresponding file handler. */
3450 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3451 if (!NILP (handler
))
3452 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3454 encoded_absname
= ENCODE_FILE (absname
);
3456 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3457 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3462 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3463 doc
: /* Set the file permission bits for newly created files.
3464 The argument MODE should be an integer; only the low 9 bits are used.
3465 This setting is inherited by subprocesses. */)
3469 CHECK_NUMBER (mode
);
3471 umask ((~ XINT (mode
)) & 0777);
3476 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3477 doc
: /* Return the default file protection for created files.
3478 The value is an integer. */)
3484 realmask
= umask (0);
3487 XSETINT (value
, (~ realmask
) & 0777);
3491 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3493 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3494 doc
: /* Set times of file FILENAME to TIME.
3495 Set both access and modification times.
3496 Return t on success, else nil.
3497 Use the current time if TIME is nil. TIME is in the format of
3500 Lisp_Object filename
, time
;
3502 Lisp_Object absname
, encoded_absname
;
3503 Lisp_Object handler
;
3507 if (! lisp_time_argument (time
, &sec
, &usec
))
3508 error ("Invalid time specification");
3510 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3512 /* If the file name has special constructs in it,
3513 call the corresponding file handler. */
3514 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3515 if (!NILP (handler
))
3516 return call3 (handler
, Qset_file_times
, absname
, time
);
3518 encoded_absname
= ENCODE_FILE (absname
);
3523 EMACS_SET_SECS (t
, sec
);
3524 EMACS_SET_USECS (t
, usec
);
3526 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3531 /* Setting times on a directory always fails. */
3532 if (stat (SDATA (encoded_absname
), &st
) == 0
3533 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3536 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3545 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3546 doc
: /* Tell Unix to finish all pending disk updates. */)
3553 #endif /* HAVE_SYNC */
3555 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3556 doc
: /* Return t if file FILE1 is newer than file FILE2.
3557 If FILE1 does not exist, the answer is nil;
3558 otherwise, if FILE2 does not exist, the answer is t. */)
3560 Lisp_Object file1
, file2
;
3562 Lisp_Object absname1
, absname2
;
3565 Lisp_Object handler
;
3566 struct gcpro gcpro1
, gcpro2
;
3568 CHECK_STRING (file1
);
3569 CHECK_STRING (file2
);
3572 GCPRO2 (absname1
, file2
);
3573 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3574 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3577 /* If the file name has special constructs in it,
3578 call the corresponding file handler. */
3579 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3581 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3582 if (!NILP (handler
))
3583 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3585 GCPRO2 (absname1
, absname2
);
3586 absname1
= ENCODE_FILE (absname1
);
3587 absname2
= ENCODE_FILE (absname2
);
3590 if (stat (SDATA (absname1
), &st
) < 0)
3593 mtime1
= st
.st_mtime
;
3595 if (stat (SDATA (absname2
), &st
) < 0)
3598 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3602 Lisp_Object Qfind_buffer_file_type
;
3605 #ifndef READ_BUF_SIZE
3606 #define READ_BUF_SIZE (64 << 10)
3609 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3611 /* This function is called after Lisp functions to decide a coding
3612 system are called, or when they cause an error. Before they are
3613 called, the current buffer is set unibyte and it contains only a
3614 newly inserted text (thus the buffer was empty before the
3617 The functions may set markers, overlays, text properties, or even
3618 alter the buffer contents, change the current buffer.
3620 Here, we reset all those changes by:
3621 o set back the current buffer.
3622 o move all markers and overlays to BEG.
3623 o remove all text properties.
3624 o set back the buffer multibyteness. */
3627 decide_coding_unwind (unwind_data
)
3628 Lisp_Object unwind_data
;
3630 Lisp_Object multibyte
, undo_list
, buffer
;
3632 multibyte
= XCAR (unwind_data
);
3633 unwind_data
= XCDR (unwind_data
);
3634 undo_list
= XCAR (unwind_data
);
3635 buffer
= XCDR (unwind_data
);
3637 if (current_buffer
!= XBUFFER (buffer
))
3638 set_buffer_internal (XBUFFER (buffer
));
3639 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3640 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3641 BUF_INTERVALS (current_buffer
) = 0;
3642 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3644 /* Now we are safe to change the buffer's multibyteness directly. */
3645 current_buffer
->enable_multibyte_characters
= multibyte
;
3646 current_buffer
->undo_list
= undo_list
;
3652 /* Used to pass values from insert-file-contents to read_non_regular. */
3654 static int non_regular_fd
;
3655 static int non_regular_inserted
;
3656 static int non_regular_nbytes
;
3659 /* Read from a non-regular file.
3660 Read non_regular_trytry bytes max from non_regular_fd.
3661 Non_regular_inserted specifies where to put the read bytes.
3662 Value is the number of bytes read. */
3671 nbytes
= emacs_read (non_regular_fd
,
3672 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3673 non_regular_nbytes
);
3675 return make_number (nbytes
);
3679 /* Condition-case handler used when reading from non-regular files
3680 in insert-file-contents. */
3683 read_non_regular_quit ()
3689 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3691 doc
: /* Insert contents of file FILENAME after point.
3692 Returns list of absolute file name and number of characters inserted.
3693 If second argument VISIT is non-nil, the buffer's visited filename
3694 and last save file modtime are set, and it is marked unmodified.
3695 If visiting and the file does not exist, visiting is completed
3696 before the error is signaled.
3697 The optional third and fourth arguments BEG and END
3698 specify what portion of the file to insert.
3699 These arguments count bytes in the file, not characters in the buffer.
3700 If VISIT is non-nil, BEG and END must be nil.
3702 If optional fifth argument REPLACE is non-nil,
3703 it means replace the current buffer contents (in the accessible portion)
3704 with the file contents. This is better than simply deleting and inserting
3705 the whole thing because (1) it preserves some marker positions
3706 and (2) it puts less data in the undo list.
3707 When REPLACE is non-nil, the value is the number of characters actually read,
3708 which is often less than the number of characters to be read.
3710 This does code conversion according to the value of
3711 `coding-system-for-read' or `file-coding-system-alist',
3712 and sets the variable `last-coding-system-used' to the coding system
3714 (filename
, visit
, beg
, end
, replace
)
3715 Lisp_Object filename
, visit
, beg
, end
, replace
;
3720 register int how_much
;
3721 register int unprocessed
;
3722 int count
= SPECPDL_INDEX ();
3723 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3724 Lisp_Object handler
, val
, insval
, orig_filename
;
3727 int not_regular
= 0;
3728 unsigned char read_buf
[READ_BUF_SIZE
];
3729 struct coding_system coding
;
3730 unsigned char buffer
[1 << 14];
3731 int replace_handled
= 0;
3732 int set_coding_system
= 0;
3733 int coding_system_decided
= 0;
3735 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3736 int we_locked_file
= 0;
3738 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3739 error ("Cannot do file visiting in an indirect buffer");
3741 if (!NILP (current_buffer
->read_only
))
3742 Fbarf_if_buffer_read_only ();
3746 orig_filename
= Qnil
;
3748 GCPRO4 (filename
, val
, p
, orig_filename
);
3750 CHECK_STRING (filename
);
3751 filename
= Fexpand_file_name (filename
, Qnil
);
3753 /* If the file name has special constructs in it,
3754 call the corresponding file handler. */
3755 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3756 if (!NILP (handler
))
3758 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3759 visit
, beg
, end
, replace
);
3760 if (CONSP (val
) && CONSP (XCDR (val
)))
3761 inserted
= XINT (XCAR (XCDR (val
)));
3765 orig_filename
= filename
;
3766 filename
= ENCODE_FILE (filename
);
3772 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3774 /* Tell stat to use expensive method to get accurate info. */
3775 Vw32_get_true_file_attributes
= Qt
;
3776 total
= stat (SDATA (filename
), &st
);
3777 Vw32_get_true_file_attributes
= tem
;
3782 if (stat (SDATA (filename
), &st
) < 0)
3784 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3785 || fstat (fd
, &st
) < 0)
3786 #endif /* not APOLLO */
3787 #endif /* WINDOWSNT */
3789 if (fd
>= 0) emacs_close (fd
);
3792 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3795 if (!NILP (Vcoding_system_for_read
))
3796 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3801 /* This code will need to be changed in order to work on named
3802 pipes, and it's probably just not worth it. So we should at
3803 least signal an error. */
3804 if (!S_ISREG (st
.st_mode
))
3811 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3812 xsignal2 (Qfile_error
,
3813 build_string ("not a regular file"), orig_filename
);
3818 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3821 /* Replacement should preserve point as it preserves markers. */
3822 if (!NILP (replace
))
3823 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3825 record_unwind_protect (close_file_unwind
, make_number (fd
));
3827 /* Supposedly happens on VMS. */
3828 /* Can happen on any platform that uses long as type of off_t, but allows
3829 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3830 give a message suitable for the latter case. */
3831 if (! not_regular
&& st
.st_size
< 0)
3832 error ("Maximum buffer size exceeded");
3834 /* Prevent redisplay optimizations. */
3835 current_buffer
->clip_changed
= 1;
3839 if (!NILP (beg
) || !NILP (end
))
3840 error ("Attempt to visit less than an entire file");
3841 if (BEG
< Z
&& NILP (replace
))
3842 error ("Cannot do file visiting in a non-empty buffer");
3848 XSETFASTINT (beg
, 0);
3856 XSETINT (end
, st
.st_size
);
3858 /* Arithmetic overflow can occur if an Emacs integer cannot
3859 represent the file size, or if the calculations below
3860 overflow. The calculations below double the file size
3861 twice, so check that it can be multiplied by 4 safely. */
3862 if (XINT (end
) != st
.st_size
3863 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3864 error ("Maximum buffer size exceeded");
3866 /* The file size returned from stat may be zero, but data
3867 may be readable nonetheless, for example when this is a
3868 file in the /proc filesystem. */
3869 if (st
.st_size
== 0)
3870 XSETINT (end
, READ_BUF_SIZE
);
3874 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3876 /* We use emacs-mule for auto saving... */
3877 setup_coding_system (Qemacs_mule
, &coding
);
3878 /* ... but with the special flag to indicate to read in a
3879 multibyte sequence for eight-bit-control char as is. */
3881 coding
.src_multibyte
= 0;
3882 coding
.dst_multibyte
3883 = !NILP (current_buffer
->enable_multibyte_characters
);
3884 coding
.eol_type
= CODING_EOL_LF
;
3885 coding_system_decided
= 1;
3889 /* Decide the coding system to use for reading the file now
3890 because we can't use an optimized method for handling
3891 `coding:' tag if the current buffer is not empty. */
3895 if (!NILP (Vcoding_system_for_read
))
3896 val
= Vcoding_system_for_read
;
3899 /* Don't try looking inside a file for a coding system
3900 specification if it is not seekable. */
3901 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3903 /* Find a coding system specified in the heading two
3904 lines or in the tailing several lines of the file.
3905 We assume that the 1K-byte and 3K-byte for heading
3906 and tailing respectively are sufficient for this
3910 if (st
.st_size
<= (1024 * 4))
3911 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3914 nread
= emacs_read (fd
, read_buf
, 1024);
3917 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3918 report_file_error ("Setting file position",
3919 Fcons (orig_filename
, Qnil
));
3920 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3925 error ("IO error reading %s: %s",
3926 SDATA (orig_filename
), emacs_strerror (errno
));
3929 struct buffer
*prev
= current_buffer
;
3933 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3935 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3936 buf
= XBUFFER (buffer
);
3938 delete_all_overlays (buf
);
3939 buf
->directory
= current_buffer
->directory
;
3940 buf
->read_only
= Qnil
;
3941 buf
->filename
= Qnil
;
3942 buf
->undo_list
= Qt
;
3943 eassert (buf
->overlays_before
== NULL
);
3944 eassert (buf
->overlays_after
== NULL
);
3946 set_buffer_internal (buf
);
3948 buf
->enable_multibyte_characters
= Qnil
;
3950 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3951 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3952 val
= call2 (Vset_auto_coding_function
,
3953 filename
, make_number (nread
));
3954 set_buffer_internal (prev
);
3956 /* Discard the unwind protect for recovering the
3960 /* Rewind the file for the actual read done later. */
3961 if (lseek (fd
, 0, 0) < 0)
3962 report_file_error ("Setting file position",
3963 Fcons (orig_filename
, Qnil
));
3969 /* If we have not yet decided a coding system, check
3970 file-coding-system-alist. */
3971 Lisp_Object args
[6], coding_systems
;
3973 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3974 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3975 coding_systems
= Ffind_operation_coding_system (6, args
);
3976 if (CONSP (coding_systems
))
3977 val
= XCAR (coding_systems
);
3981 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3982 /* Ensure we set Vlast_coding_system_used. */
3983 set_coding_system
= 1;
3985 if (NILP (current_buffer
->enable_multibyte_characters
)
3987 /* We must suppress all character code conversion except for
3988 end-of-line conversion. */
3989 setup_raw_text_coding_system (&coding
);
3991 coding
.src_multibyte
= 0;
3992 coding
.dst_multibyte
3993 = !NILP (current_buffer
->enable_multibyte_characters
);
3994 coding_system_decided
= 1;
3997 /* If requested, replace the accessible part of the buffer
3998 with the file contents. Avoid replacing text at the
3999 beginning or end of the buffer that matches the file contents;
4000 that preserves markers pointing to the unchanged parts.
4002 Here we implement this feature in an optimized way
4003 for the case where code conversion is NOT needed.
4004 The following if-statement handles the case of conversion
4005 in a less optimal way.
4007 If the code conversion is "automatic" then we try using this
4008 method and hope for the best.
4009 But if we discover the need for conversion, we give up on this method
4010 and let the following if-statement handle the replace job. */
4013 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
4015 /* same_at_start and same_at_end count bytes,
4016 because file access counts bytes
4017 and BEG and END count bytes. */
4018 int same_at_start
= BEGV_BYTE
;
4019 int same_at_end
= ZV_BYTE
;
4021 /* There is still a possibility we will find the need to do code
4022 conversion. If that happens, we set this variable to 1 to
4023 give up on handling REPLACE in the optimized way. */
4024 int giveup_match_end
= 0;
4026 if (XINT (beg
) != 0)
4028 if (lseek (fd
, XINT (beg
), 0) < 0)
4029 report_file_error ("Setting file position",
4030 Fcons (orig_filename
, Qnil
));
4035 /* Count how many chars at the start of the file
4036 match the text at the beginning of the buffer. */
4041 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4043 error ("IO error reading %s: %s",
4044 SDATA (orig_filename
), emacs_strerror (errno
));
4045 else if (nread
== 0)
4048 if (coding
.type
== coding_type_undecided
)
4049 detect_coding (&coding
, buffer
, nread
);
4050 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
4051 /* We found that the file should be decoded somehow.
4052 Let's give up here. */
4054 giveup_match_end
= 1;
4058 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
4059 detect_eol (&coding
, buffer
, nread
);
4060 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
4061 && coding
.eol_type
!= CODING_EOL_LF
)
4062 /* We found that the format of eol should be decoded.
4063 Let's give up here. */
4065 giveup_match_end
= 1;
4070 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4071 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4072 same_at_start
++, bufpos
++;
4073 /* If we found a discrepancy, stop the scan.
4074 Otherwise loop around and scan the next bufferful. */
4075 if (bufpos
!= nread
)
4079 /* If the file matches the buffer completely,
4080 there's no need to replace anything. */
4081 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4085 /* Truncate the buffer to the size of the file. */
4086 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4091 /* Count how many chars at the end of the file
4092 match the text at the end of the buffer. But, if we have
4093 already found that decoding is necessary, don't waste time. */
4094 while (!giveup_match_end
)
4096 int total_read
, nread
, bufpos
, curpos
, trial
;
4098 /* At what file position are we now scanning? */
4099 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4100 /* If the entire file matches the buffer tail, stop the scan. */
4103 /* How much can we scan in the next step? */
4104 trial
= min (curpos
, sizeof buffer
);
4105 if (lseek (fd
, curpos
- trial
, 0) < 0)
4106 report_file_error ("Setting file position",
4107 Fcons (orig_filename
, Qnil
));
4109 total_read
= nread
= 0;
4110 while (total_read
< trial
)
4112 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4114 error ("IO error reading %s: %s",
4115 SDATA (orig_filename
), emacs_strerror (errno
));
4116 else if (nread
== 0)
4118 total_read
+= nread
;
4121 /* Scan this bufferful from the end, comparing with
4122 the Emacs buffer. */
4123 bufpos
= total_read
;
4125 /* Compare with same_at_start to avoid counting some buffer text
4126 as matching both at the file's beginning and at the end. */
4127 while (bufpos
> 0 && same_at_end
> same_at_start
4128 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4129 same_at_end
--, bufpos
--;
4131 /* If we found a discrepancy, stop the scan.
4132 Otherwise loop around and scan the preceding bufferful. */
4135 /* If this discrepancy is because of code conversion,
4136 we cannot use this method; giveup and try the other. */
4137 if (same_at_end
> same_at_start
4138 && FETCH_BYTE (same_at_end
- 1) >= 0200
4139 && ! NILP (current_buffer
->enable_multibyte_characters
)
4140 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4141 giveup_match_end
= 1;
4150 if (! giveup_match_end
)
4154 /* We win! We can handle REPLACE the optimized way. */
4156 /* Extend the start of non-matching text area to multibyte
4157 character boundary. */
4158 if (! NILP (current_buffer
->enable_multibyte_characters
))
4159 while (same_at_start
> BEGV_BYTE
4160 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4163 /* Extend the end of non-matching text area to multibyte
4164 character boundary. */
4165 if (! NILP (current_buffer
->enable_multibyte_characters
))
4166 while (same_at_end
< ZV_BYTE
4167 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4170 /* Don't try to reuse the same piece of text twice. */
4171 overlap
= (same_at_start
- BEGV_BYTE
4172 - (same_at_end
+ st
.st_size
- ZV
));
4174 same_at_end
+= overlap
;
4176 /* Arrange to read only the nonmatching middle part of the file. */
4177 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4178 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4180 del_range_byte (same_at_start
, same_at_end
, 0);
4181 /* Insert from the file at the proper position. */
4182 temp
= BYTE_TO_CHAR (same_at_start
);
4183 SET_PT_BOTH (temp
, same_at_start
);
4185 /* If display currently starts at beginning of line,
4186 keep it that way. */
4187 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4188 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4190 replace_handled
= 1;
4194 /* If requested, replace the accessible part of the buffer
4195 with the file contents. Avoid replacing text at the
4196 beginning or end of the buffer that matches the file contents;
4197 that preserves markers pointing to the unchanged parts.
4199 Here we implement this feature for the case where code conversion
4200 is needed, in a simple way that needs a lot of memory.
4201 The preceding if-statement handles the case of no conversion
4202 in a more optimized way. */
4203 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4205 int same_at_start
= BEGV_BYTE
;
4206 int same_at_end
= ZV_BYTE
;
4209 /* Make sure that the gap is large enough. */
4210 int bufsize
= 2 * st
.st_size
;
4211 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4214 /* First read the whole file, performing code conversion into
4215 CONVERSION_BUFFER. */
4217 if (lseek (fd
, XINT (beg
), 0) < 0)
4219 xfree (conversion_buffer
);
4220 report_file_error ("Setting file position",
4221 Fcons (orig_filename
, Qnil
));
4224 total
= st
.st_size
; /* Total bytes in the file. */
4225 how_much
= 0; /* Bytes read from file so far. */
4226 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4227 unprocessed
= 0; /* Bytes not processed in previous loop. */
4229 while (how_much
< total
)
4231 /* try is reserved in some compilers (Microsoft C) */
4232 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4233 unsigned char *destination
= read_buf
+ unprocessed
;
4236 /* Allow quitting out of the actual I/O. */
4239 this = emacs_read (fd
, destination
, trytry
);
4242 if (this < 0 || this + unprocessed
== 0)
4250 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4252 int require
, result
;
4254 this += unprocessed
;
4256 /* If we are using more space than estimated,
4257 make CONVERSION_BUFFER bigger. */
4258 require
= decoding_buffer_size (&coding
, this);
4259 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4261 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4262 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4265 /* Convert this batch with results in CONVERSION_BUFFER. */
4266 if (how_much
>= total
) /* This is the last block. */
4267 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4268 if (coding
.composing
!= COMPOSITION_DISABLED
)
4269 coding_allocate_composition_data (&coding
, BEGV
);
4270 result
= decode_coding (&coding
, read_buf
,
4271 conversion_buffer
+ inserted
,
4272 this, bufsize
- inserted
);
4274 /* Save for next iteration whatever we didn't convert. */
4275 unprocessed
= this - coding
.consumed
;
4276 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4277 if (!NILP (current_buffer
->enable_multibyte_characters
))
4278 this = coding
.produced
;
4280 this = str_as_unibyte (conversion_buffer
+ inserted
,
4287 /* At this point, INSERTED is how many characters (i.e. bytes)
4288 are present in CONVERSION_BUFFER.
4289 HOW_MUCH should equal TOTAL,
4290 or should be <= 0 if we couldn't read the file. */
4294 xfree (conversion_buffer
);
4295 coding_free_composition_data (&coding
);
4296 error ("IO error reading %s: %s",
4297 SDATA (orig_filename
), emacs_strerror (errno
));
4300 /* Compare the beginning of the converted file
4301 with the buffer text. */
4304 while (bufpos
< inserted
&& same_at_start
< same_at_end
4305 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4306 same_at_start
++, bufpos
++;
4308 /* If the file matches the buffer completely,
4309 there's no need to replace anything. */
4311 if (bufpos
== inserted
)
4313 xfree (conversion_buffer
);
4314 coding_free_composition_data (&coding
);
4317 /* Truncate the buffer to the size of the file. */
4318 del_range_byte (same_at_start
, same_at_end
, 0);
4323 /* Extend the start of non-matching text area to multibyte
4324 character boundary. */
4325 if (! NILP (current_buffer
->enable_multibyte_characters
))
4326 while (same_at_start
> BEGV_BYTE
4327 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4330 /* Scan this bufferful from the end, comparing with
4331 the Emacs buffer. */
4334 /* Compare with same_at_start to avoid counting some buffer text
4335 as matching both at the file's beginning and at the end. */
4336 while (bufpos
> 0 && same_at_end
> same_at_start
4337 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4338 same_at_end
--, bufpos
--;
4340 /* Extend the end of non-matching text area to multibyte
4341 character boundary. */
4342 if (! NILP (current_buffer
->enable_multibyte_characters
))
4343 while (same_at_end
< ZV_BYTE
4344 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4347 /* Don't try to reuse the same piece of text twice. */
4348 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4350 same_at_end
+= overlap
;
4352 /* If display currently starts at beginning of line,
4353 keep it that way. */
4354 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4355 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4357 /* Replace the chars that we need to replace,
4358 and update INSERTED to equal the number of bytes
4359 we are taking from the file. */
4360 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4362 if (same_at_end
!= same_at_start
)
4364 del_range_byte (same_at_start
, same_at_end
, 0);
4366 same_at_start
= GPT_BYTE
;
4370 temp
= BYTE_TO_CHAR (same_at_start
);
4372 /* Insert from the file at the proper position. */
4373 SET_PT_BOTH (temp
, same_at_start
);
4374 insert_1 (conversion_buffer
+ same_at_start
- BEGV_BYTE
, inserted
,
4376 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4377 coding_restore_composition (&coding
, Fcurrent_buffer ());
4378 coding_free_composition_data (&coding
);
4380 /* Set `inserted' to the number of inserted characters. */
4381 inserted
= PT
- temp
;
4382 /* Set point before the inserted characters. */
4383 SET_PT_BOTH (temp
, same_at_start
);
4385 xfree (conversion_buffer
);
4394 register Lisp_Object temp
;
4396 total
= XINT (end
) - XINT (beg
);
4398 /* Make sure point-max won't overflow after this insertion. */
4399 XSETINT (temp
, total
);
4400 if (total
!= XINT (temp
))
4401 error ("Maximum buffer size exceeded");
4404 /* For a special file, all we can do is guess. */
4405 total
= READ_BUF_SIZE
;
4407 if (NILP (visit
) && inserted
> 0)
4409 #ifdef CLASH_DETECTION
4410 if (!NILP (current_buffer
->file_truename
)
4411 /* Make binding buffer-file-name to nil effective. */
4412 && !NILP (current_buffer
->filename
)
4413 && SAVE_MODIFF
>= MODIFF
)
4415 #endif /* CLASH_DETECTION */
4416 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
4420 if (GAP_SIZE
< total
)
4421 make_gap (total
- GAP_SIZE
);
4423 if (XINT (beg
) != 0 || !NILP (replace
))
4425 if (lseek (fd
, XINT (beg
), 0) < 0)
4426 report_file_error ("Setting file position",
4427 Fcons (orig_filename
, Qnil
));
4430 /* In the following loop, HOW_MUCH contains the total bytes read so
4431 far for a regular file, and not changed for a special file. But,
4432 before exiting the loop, it is set to a negative value if I/O
4436 /* Total bytes inserted. */
4439 /* Here, we don't do code conversion in the loop. It is done by
4440 code_convert_region after all data are read into the buffer. */
4442 int gap_size
= GAP_SIZE
;
4444 while (how_much
< total
)
4446 /* try is reserved in some compilers (Microsoft C) */
4447 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4454 /* Maybe make more room. */
4455 if (gap_size
< trytry
)
4457 make_gap (total
- gap_size
);
4458 gap_size
= GAP_SIZE
;
4461 /* Read from the file, capturing `quit'. When an
4462 error occurs, end the loop, and arrange for a quit
4463 to be signaled after decoding the text we read. */
4464 non_regular_fd
= fd
;
4465 non_regular_inserted
= inserted
;
4466 non_regular_nbytes
= trytry
;
4467 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4468 read_non_regular_quit
);
4479 /* Allow quitting out of the actual I/O. We don't make text
4480 part of the buffer until all the reading is done, so a C-g
4481 here doesn't do any harm. */
4484 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4496 /* For a regular file, where TOTAL is the real size,
4497 count HOW_MUCH to compare with it.
4498 For a special file, where TOTAL is just a buffer size,
4499 so don't bother counting in HOW_MUCH.
4500 (INSERTED is where we count the number of characters inserted.) */
4507 /* Now we have read all the file data into the gap.
4508 If it was empty, undo marking the buffer modified. */
4512 #ifdef CLASH_DETECTION
4514 unlock_file (current_buffer
->file_truename
);
4516 Vdeactivate_mark
= old_Vdeactivate_mark
;
4519 Vdeactivate_mark
= Qt
;
4521 /* Make the text read part of the buffer. */
4522 GAP_SIZE
-= inserted
;
4524 GPT_BYTE
+= inserted
;
4526 ZV_BYTE
+= inserted
;
4531 /* Put an anchor to ensure multi-byte form ends at gap. */
4536 /* Discard the unwind protect for closing the file. */
4540 error ("IO error reading %s: %s",
4541 SDATA (orig_filename
), emacs_strerror (errno
));
4545 if (! coding_system_decided
)
4547 /* The coding system is not yet decided. Decide it by an
4548 optimized method for handling `coding:' tag.
4550 Note that we can get here only if the buffer was empty
4551 before the insertion. */
4555 if (!NILP (Vcoding_system_for_read
))
4556 val
= Vcoding_system_for_read
;
4559 /* Since we are sure that the current buffer was empty
4560 before the insertion, we can toggle
4561 enable-multibyte-characters directly here without taking
4562 care of marker adjustment and byte combining problem. By
4563 this way, we can run Lisp program safely before decoding
4564 the inserted text. */
4565 Lisp_Object unwind_data
;
4566 int count
= SPECPDL_INDEX ();
4568 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4569 Fcons (current_buffer
->undo_list
,
4570 Fcurrent_buffer ()));
4571 current_buffer
->enable_multibyte_characters
= Qnil
;
4572 current_buffer
->undo_list
= Qt
;
4573 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4575 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4577 val
= call2 (Vset_auto_coding_function
,
4578 filename
, make_number (inserted
));
4583 /* If the coding system is not yet decided, check
4584 file-coding-system-alist. */
4585 Lisp_Object args
[6], coding_systems
;
4587 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4588 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4589 coding_systems
= Ffind_operation_coding_system (6, args
);
4590 if (CONSP (coding_systems
))
4591 val
= XCAR (coding_systems
);
4593 unbind_to (count
, Qnil
);
4594 inserted
= Z_BYTE
- BEG_BYTE
;
4597 /* The following kludgy code is to avoid some compiler bug.
4599 setup_coding_system (val, &coding);
4602 struct coding_system temp_coding
;
4603 setup_coding_system (Fcheck_coding_system (val
), &temp_coding
);
4604 bcopy (&temp_coding
, &coding
, sizeof coding
);
4606 /* Ensure we set Vlast_coding_system_used. */
4607 set_coding_system
= 1;
4609 if (NILP (current_buffer
->enable_multibyte_characters
)
4611 /* We must suppress all character code conversion except for
4612 end-of-line conversion. */
4613 setup_raw_text_coding_system (&coding
);
4614 coding
.src_multibyte
= 0;
4615 coding
.dst_multibyte
4616 = !NILP (current_buffer
->enable_multibyte_characters
);
4620 /* Can't do this if part of the buffer might be preserved. */
4622 && (coding
.type
== coding_type_no_conversion
4623 || coding
.type
== coding_type_raw_text
))
4625 /* Visiting a file with these coding system makes the buffer
4627 current_buffer
->enable_multibyte_characters
= Qnil
;
4628 coding
.dst_multibyte
= 0;
4631 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4633 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4635 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4637 inserted
= coding
.produced_char
;
4640 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4644 /* Now INSERTED is measured in characters. */
4647 /* Use the conversion type to determine buffer-file-type
4648 (find-buffer-file-type is now used to help determine the
4650 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4651 || coding
.eol_type
== CODING_EOL_LF
)
4652 && ! CODING_REQUIRE_DECODING (&coding
))
4653 current_buffer
->buffer_file_type
= Qt
;
4655 current_buffer
->buffer_file_type
= Qnil
;
4662 if (!EQ (current_buffer
->undo_list
, Qt
))
4663 current_buffer
->undo_list
= Qnil
;
4665 stat (SDATA (filename
), &st
);
4670 current_buffer
->modtime
= st
.st_mtime
;
4671 current_buffer
->filename
= orig_filename
;
4674 SAVE_MODIFF
= MODIFF
;
4675 current_buffer
->auto_save_modified
= MODIFF
;
4676 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4677 #ifdef CLASH_DETECTION
4680 if (!NILP (current_buffer
->file_truename
))
4681 unlock_file (current_buffer
->file_truename
);
4682 unlock_file (filename
);
4684 #endif /* CLASH_DETECTION */
4686 xsignal2 (Qfile_error
,
4687 build_string ("not a regular file"), orig_filename
);
4690 if (set_coding_system
)
4691 Vlast_coding_system_used
= coding
.symbol
;
4693 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4695 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4697 if (! NILP (insval
))
4699 CHECK_NUMBER (insval
);
4700 inserted
= XFASTINT (insval
);
4704 /* Decode file format */
4707 int empty_undo_list_p
= 0;
4709 /* If we're anyway going to discard undo information, don't
4710 record it in the first place. The buffer's undo list at this
4711 point is either nil or t when visiting a file. */
4714 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4715 current_buffer
->undo_list
= Qt
;
4718 insval
= call3 (Qformat_decode
,
4719 Qnil
, make_number (inserted
), visit
);
4720 CHECK_NUMBER (insval
);
4721 inserted
= XFASTINT (insval
);
4724 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4727 /* Call after-change hooks for the inserted text, aside from the case
4728 of normal visiting (not with REPLACE), which is done in a new buffer
4729 "before" the buffer is changed. */
4730 if (inserted
> 0 && total
> 0
4731 && (NILP (visit
) || !NILP (replace
)))
4733 signal_after_change (PT
, 0, inserted
);
4734 update_compositions (PT
, PT
, CHECK_BORDER
);
4737 p
= Vafter_insert_file_functions
;
4740 insval
= call1 (XCAR (p
), make_number (inserted
));
4743 CHECK_NUMBER (insval
);
4744 inserted
= XFASTINT (insval
);
4751 && current_buffer
->modtime
== -1)
4753 /* If visiting nonexistent file, return nil. */
4754 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4758 Fsignal (Qquit
, Qnil
);
4760 /* ??? Retval needs to be dealt with in all cases consistently. */
4762 val
= Fcons (orig_filename
,
4763 Fcons (make_number (inserted
),
4766 RETURN_UNGCPRO (unbind_to (count
, val
));
4769 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4770 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4771 Lisp_Object
, Lisp_Object
));
4773 /* If build_annotations switched buffers, switch back to BUF.
4774 Kill the temporary buffer that was selected in the meantime.
4776 Since this kill only the last temporary buffer, some buffers remain
4777 not killed if build_annotations switched buffers more than once.
4781 build_annotations_unwind (buf
)
4786 if (XBUFFER (buf
) == current_buffer
)
4788 tembuf
= Fcurrent_buffer ();
4790 Fkill_buffer (tembuf
);
4794 /* Decide the coding-system to encode the data with. */
4797 choose_write_coding_system (start
, end
, filename
,
4798 append
, visit
, lockname
, coding
)
4799 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4800 struct coding_system
*coding
;
4805 && NILP (Fstring_equal (current_buffer
->filename
,
4806 current_buffer
->auto_save_file_name
)))
4808 /* We use emacs-mule for auto saving... */
4809 setup_coding_system (Qemacs_mule
, coding
);
4810 /* ... but with the special flag to indicate not to strip off
4811 leading code of eight-bit-control chars. */
4813 /* We force LF for end-of-line because that is faster. */
4814 coding
->eol_type
= CODING_EOL_LF
;
4815 goto done_setup_coding
;
4817 else if (!NILP (Vcoding_system_for_write
))
4819 val
= Vcoding_system_for_write
;
4820 if (coding_system_require_warning
4821 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4822 /* Confirm that VAL can surely encode the current region. */
4823 val
= call5 (Vselect_safe_coding_system_function
,
4824 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4829 /* If the variable `buffer-file-coding-system' is set locally,
4830 it means that the file was read with some kind of code
4831 conversion or the variable is explicitly set by users. We
4832 had better write it out with the same coding system even if
4833 `enable-multibyte-characters' is nil.
4835 If it is not set locally, we anyway have to convert EOL
4836 format if the default value of `buffer-file-coding-system'
4837 tells that it is not Unix-like (LF only) format. */
4838 int using_default_coding
= 0;
4839 int force_raw_text
= 0;
4841 val
= current_buffer
->buffer_file_coding_system
;
4843 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4846 if (NILP (current_buffer
->enable_multibyte_characters
))
4852 /* Check file-coding-system-alist. */
4853 Lisp_Object args
[7], coding_systems
;
4855 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4856 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4858 coding_systems
= Ffind_operation_coding_system (7, args
);
4859 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4860 val
= XCDR (coding_systems
);
4864 && !NILP (current_buffer
->buffer_file_coding_system
))
4866 /* If we still have not decided a coding system, use the
4867 default value of buffer-file-coding-system. */
4868 val
= current_buffer
->buffer_file_coding_system
;
4869 using_default_coding
= 1;
4873 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4874 /* Confirm that VAL can surely encode the current region. */
4875 val
= call5 (Vselect_safe_coding_system_function
,
4876 start
, end
, val
, Qnil
, filename
);
4878 setup_coding_system (Fcheck_coding_system (val
), coding
);
4879 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4880 && !using_default_coding
)
4882 if (! EQ (default_buffer_file_coding
.symbol
,
4883 buffer_defaults
.buffer_file_coding_system
))
4884 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4885 &default_buffer_file_coding
);
4886 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4888 Lisp_Object subsidiaries
;
4890 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4891 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4892 if (VECTORP (subsidiaries
)
4893 && XVECTOR (subsidiaries
)->size
== 3)
4895 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4900 setup_raw_text_coding_system (coding
);
4901 goto done_setup_coding
;
4904 setup_coding_system (Fcheck_coding_system (val
), coding
);
4907 if (coding
->eol_type
== CODING_EOL_UNDECIDED
)
4908 coding
->eol_type
= system_eol_type
;
4909 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4910 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4913 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4914 "r\nFWrite region to file: \ni\ni\ni\np",
4915 doc
: /* Write current region into specified file.
4916 When called from a program, requires three arguments:
4917 START, END and FILENAME. START and END are normally buffer positions
4918 specifying the part of the buffer to write.
4919 If START is nil, that means to use the entire buffer contents.
4920 If START is a string, then output that string to the file
4921 instead of any buffer contents; END is ignored.
4923 Optional fourth argument APPEND if non-nil means
4924 append to existing file contents (if any). If it is an integer,
4925 seek to that offset in the file before writing.
4926 Optional fifth argument VISIT, if t or a string, means
4927 set the last-save-file-modtime of buffer to this file's modtime
4928 and mark buffer not modified.
4929 If VISIT is a string, it is a second file name;
4930 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4931 VISIT is also the file name to lock and unlock for clash detection.
4932 If VISIT is neither t nor nil nor a string,
4933 that means do not display the \"Wrote file\" message.
4934 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4935 use for locking and unlocking, overriding FILENAME and VISIT.
4936 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4937 for an existing file with the same name. If MUSTBENEW is `excl',
4938 that means to get an error if the file already exists; never overwrite.
4939 If MUSTBENEW is neither nil nor `excl', that means ask for
4940 confirmation before overwriting, but do go ahead and overwrite the file
4941 if the user confirms.
4943 This does code conversion according to the value of
4944 `coding-system-for-write', `buffer-file-coding-system', or
4945 `file-coding-system-alist', and sets the variable
4946 `last-coding-system-used' to the coding system actually used. */)
4947 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4948 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4953 const unsigned char *fn
;
4956 int count
= SPECPDL_INDEX ();
4959 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4961 Lisp_Object handler
;
4962 Lisp_Object visit_file
;
4963 Lisp_Object annotations
;
4964 Lisp_Object encoded_filename
;
4965 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4966 int quietly
= !NILP (visit
);
4967 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4968 struct buffer
*given_buffer
;
4970 int buffer_file_type
= O_BINARY
;
4972 struct coding_system coding
;
4974 if (current_buffer
->base_buffer
&& visiting
)
4975 error ("Cannot do file visiting in an indirect buffer");
4977 if (!NILP (start
) && !STRINGP (start
))
4978 validate_region (&start
, &end
);
4981 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4983 filename
= Fexpand_file_name (filename
, Qnil
);
4985 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4986 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4988 if (STRINGP (visit
))
4989 visit_file
= Fexpand_file_name (visit
, Qnil
);
4991 visit_file
= filename
;
4993 if (NILP (lockname
))
4994 lockname
= visit_file
;
4998 /* If the file name has special constructs in it,
4999 call the corresponding file handler. */
5000 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
5001 /* If FILENAME has no handler, see if VISIT has one. */
5002 if (NILP (handler
) && STRINGP (visit
))
5003 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
5005 if (!NILP (handler
))
5008 val
= call6 (handler
, Qwrite_region
, start
, end
,
5009 filename
, append
, visit
);
5013 SAVE_MODIFF
= MODIFF
;
5014 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5015 current_buffer
->filename
= visit_file
;
5021 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
5023 /* Special kludge to simplify auto-saving. */
5026 XSETFASTINT (start
, BEG
);
5027 XSETFASTINT (end
, Z
);
5031 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
5032 count1
= SPECPDL_INDEX ();
5034 given_buffer
= current_buffer
;
5036 if (!STRINGP (start
))
5038 annotations
= build_annotations (start
, end
);
5040 if (current_buffer
!= given_buffer
)
5042 XSETFASTINT (start
, BEGV
);
5043 XSETFASTINT (end
, ZV
);
5049 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
5051 /* Decide the coding-system to encode the data with.
5052 We used to make this choice before calling build_annotations, but that
5053 leads to problems when a write-annotate-function takes care of
5054 unsavable chars (as was the case with X-Symbol). */
5055 choose_write_coding_system (start
, end
, filename
,
5056 append
, visit
, lockname
, &coding
);
5057 Vlast_coding_system_used
= coding
.symbol
;
5059 given_buffer
= current_buffer
;
5060 if (! STRINGP (start
))
5062 annotations
= build_annotations_2 (start
, end
,
5063 coding
.pre_write_conversion
, annotations
);
5064 if (current_buffer
!= given_buffer
)
5066 XSETFASTINT (start
, BEGV
);
5067 XSETFASTINT (end
, ZV
);
5071 #ifdef CLASH_DETECTION
5074 #if 0 /* This causes trouble for GNUS. */
5075 /* If we've locked this file for some other buffer,
5076 query before proceeding. */
5077 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5078 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5081 lock_file (lockname
);
5083 #endif /* CLASH_DETECTION */
5085 encoded_filename
= ENCODE_FILE (filename
);
5087 fn
= SDATA (encoded_filename
);
5091 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5092 #else /* not DOS_NT */
5093 desc
= emacs_open (fn
, O_WRONLY
, 0);
5094 #endif /* not DOS_NT */
5096 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5098 if (auto_saving
) /* Overwrite any previous version of autosave file */
5100 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5101 desc
= emacs_open (fn
, O_RDWR
, 0);
5103 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5104 ? SDATA (current_buffer
->filename
) : 0,
5107 else /* Write to temporary name and rename if no errors */
5109 Lisp_Object temp_name
;
5110 temp_name
= Ffile_name_directory (filename
);
5112 if (!NILP (temp_name
))
5114 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5115 build_string ("$$SAVE$$")));
5116 fname
= SDATA (filename
);
5117 fn
= SDATA (temp_name
);
5118 desc
= creat_copy_attrs (fname
, fn
);
5121 /* If we can't open the temporary file, try creating a new
5122 version of the original file. VMS "creat" creates a
5123 new version rather than truncating an existing file. */
5126 desc
= creat (fn
, 0666);
5127 #if 0 /* This can clobber an existing file and fail to replace it,
5128 if the user runs out of space. */
5131 /* We can't make a new version;
5132 try to truncate and rewrite existing version if any. */
5134 desc
= emacs_open (fn
, O_RDWR
, 0);
5140 desc
= creat (fn
, 0666);
5144 desc
= emacs_open (fn
,
5145 O_WRONLY
| O_CREAT
| buffer_file_type
5146 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5147 S_IREAD
| S_IWRITE
);
5148 #else /* not DOS_NT */
5149 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5150 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5151 auto_saving
? auto_save_mode_bits
: 0666);
5152 #endif /* not DOS_NT */
5153 #endif /* not VMS */
5157 #ifdef CLASH_DETECTION
5159 if (!auto_saving
) unlock_file (lockname
);
5161 #endif /* CLASH_DETECTION */
5163 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5166 record_unwind_protect (close_file_unwind
, make_number (desc
));
5168 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5172 if (NUMBERP (append
))
5173 ret
= lseek (desc
, XINT (append
), 1);
5175 ret
= lseek (desc
, 0, 2);
5178 #ifdef CLASH_DETECTION
5179 if (!auto_saving
) unlock_file (lockname
);
5180 #endif /* CLASH_DETECTION */
5182 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5190 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5191 * if we do writes that don't end with a carriage return. Furthermore
5192 * it cannot handle writes of more then 16K. The modified
5193 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5194 * this EXCEPT for the last record (if it doesn't end with a carriage
5195 * return). This implies that if your buffer doesn't end with a carriage
5196 * return, you get one free... tough. However it also means that if
5197 * we make two calls to sys_write (a la the following code) you can
5198 * get one at the gap as well. The easiest way to fix this (honest)
5199 * is to move the gap to the next newline (or the end of the buffer).
5204 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5205 move_gap (find_next_newline (GPT
, 1));
5207 /* Whether VMS or not, we must move the gap to the next of newline
5208 when we must put designation sequences at beginning of line. */
5209 if (INTEGERP (start
)
5210 && coding
.type
== coding_type_iso2022
5211 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5212 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5214 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5215 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5216 move_gap_both (PT
, PT_BYTE
);
5217 SET_PT_BOTH (opoint
, opoint_byte
);
5224 if (STRINGP (start
))
5226 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5227 &annotations
, &coding
);
5230 else if (XINT (start
) != XINT (end
))
5232 tem
= CHAR_TO_BYTE (XINT (start
));
5234 if (XINT (start
) < GPT
)
5236 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5237 min (GPT
, XINT (end
)) - XINT (start
),
5238 &annotations
, &coding
);
5242 if (XINT (end
) > GPT
&& !failure
)
5244 tem
= max (XINT (start
), GPT
);
5245 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5246 &annotations
, &coding
);
5252 /* If file was empty, still need to write the annotations */
5253 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5254 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5258 if (CODING_REQUIRE_FLUSHING (&coding
)
5259 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5262 /* We have to flush out a data. */
5263 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5264 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5271 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5272 Disk full in NFS may be reported here. */
5273 /* mib says that closing the file will try to write as fast as NFS can do
5274 it, and that means the fsync here is not crucial for autosave files. */
5275 if (!auto_saving
&& !write_region_inhibit_fsync
&& fsync (desc
) < 0)
5277 /* If fsync fails with EINTR, don't treat that as serious. Also
5278 ignore EINVAL which happens when fsync is not supported on this
5280 if (errno
!= EINTR
&& errno
!= EINVAL
)
5281 failure
= 1, save_errno
= errno
;
5285 /* Spurious "file has changed on disk" warnings have been
5286 observed on Suns as well.
5287 It seems that `close' can change the modtime, under nfs.
5289 (This has supposedly been fixed in Sunos 4,
5290 but who knows about all the other machines with NFS?) */
5293 /* On VMS and APOLLO, must do the stat after the close
5294 since closing changes the modtime. */
5297 /* Recall that #if defined does not work on VMS. */
5304 /* NFS can report a write failure now. */
5305 if (emacs_close (desc
) < 0)
5306 failure
= 1, save_errno
= errno
;
5309 /* If we wrote to a temporary name and had no errors, rename to real name. */
5313 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5321 /* Discard the unwind protect for close_file_unwind. */
5322 specpdl_ptr
= specpdl
+ count1
;
5323 /* Restore the original current buffer. */
5324 visit_file
= unbind_to (count
, visit_file
);
5326 #ifdef CLASH_DETECTION
5328 unlock_file (lockname
);
5329 #endif /* CLASH_DETECTION */
5331 /* Do this before reporting IO error
5332 to avoid a "file has changed on disk" warning on
5333 next attempt to save. */
5335 current_buffer
->modtime
= st
.st_mtime
;
5338 error ("IO error writing %s: %s", SDATA (filename
),
5339 emacs_strerror (save_errno
));
5343 SAVE_MODIFF
= MODIFF
;
5344 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5345 current_buffer
->filename
= visit_file
;
5346 update_mode_lines
++;
5351 && ! NILP (Fstring_equal (current_buffer
->filename
,
5352 current_buffer
->auto_save_file_name
)))
5353 SAVE_MODIFF
= MODIFF
;
5359 message_with_string ((INTEGERP (append
)
5369 Lisp_Object
merge ();
5371 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5372 doc
: /* Return t if (car A) is numerically less than (car B). */)
5376 return Flss (Fcar (a
), Fcar (b
));
5379 /* Build the complete list of annotations appropriate for writing out
5380 the text between START and END, by calling all the functions in
5381 write-region-annotate-functions and merging the lists they return.
5382 If one of these functions switches to a different buffer, we assume
5383 that buffer contains altered text. Therefore, the caller must
5384 make sure to restore the current buffer in all cases,
5385 as save-excursion would do. */
5388 build_annotations (start
, end
)
5389 Lisp_Object start
, end
;
5391 Lisp_Object annotations
;
5393 struct gcpro gcpro1
, gcpro2
;
5394 Lisp_Object original_buffer
;
5395 int i
, used_global
= 0;
5397 XSETBUFFER (original_buffer
, current_buffer
);
5400 p
= Vwrite_region_annotate_functions
;
5401 GCPRO2 (annotations
, p
);
5404 struct buffer
*given_buffer
= current_buffer
;
5405 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5406 { /* Use the global value of the hook. */
5409 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5411 p
= Fappend (2, arg
);
5414 Vwrite_region_annotations_so_far
= annotations
;
5415 res
= call2 (XCAR (p
), start
, end
);
5416 /* If the function makes a different buffer current,
5417 assume that means this buffer contains altered text to be output.
5418 Reset START and END from the buffer bounds
5419 and discard all previous annotations because they should have
5420 been dealt with by this function. */
5421 if (current_buffer
!= given_buffer
)
5423 XSETFASTINT (start
, BEGV
);
5424 XSETFASTINT (end
, ZV
);
5427 Flength (res
); /* Check basic validity of return value */
5428 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5432 /* Now do the same for annotation functions implied by the file-format */
5433 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
5434 p
= current_buffer
->auto_save_file_format
;
5436 p
= current_buffer
->file_format
;
5437 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5439 struct buffer
*given_buffer
= current_buffer
;
5441 Vwrite_region_annotations_so_far
= annotations
;
5443 /* Value is either a list of annotations or nil if the function
5444 has written annotations to a temporary buffer, which is now
5446 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5447 original_buffer
, make_number (i
));
5448 if (current_buffer
!= given_buffer
)
5450 XSETFASTINT (start
, BEGV
);
5451 XSETFASTINT (end
, ZV
);
5456 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5464 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5465 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5467 struct gcpro gcpro1
;
5470 GCPRO1 (annotations
);
5471 /* At last, do the same for the function PRE_WRITE_CONVERSION
5472 implied by the current coding-system. */
5473 if (!NILP (pre_write_conversion
))
5475 struct buffer
*given_buffer
= current_buffer
;
5476 Vwrite_region_annotations_so_far
= annotations
;
5477 res
= call2 (pre_write_conversion
, start
, end
);
5479 annotations
= (current_buffer
!= given_buffer
5481 : merge (annotations
, res
, Qcar_less_than_car
));
5488 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5489 If STRING is nil, POS is the character position in the current buffer.
5490 Intersperse with them the annotations from *ANNOT
5491 which fall within the range of POS to POS + NCHARS,
5492 each at its appropriate position.
5494 We modify *ANNOT by discarding elements as we use them up.
5496 The return value is negative in case of system call failure. */
5499 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5502 register int nchars
;
5505 struct coding_system
*coding
;
5509 int lastpos
= pos
+ nchars
;
5511 while (NILP (*annot
) || CONSP (*annot
))
5513 tem
= Fcar_safe (Fcar (*annot
));
5516 nextpos
= XFASTINT (tem
);
5518 /* If there are no more annotations in this range,
5519 output the rest of the range all at once. */
5520 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5521 return e_write (desc
, string
, pos
, lastpos
, coding
);
5523 /* Output buffer text up to the next annotation's position. */
5526 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5530 /* Output the annotation. */
5531 tem
= Fcdr (Fcar (*annot
));
5534 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5537 *annot
= Fcdr (*annot
);
5542 #ifndef WRITE_BUF_SIZE
5543 #define WRITE_BUF_SIZE (16 * 1024)
5546 /* Write text in the range START and END into descriptor DESC,
5547 encoding them with coding system CODING. If STRING is nil, START
5548 and END are character positions of the current buffer, else they
5549 are indexes to the string STRING. */
5552 e_write (desc
, string
, start
, end
, coding
)
5556 struct coding_system
*coding
;
5558 register char *addr
;
5559 register int nbytes
;
5560 char buf
[WRITE_BUF_SIZE
];
5564 coding
->composing
= COMPOSITION_DISABLED
;
5565 if (coding
->composing
!= COMPOSITION_DISABLED
)
5566 coding_save_composition (coding
, start
, end
, string
);
5568 if (STRINGP (string
))
5570 addr
= SDATA (string
);
5571 nbytes
= SBYTES (string
);
5572 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5574 else if (start
< end
)
5576 /* It is assured that the gap is not in the range START and END-1. */
5577 addr
= CHAR_POS_ADDR (start
);
5578 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5579 coding
->src_multibyte
5580 = !NILP (current_buffer
->enable_multibyte_characters
);
5586 coding
->src_multibyte
= 1;
5589 /* We used to have a code for handling selective display here. But,
5590 now it is handled within encode_coding. */
5595 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5596 if (coding
->produced
> 0)
5598 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5599 if (coding
->produced
)
5605 nbytes
-= coding
->consumed
;
5606 addr
+= coding
->consumed
;
5607 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5610 /* The source text ends by an incomplete multibyte form.
5611 There's no way other than write it out as is. */
5612 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5621 start
+= coding
->consumed_char
;
5622 if (coding
->cmp_data
)
5623 coding_adjust_composition_offset (coding
, start
);
5626 if (coding
->cmp_data
)
5627 coding_free_composition_data (coding
);
5632 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5633 Sverify_visited_file_modtime
, 1, 1, 0,
5634 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5635 This means that the file has not been changed since it was visited or saved.
5636 See Info node `(elisp)Modification Time' for more details. */)
5642 Lisp_Object handler
;
5643 Lisp_Object filename
;
5648 if (!STRINGP (b
->filename
)) return Qt
;
5649 if (b
->modtime
== 0) return Qt
;
5651 /* If the file name has special constructs in it,
5652 call the corresponding file handler. */
5653 handler
= Ffind_file_name_handler (b
->filename
,
5654 Qverify_visited_file_modtime
);
5655 if (!NILP (handler
))
5656 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5658 filename
= ENCODE_FILE (b
->filename
);
5660 if (stat (SDATA (filename
), &st
) < 0)
5662 /* If the file doesn't exist now and didn't exist before,
5663 we say that it isn't modified, provided the error is a tame one. */
5664 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5669 if (st
.st_mtime
== b
->modtime
5670 /* If both are positive, accept them if they are off by one second. */
5671 || (st
.st_mtime
> 0 && b
->modtime
> 0
5672 && (st
.st_mtime
== b
->modtime
+ 1
5673 || st
.st_mtime
== b
->modtime
- 1)))
5678 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5679 Sclear_visited_file_modtime
, 0, 0, 0,
5680 doc
: /* Clear out records of last mod time of visited file.
5681 Next attempt to save will certainly not complain of a discrepancy. */)
5684 current_buffer
->modtime
= 0;
5688 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5689 Svisited_file_modtime
, 0, 0, 0,
5690 doc
: /* Return the current buffer's recorded visited file modification time.
5691 The value is a list of the form (HIGH LOW), like the time values
5692 that `file-attributes' returns. If the current buffer has no recorded
5693 file modification time, this function returns 0.
5694 See Info node `(elisp)Modification Time' for more details. */)
5697 if (! current_buffer
->modtime
)
5698 return make_number (0);
5699 return make_time ((time_t) current_buffer
->modtime
);
5702 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5703 Sset_visited_file_modtime
, 0, 1, 0,
5704 doc
: /* Update buffer's recorded modification time from the visited file's time.
5705 Useful if the buffer was not read from the file normally
5706 or if the file itself has been changed for some known benign reason.
5707 An argument specifies the modification time value to use
5708 \(instead of that of the visited file), in the form of a list
5709 \(HIGH . LOW) or (HIGH LOW). */)
5711 Lisp_Object time_list
;
5713 if (!NILP (time_list
))
5714 current_buffer
->modtime
= cons_to_long (time_list
);
5717 register Lisp_Object filename
;
5719 Lisp_Object handler
;
5721 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5723 /* If the file name has special constructs in it,
5724 call the corresponding file handler. */
5725 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5726 if (!NILP (handler
))
5727 /* The handler can find the file name the same way we did. */
5728 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5730 filename
= ENCODE_FILE (filename
);
5732 if (stat (SDATA (filename
), &st
) >= 0)
5733 current_buffer
->modtime
= st
.st_mtime
;
5740 auto_save_error (error
)
5743 Lisp_Object args
[3], msg
;
5745 struct gcpro gcpro1
;
5751 args
[0] = build_string ("Auto-saving %s: %s");
5752 args
[1] = current_buffer
->name
;
5753 args
[2] = Ferror_message_string (error
);
5754 msg
= Fformat (3, args
);
5756 nbytes
= SBYTES (msg
);
5757 SAFE_ALLOCA (msgbuf
, char *, nbytes
);
5758 bcopy (SDATA (msg
), msgbuf
, nbytes
);
5760 for (i
= 0; i
< 3; ++i
)
5763 message2 (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5765 message2_nolog (msgbuf
, nbytes
, STRING_MULTIBYTE (msg
));
5766 Fsleep_for (make_number (1), Qnil
);
5780 auto_save_mode_bits
= 0666;
5782 /* Get visited file's mode to become the auto save file's mode. */
5783 if (! NILP (current_buffer
->filename
))
5785 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5786 /* But make sure we can overwrite it later! */
5787 auto_save_mode_bits
= st
.st_mode
| 0600;
5788 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5790 /* Remote files don't cooperate with stat. */
5791 auto_save_mode_bits
= XINT (modes
) | 0600;
5795 Fwrite_region (Qnil
, Qnil
,
5796 current_buffer
->auto_save_file_name
,
5797 Qnil
, Qlambda
, Qnil
, Qnil
);
5801 do_auto_save_unwind (arg
) /* used as unwind-protect function */
5804 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
5816 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5819 minibuffer_auto_raise
= XINT (value
);
5824 do_auto_save_make_dir (dir
)
5829 call2 (Qmake_directory
, dir
, Qt
);
5830 XSETFASTINT (mode
, 0700);
5831 return Fset_file_modes (dir
, mode
);
5835 do_auto_save_eh (ignore
)
5841 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5842 doc
: /* Auto-save all buffers that need it.
5843 This is all buffers that have auto-saving enabled
5844 and are changed since last auto-saved.
5845 Auto-saving writes the buffer into a file
5846 so that your editing is not lost if the system crashes.
5847 This file is not the file you visited; that changes only when you save.
5848 Normally we run the normal hook `auto-save-hook' before saving.
5850 A non-nil NO-MESSAGE argument means do not print any message if successful.
5851 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5852 (no_message
, current_only
)
5853 Lisp_Object no_message
, current_only
;
5855 struct buffer
*old
= current_buffer
, *b
;
5856 Lisp_Object tail
, buf
;
5858 int do_handled_files
;
5860 FILE *stream
= NULL
;
5861 int count
= SPECPDL_INDEX ();
5862 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5863 int old_message_p
= 0;
5864 struct gcpro gcpro1
, gcpro2
;
5866 if (max_specpdl_size
< specpdl_size
+ 40)
5867 max_specpdl_size
= specpdl_size
+ 40;
5872 if (NILP (no_message
))
5874 old_message_p
= push_message ();
5875 record_unwind_protect (pop_message_unwind
, Qnil
);
5878 /* Ordinarily don't quit within this function,
5879 but don't make it impossible to quit (in case we get hung in I/O). */
5883 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5884 point to non-strings reached from Vbuffer_alist. */
5886 if (!NILP (Vrun_hooks
))
5887 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5889 if (STRINGP (Vauto_save_list_file_name
))
5891 Lisp_Object listfile
;
5893 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5895 /* Don't try to create the directory when shutting down Emacs,
5896 because creating the directory might signal an error, and
5897 that would leave Emacs in a strange state. */
5898 if (!NILP (Vrun_hooks
))
5902 GCPRO2 (dir
, listfile
);
5903 dir
= Ffile_name_directory (listfile
);
5904 if (NILP (Ffile_directory_p (dir
)))
5905 internal_condition_case_1 (do_auto_save_make_dir
,
5906 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5911 stream
= fopen (SDATA (listfile
), "w");
5914 record_unwind_protect (do_auto_save_unwind
,
5915 make_save_value (stream
, 0));
5916 record_unwind_protect (do_auto_save_unwind_1
,
5917 make_number (minibuffer_auto_raise
));
5918 minibuffer_auto_raise
= 0;
5921 /* On first pass, save all files that don't have handlers.
5922 On second pass, save all files that do have handlers.
5924 If Emacs is crashing, the handlers may tweak what is causing
5925 Emacs to crash in the first place, and it would be a shame if
5926 Emacs failed to autosave perfectly ordinary files because it
5927 couldn't handle some ange-ftp'd file. */
5929 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5930 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5932 buf
= XCDR (XCAR (tail
));
5935 /* Record all the buffers that have auto save mode
5936 in the special file that lists them. For each of these buffers,
5937 Record visited name (if any) and auto save name. */
5938 if (STRINGP (b
->auto_save_file_name
)
5939 && stream
!= NULL
&& do_handled_files
== 0)
5942 if (!NILP (b
->filename
))
5944 fwrite (SDATA (b
->filename
), 1,
5945 SBYTES (b
->filename
), stream
);
5947 putc ('\n', stream
);
5948 fwrite (SDATA (b
->auto_save_file_name
), 1,
5949 SBYTES (b
->auto_save_file_name
), stream
);
5950 putc ('\n', stream
);
5954 if (!NILP (current_only
)
5955 && b
!= current_buffer
)
5958 /* Don't auto-save indirect buffers.
5959 The base buffer takes care of it. */
5963 /* Check for auto save enabled
5964 and file changed since last auto save
5965 and file changed since last real save. */
5966 if (STRINGP (b
->auto_save_file_name
)
5967 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5968 && b
->auto_save_modified
< BUF_MODIFF (b
)
5969 /* -1 means we've turned off autosaving for a while--see below. */
5970 && XINT (b
->save_length
) >= 0
5971 && (do_handled_files
5972 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5975 EMACS_TIME before_time
, after_time
;
5977 EMACS_GET_TIME (before_time
);
5979 /* If we had a failure, don't try again for 20 minutes. */
5980 if (b
->auto_save_failure_time
>= 0
5981 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5984 if ((XFASTINT (b
->save_length
) * 10
5985 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5986 /* A short file is likely to change a large fraction;
5987 spare the user annoying messages. */
5988 && XFASTINT (b
->save_length
) > 5000
5989 /* These messages are frequent and annoying for `*mail*'. */
5990 && !EQ (b
->filename
, Qnil
)
5991 && NILP (no_message
))
5993 /* It has shrunk too much; turn off auto-saving here. */
5994 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5995 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5997 minibuffer_auto_raise
= 0;
5998 /* Turn off auto-saving until there's a real save,
5999 and prevent any more warnings. */
6000 XSETINT (b
->save_length
, -1);
6001 Fsleep_for (make_number (1), Qnil
);
6004 set_buffer_internal (b
);
6005 if (!auto_saved
&& NILP (no_message
))
6006 message1 ("Auto-saving...");
6007 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
6009 b
->auto_save_modified
= BUF_MODIFF (b
);
6010 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6011 set_buffer_internal (old
);
6013 EMACS_GET_TIME (after_time
);
6015 /* If auto-save took more than 60 seconds,
6016 assume it was an NFS failure that got a timeout. */
6017 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
6018 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
6022 /* Prevent another auto save till enough input events come in. */
6023 record_auto_save ();
6025 if (auto_saved
&& NILP (no_message
))
6029 /* If we are going to restore an old message,
6030 give time to read ours. */
6031 sit_for (make_number (1), 0, 0);
6035 /* If we displayed a message and then restored a state
6036 with no message, leave a "done" message on the screen. */
6037 message1 ("Auto-saving...done");
6042 /* This restores the message-stack status. */
6043 unbind_to (count
, Qnil
);
6047 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
6048 Sset_buffer_auto_saved
, 0, 0, 0,
6049 doc
: /* Mark current buffer as auto-saved with its current text.
6050 No auto-save file will be written until the buffer changes again. */)
6053 current_buffer
->auto_save_modified
= MODIFF
;
6054 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6055 current_buffer
->auto_save_failure_time
= -1;
6059 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
6060 Sclear_buffer_auto_save_failure
, 0, 0, 0,
6061 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
6064 current_buffer
->auto_save_failure_time
= -1;
6068 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6070 doc
: /* Return t if current buffer has been auto-saved recently.
6071 More precisely, if it has been auto-saved since last read from or saved
6072 in the visited file. If the buffer has no visited file,
6073 then any auto-save counts as "recent". */)
6076 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6079 /* Reading and completing file names */
6080 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
6081 extern Lisp_Object Qcompletion_ignore_case
;
6083 /* In the string VAL, change each $ to $$ and return the result. */
6086 double_dollars (val
)
6089 register const unsigned char *old
;
6090 register unsigned char *new;
6094 osize
= SBYTES (val
);
6096 /* Count the number of $ characters. */
6097 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
6098 if (*old
++ == '$') count
++;
6102 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
6105 for (n
= osize
; n
> 0; n
--)
6119 read_file_name_cleanup (arg
)
6122 return (current_buffer
->directory
= arg
);
6125 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
6127 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
6128 (string
, dir
, action
)
6129 Lisp_Object string
, dir
, action
;
6130 /* action is nil for complete, t for return list of completions,
6131 lambda for verify final value */
6133 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
6135 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
6137 CHECK_STRING (string
);
6144 /* No need to protect ACTION--we only compare it with t and nil. */
6145 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6147 if (SCHARS (string
) == 0)
6149 if (EQ (action
, Qlambda
))
6157 orig_string
= string
;
6158 string
= Fsubstitute_in_file_name (string
);
6159 changed
= NILP (Fstring_equal (string
, orig_string
));
6160 name
= Ffile_name_nondirectory (string
);
6161 val
= Ffile_name_directory (string
);
6163 realdir
= Fexpand_file_name (val
, realdir
);
6168 specdir
= Ffile_name_directory (string
);
6169 val
= Ffile_name_completion (name
, realdir
, Vread_file_name_predicate
);
6174 return double_dollars (string
);
6178 if (!NILP (specdir
))
6179 val
= concat2 (specdir
, val
);
6181 return double_dollars (val
);
6184 #endif /* not VMS */
6188 if (EQ (action
, Qt
))
6190 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6194 if (NILP (Vread_file_name_predicate
)
6195 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6199 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6201 /* Brute-force speed up for directory checking:
6202 Discard strings which don't end in a slash. */
6203 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6205 Lisp_Object tem
= XCAR (all
);
6208 && (len
= SBYTES (tem
), len
> 0)
6209 && IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6210 comp
= Fcons (tem
, comp
);
6216 /* Must do it the hard (and slow) way. */
6218 GCPRO3 (all
, comp
, specdir
);
6219 count
= SPECPDL_INDEX ();
6220 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6221 current_buffer
->directory
= realdir
;
6222 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6224 tem
= call1 (Vread_file_name_predicate
, XCAR (all
));
6226 comp
= Fcons (XCAR (all
), comp
);
6228 unbind_to (count
, Qnil
);
6231 return Fnreverse (comp
);
6234 /* Only other case actually used is ACTION = lambda */
6236 /* Supposedly this helps commands such as `cd' that read directory names,
6237 but can someone explain how it helps them? -- RMS */
6238 if (SCHARS (name
) == 0)
6241 string
= Fexpand_file_name (string
, dir
);
6242 if (!NILP (Vread_file_name_predicate
))
6243 return call1 (Vread_file_name_predicate
, string
);
6244 return Ffile_exists_p (string
);
6247 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
6248 Snext_read_file_uses_dialog_p
, 0, 0, 0,
6249 doc
: /* Return t if a call to `read-file-name' will use a dialog.
6250 The return value is only relevant for a call to `read-file-name' that happens
6251 before any other event (mouse or keypress) is handeled. */)
6254 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6255 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6264 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6265 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6266 Value is not expanded---you must call `expand-file-name' yourself.
6267 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6268 the same non-empty string that was inserted by this function.
6269 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6270 except that if INITIAL is specified, that combined with DIR is used.)
6271 If the user exits with an empty minibuffer, this function returns
6272 an empty string. (This can only happen if the user erased the
6273 pre-inserted contents or if `insert-default-directory' is nil.)
6274 Fourth arg MUSTMATCH non-nil means require existing file's name.
6275 Non-nil and non-t means also require confirmation after completion.
6276 Fifth arg INITIAL specifies text to start with.
6277 If optional sixth arg PREDICATE is non-nil, possible completions and
6278 the resulting file name must satisfy (funcall PREDICATE NAME).
6279 DIR should be an absolute directory name. It defaults to the value of
6280 `default-directory'.
6282 If this command was invoked with the mouse, use a file dialog box if
6283 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6284 provides a file dialog box.
6286 See also `read-file-name-completion-ignore-case'
6287 and `read-file-name-function'. */)
6288 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6289 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6291 Lisp_Object val
, insdef
, tem
;
6292 struct gcpro gcpro1
, gcpro2
;
6293 register char *homedir
;
6294 Lisp_Object decoded_homedir
;
6295 int replace_in_history
= 0;
6296 int add_to_history
= 0;
6300 dir
= current_buffer
->directory
;
6301 if (NILP (Ffile_name_absolute_p (dir
)))
6302 dir
= Fexpand_file_name (dir
, Qnil
);
6303 if (NILP (default_filename
))
6306 ? Fexpand_file_name (initial
, dir
)
6307 : current_buffer
->filename
);
6309 /* If dir starts with user's homedir, change that to ~. */
6310 homedir
= (char *) egetenv ("HOME");
6312 /* homedir can be NULL in temacs, since Vprocess_environment is not
6313 yet set up. We shouldn't crash in that case. */
6316 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6317 CORRECT_DIR_SEPS (homedir
);
6322 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6325 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6326 SBYTES (decoded_homedir
))
6327 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6329 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6330 dir
= concat2 (build_string ("~"), dir
);
6332 /* Likewise for default_filename. */
6334 && STRINGP (default_filename
)
6335 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6336 SBYTES (decoded_homedir
))
6337 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6340 = Fsubstring (default_filename
,
6341 make_number (SCHARS (decoded_homedir
)), Qnil
);
6342 default_filename
= concat2 (build_string ("~"), default_filename
);
6344 if (!NILP (default_filename
))
6346 CHECK_STRING (default_filename
);
6347 default_filename
= double_dollars (default_filename
);
6350 if (insert_default_directory
&& STRINGP (dir
))
6353 if (!NILP (initial
))
6355 Lisp_Object args
[2], pos
;
6359 insdef
= Fconcat (2, args
);
6360 pos
= make_number (SCHARS (double_dollars (dir
)));
6361 insdef
= Fcons (double_dollars (insdef
), pos
);
6364 insdef
= double_dollars (insdef
);
6366 else if (STRINGP (initial
))
6367 insdef
= Fcons (double_dollars (initial
), make_number (0));
6371 if (!NILP (Vread_file_name_function
))
6373 Lisp_Object args
[7];
6375 GCPRO2 (insdef
, default_filename
);
6376 args
[0] = Vread_file_name_function
;
6379 args
[3] = default_filename
;
6380 args
[4] = mustmatch
;
6382 args
[6] = predicate
;
6383 RETURN_UNGCPRO (Ffuncall (7, args
));
6386 count
= SPECPDL_INDEX ();
6387 specbind (Qcompletion_ignore_case
,
6388 read_file_name_completion_ignore_case
? Qt
: Qnil
);
6389 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6390 specbind (intern ("read-file-name-predicate"),
6391 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6393 GCPRO2 (insdef
, default_filename
);
6395 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6396 if (! NILP (Fnext_read_file_uses_dialog_p ()))
6398 /* If DIR contains a file name, split it. */
6400 file
= Ffile_name_nondirectory (dir
);
6401 if (SCHARS (file
) && NILP (default_filename
))
6403 default_filename
= file
;
6404 dir
= Ffile_name_directory (dir
);
6406 if (!NILP(default_filename
))
6407 default_filename
= Fexpand_file_name (default_filename
, dir
);
6408 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
,
6409 EQ (predicate
, Qfile_directory_p
) ? Qt
: Qnil
);
6414 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6415 dir
, mustmatch
, insdef
,
6416 Qfile_name_history
, default_filename
, Qnil
);
6418 tem
= Fsymbol_value (Qfile_name_history
);
6419 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6420 replace_in_history
= 1;
6422 /* If Fcompleting_read returned the inserted default string itself
6423 (rather than a new string with the same contents),
6424 it has to mean that the user typed RET with the minibuffer empty.
6425 In that case, we really want to return ""
6426 so that commands such as set-visited-file-name can distinguish. */
6427 if (EQ (val
, default_filename
))
6429 /* In this case, Fcompleting_read has not added an element
6430 to the history. Maybe we should. */
6431 if (! replace_in_history
)
6437 unbind_to (count
, Qnil
);
6440 error ("No file name specified");
6442 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6444 if (!NILP (tem
) && !NILP (default_filename
))
6445 val
= default_filename
;
6446 val
= Fsubstitute_in_file_name (val
);
6448 if (replace_in_history
)
6449 /* Replace what Fcompleting_read added to the history
6450 with what we will actually return. */
6452 Lisp_Object val1
= double_dollars (val
);
6453 tem
= Fsymbol_value (Qfile_name_history
);
6454 if (history_delete_duplicates
)
6455 XSETCDR (tem
, Fdelete (val1
, XCDR(tem
)));
6456 XSETCAR (tem
, val1
);
6458 else if (add_to_history
)
6460 /* Add the value to the history--but not if it matches
6461 the last value already there. */
6462 Lisp_Object val1
= double_dollars (val
);
6463 tem
= Fsymbol_value (Qfile_name_history
);
6464 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6466 if (history_delete_duplicates
) tem
= Fdelete (val1
, tem
);
6467 Fset (Qfile_name_history
, Fcons (val1
, tem
));
6478 /* Must be set before any path manipulation is performed. */
6479 XSETFASTINT (Vdirectory_sep_char
, '/');
6486 Qoperations
= intern ("operations");
6487 Qexpand_file_name
= intern ("expand-file-name");
6488 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6489 Qdirectory_file_name
= intern ("directory-file-name");
6490 Qfile_name_directory
= intern ("file-name-directory");
6491 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6492 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6493 Qfile_name_as_directory
= intern ("file-name-as-directory");
6494 Qcopy_file
= intern ("copy-file");
6495 Qmake_directory_internal
= intern ("make-directory-internal");
6496 Qmake_directory
= intern ("make-directory");
6497 Qdelete_directory
= intern ("delete-directory");
6498 Qdelete_file
= intern ("delete-file");
6499 Qrename_file
= intern ("rename-file");
6500 Qadd_name_to_file
= intern ("add-name-to-file");
6501 Qmake_symbolic_link
= intern ("make-symbolic-link");
6502 Qfile_exists_p
= intern ("file-exists-p");
6503 Qfile_executable_p
= intern ("file-executable-p");
6504 Qfile_readable_p
= intern ("file-readable-p");
6505 Qfile_writable_p
= intern ("file-writable-p");
6506 Qfile_symlink_p
= intern ("file-symlink-p");
6507 Qaccess_file
= intern ("access-file");
6508 Qfile_directory_p
= intern ("file-directory-p");
6509 Qfile_regular_p
= intern ("file-regular-p");
6510 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6511 Qfile_modes
= intern ("file-modes");
6512 Qset_file_modes
= intern ("set-file-modes");
6513 Qset_file_times
= intern ("set-file-times");
6514 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6515 Qinsert_file_contents
= intern ("insert-file-contents");
6516 Qwrite_region
= intern ("write-region");
6517 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6518 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6519 Qauto_save_coding
= intern ("auto-save-coding");
6521 staticpro (&Qoperations
);
6522 staticpro (&Qexpand_file_name
);
6523 staticpro (&Qsubstitute_in_file_name
);
6524 staticpro (&Qdirectory_file_name
);
6525 staticpro (&Qfile_name_directory
);
6526 staticpro (&Qfile_name_nondirectory
);
6527 staticpro (&Qunhandled_file_name_directory
);
6528 staticpro (&Qfile_name_as_directory
);
6529 staticpro (&Qcopy_file
);
6530 staticpro (&Qmake_directory_internal
);
6531 staticpro (&Qmake_directory
);
6532 staticpro (&Qdelete_directory
);
6533 staticpro (&Qdelete_file
);
6534 staticpro (&Qrename_file
);
6535 staticpro (&Qadd_name_to_file
);
6536 staticpro (&Qmake_symbolic_link
);
6537 staticpro (&Qfile_exists_p
);
6538 staticpro (&Qfile_executable_p
);
6539 staticpro (&Qfile_readable_p
);
6540 staticpro (&Qfile_writable_p
);
6541 staticpro (&Qaccess_file
);
6542 staticpro (&Qfile_symlink_p
);
6543 staticpro (&Qfile_directory_p
);
6544 staticpro (&Qfile_regular_p
);
6545 staticpro (&Qfile_accessible_directory_p
);
6546 staticpro (&Qfile_modes
);
6547 staticpro (&Qset_file_modes
);
6548 staticpro (&Qset_file_times
);
6549 staticpro (&Qfile_newer_than_file_p
);
6550 staticpro (&Qinsert_file_contents
);
6551 staticpro (&Qwrite_region
);
6552 staticpro (&Qverify_visited_file_modtime
);
6553 staticpro (&Qset_visited_file_modtime
);
6554 staticpro (&Qauto_save_coding
);
6556 Qfile_name_history
= intern ("file-name-history");
6557 Fset (Qfile_name_history
, Qnil
);
6558 staticpro (&Qfile_name_history
);
6560 Qfile_error
= intern ("file-error");
6561 staticpro (&Qfile_error
);
6562 Qfile_already_exists
= intern ("file-already-exists");
6563 staticpro (&Qfile_already_exists
);
6564 Qfile_date_error
= intern ("file-date-error");
6565 staticpro (&Qfile_date_error
);
6566 Qexcl
= intern ("excl");
6570 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6571 staticpro (&Qfind_buffer_file_type
);
6574 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6575 doc
: /* *Coding system for encoding file names.
6576 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6577 Vfile_name_coding_system
= Qnil
;
6579 DEFVAR_LISP ("default-file-name-coding-system",
6580 &Vdefault_file_name_coding_system
,
6581 doc
: /* Default coding system for encoding file names.
6582 This variable is used only when `file-name-coding-system' is nil.
6584 This variable is set/changed by the command `set-language-environment'.
6585 User should not set this variable manually,
6586 instead use `file-name-coding-system' to get a constant encoding
6587 of file names regardless of the current language environment. */);
6588 Vdefault_file_name_coding_system
= Qnil
;
6590 Qformat_decode
= intern ("format-decode");
6591 staticpro (&Qformat_decode
);
6592 Qformat_annotate_function
= intern ("format-annotate-function");
6593 staticpro (&Qformat_annotate_function
);
6594 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6595 staticpro (&Qafter_insert_file_set_coding
);
6597 Qcar_less_than_car
= intern ("car-less-than-car");
6598 staticpro (&Qcar_less_than_car
);
6600 Fput (Qfile_error
, Qerror_conditions
,
6601 list2 (Qfile_error
, Qerror
));
6602 Fput (Qfile_error
, Qerror_message
,
6603 build_string ("File error"));
6605 Fput (Qfile_already_exists
, Qerror_conditions
,
6606 list3 (Qfile_already_exists
, Qfile_error
, Qerror
));
6607 Fput (Qfile_already_exists
, Qerror_message
,
6608 build_string ("File already exists"));
6610 Fput (Qfile_date_error
, Qerror_conditions
,
6611 list3 (Qfile_date_error
, Qfile_error
, Qerror
));
6612 Fput (Qfile_date_error
, Qerror_message
,
6613 build_string ("Cannot set file date"));
6615 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6616 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6617 Vread_file_name_function
= Qnil
;
6619 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6620 doc
: /* Current predicate used by `read-file-name-internal'. */);
6621 Vread_file_name_predicate
= Qnil
;
6623 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case
,
6624 doc
: /* *Non-nil means when reading a file name completion ignores case. */);
6625 #if defined VMS || defined DOS_NT || defined MAC_OS
6626 read_file_name_completion_ignore_case
= 1;
6628 read_file_name_completion_ignore_case
= 0;
6631 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6632 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6634 When the initial minibuffer contents show a name of a file or a directory,
6635 typing RETURN without editing the initial contents is equivalent to typing
6636 the default file name.
6638 If this variable is non-nil, the minibuffer contents are always
6639 initially non-empty, and typing RETURN without editing will fetch the
6640 default name, if one is provided. Note however that this default name
6641 is not necessarily the same as initial contents inserted in the minibuffer,
6642 if the initial contents is just the default directory.
6644 If this variable is nil, the minibuffer often starts out empty. In
6645 that case you may have to explicitly fetch the next history element to
6646 request the default name; typing RETURN without editing will leave
6647 the minibuffer empty.
6649 For some commands, exiting with an empty minibuffer has a special meaning,
6650 such as making the current buffer visit no file in the case of
6651 `set-visited-file-name'. */);
6652 insert_default_directory
= 1;
6654 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6655 doc
: /* *Non-nil means write new files with record format `stmlf'.
6656 nil means use format `var'. This variable is meaningful only on VMS. */);
6657 vms_stmlf_recfm
= 0;
6659 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6660 doc
: /* Directory separator character for built-in functions that return file names.
6661 The value is always ?/. Don't use this variable, just use `/'. */);
6663 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6664 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6665 If a file name matches REGEXP, then all I/O on that file is done by calling
6668 The first argument given to HANDLER is the name of the I/O primitive
6669 to be handled; the remaining arguments are the arguments that were
6670 passed to that primitive. For example, if you do
6671 (file-exists-p FILENAME)
6672 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6673 (funcall HANDLER 'file-exists-p FILENAME)
6674 The function `find-file-name-handler' checks this list for a handler
6675 for its argument. */);
6676 Vfile_name_handler_alist
= Qnil
;
6678 DEFVAR_LISP ("set-auto-coding-function",
6679 &Vset_auto_coding_function
,
6680 doc
: /* If non-nil, a function to call to decide a coding system of file.
6681 Two arguments are passed to this function: the file name
6682 and the length of a file contents following the point.
6683 This function should return a coding system to decode the file contents.
6684 It should check the file name against `auto-coding-alist'.
6685 If no coding system is decided, it should check a coding system
6686 specified in the heading lines with the format:
6687 -*- ... coding: CODING-SYSTEM; ... -*-
6688 or local variable spec of the tailing lines with `coding:' tag. */);
6689 Vset_auto_coding_function
= Qnil
;
6691 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6692 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6693 Each is passed one argument, the number of characters inserted.
6694 It should return the new character count, and leave point the same.
6695 If `insert-file-contents' is intercepted by a handler from
6696 `file-name-handler-alist', that handler is responsible for calling the
6697 functions in `after-insert-file-functions' if appropriate. */);
6698 Vafter_insert_file_functions
= Qnil
;
6700 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6701 doc
: /* A list of functions to be called at the start of `write-region'.
6702 Each is passed two arguments, START and END as for `write-region'.
6703 These are usually two numbers but not always; see the documentation
6704 for `write-region'. The function should return a list of pairs
6705 of the form (POSITION . STRING), consisting of strings to be effectively
6706 inserted at the specified positions of the file being written (1 means to
6707 insert before the first byte written). The POSITIONs must be sorted into
6708 increasing order. If there are several functions in the list, the several
6709 lists are merged destructively. Alternatively, the function can return
6710 with a different buffer current; in that case it should pay attention
6711 to the annotations returned by previous functions and listed in
6712 `write-region-annotations-so-far'.*/);
6713 Vwrite_region_annotate_functions
= Qnil
;
6714 staticpro (&Qwrite_region_annotate_functions
);
6715 Qwrite_region_annotate_functions
6716 = intern ("write-region-annotate-functions");
6718 DEFVAR_LISP ("write-region-annotations-so-far",
6719 &Vwrite_region_annotations_so_far
,
6720 doc
: /* When an annotation function is called, this holds the previous annotations.
6721 These are the annotations made by other annotation functions
6722 that were already called. See also `write-region-annotate-functions'. */);
6723 Vwrite_region_annotations_so_far
= Qnil
;
6725 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6726 doc
: /* A list of file name handlers that temporarily should not be used.
6727 This applies only to the operation `inhibit-file-name-operation'. */);
6728 Vinhibit_file_name_handlers
= Qnil
;
6730 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6731 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6732 Vinhibit_file_name_operation
= Qnil
;
6734 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6735 doc
: /* File name in which we write a list of all auto save file names.
6736 This variable is initialized automatically from `auto-save-list-file-prefix'
6737 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6738 a non-nil value. */);
6739 Vauto_save_list_file_name
= Qnil
;
6742 DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync
,
6743 doc
: /* *Non-nil means don't call fsync in `write-region'.
6744 This variable affects calls to `write-region' as well as save commands.
6745 A non-nil value may result in data loss! */);
6746 write_region_inhibit_fsync
= 0;
6749 defsubr (&Sfind_file_name_handler
);
6750 defsubr (&Sfile_name_directory
);
6751 defsubr (&Sfile_name_nondirectory
);
6752 defsubr (&Sunhandled_file_name_directory
);
6753 defsubr (&Sfile_name_as_directory
);
6754 defsubr (&Sdirectory_file_name
);
6755 defsubr (&Smake_temp_name
);
6756 defsubr (&Sexpand_file_name
);
6757 defsubr (&Ssubstitute_in_file_name
);
6758 defsubr (&Scopy_file
);
6759 defsubr (&Smake_directory_internal
);
6760 defsubr (&Sdelete_directory
);
6761 defsubr (&Sdelete_file
);
6762 defsubr (&Srename_file
);
6763 defsubr (&Sadd_name_to_file
);
6765 defsubr (&Smake_symbolic_link
);
6766 #endif /* S_IFLNK */
6768 defsubr (&Sdefine_logical_name
);
6771 defsubr (&Ssysnetunam
);
6772 #endif /* HPUX_NET */
6773 defsubr (&Sfile_name_absolute_p
);
6774 defsubr (&Sfile_exists_p
);
6775 defsubr (&Sfile_executable_p
);
6776 defsubr (&Sfile_readable_p
);
6777 defsubr (&Sfile_writable_p
);
6778 defsubr (&Saccess_file
);
6779 defsubr (&Sfile_symlink_p
);
6780 defsubr (&Sfile_directory_p
);
6781 defsubr (&Sfile_accessible_directory_p
);
6782 defsubr (&Sfile_regular_p
);
6783 defsubr (&Sfile_modes
);
6784 defsubr (&Sset_file_modes
);
6785 defsubr (&Sset_file_times
);
6786 defsubr (&Sset_default_file_modes
);
6787 defsubr (&Sdefault_file_modes
);
6788 defsubr (&Sfile_newer_than_file_p
);
6789 defsubr (&Sinsert_file_contents
);
6790 defsubr (&Swrite_region
);
6791 defsubr (&Scar_less_than_car
);
6792 defsubr (&Sverify_visited_file_modtime
);
6793 defsubr (&Sclear_visited_file_modtime
);
6794 defsubr (&Svisited_file_modtime
);
6795 defsubr (&Sset_visited_file_modtime
);
6796 defsubr (&Sdo_auto_save
);
6797 defsubr (&Sset_buffer_auto_saved
);
6798 defsubr (&Sclear_buffer_auto_save_failure
);
6799 defsubr (&Srecent_auto_save_p
);
6801 defsubr (&Sread_file_name_internal
);
6802 defsubr (&Sread_file_name
);
6803 defsubr (&Snext_read_file_uses_dialog_p
);
6806 defsubr (&Sunix_sync
);
6810 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6811 (do not change this comment) */