1 /* File IO for GNU Emacs.
2 Copyright (C) 1985,86,87,88,93,94,95,96,97,98,99,2000, 2001
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
29 #include <sys/types.h>
36 #if !defined (S_ISLNK) && defined (S_IFLNK)
37 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
40 #if !defined (S_ISFIFO) && defined (S_IFIFO)
41 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
44 #if !defined (S_ISREG) && defined (S_IFREG)
45 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
76 #include "intervals.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
;
150 /* Nonzero during writing of auto-save files */
153 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
154 a new file with the same mode as the original */
155 int auto_save_mode_bits
;
157 /* Coding system for file names, or nil if none. */
158 Lisp_Object Vfile_name_coding_system
;
160 /* Coding system for file names used only when
161 Vfile_name_coding_system is nil. */
162 Lisp_Object Vdefault_file_name_coding_system
;
164 /* Alist of elements (REGEXP . HANDLER) for file names
165 whose I/O is done with a special handler. */
166 Lisp_Object Vfile_name_handler_alist
;
168 /* Format for auto-save files */
169 Lisp_Object Vauto_save_file_format
;
171 /* Lisp functions for translating file formats */
172 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
174 /* Function to be called to decide a coding system of a reading file. */
175 Lisp_Object Vset_auto_coding_function
;
177 /* Functions to be called to process text properties in inserted file. */
178 Lisp_Object Vafter_insert_file_functions
;
180 /* Lisp function for setting buffer-file-coding-system and the
181 multibyteness of the current buffer after inserting a file. */
182 Lisp_Object Qafter_insert_file_set_coding
;
184 /* Functions to be called to create text property annotations for file. */
185 Lisp_Object Vwrite_region_annotate_functions
;
186 Lisp_Object Qwrite_region_annotate_functions
;
188 /* During build_annotations, each time an annotation function is called,
189 this holds the annotations made by the previous functions. */
190 Lisp_Object Vwrite_region_annotations_so_far
;
192 /* File name in which we write a list of all our auto save files. */
193 Lisp_Object Vauto_save_list_file_name
;
195 /* Function to call to read a file name. */
196 Lisp_Object Vread_file_name_function
;
198 /* Current predicate used by read_file_name_internal. */
199 Lisp_Object Vread_file_name_predicate
;
201 /* Nonzero means, when reading a filename in the minibuffer,
202 start out by inserting the default directory into the minibuffer. */
203 int insert_default_directory
;
205 /* On VMS, nonzero means write new files with record format stmlf.
206 Zero means use var format. */
209 /* On NT, specifies the directory separator character, used (eg.) when
210 expanding file names. This can be bound to / or \. */
211 Lisp_Object Vdirectory_sep_char
;
213 extern Lisp_Object Vuser_login_name
;
216 extern Lisp_Object Vw32_get_true_file_attributes
;
219 extern int minibuf_level
;
221 extern int minibuffer_auto_raise
;
223 /* These variables describe handlers that have "already" had a chance
224 to handle the current operation.
226 Vinhibit_file_name_handlers is a list of file name handlers.
227 Vinhibit_file_name_operation is the operation being handled.
228 If we try to handle that operation, we ignore those handlers. */
230 static Lisp_Object Vinhibit_file_name_handlers
;
231 static Lisp_Object Vinhibit_file_name_operation
;
233 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
235 Lisp_Object Qfile_name_history
;
237 Lisp_Object Qcar_less_than_car
;
239 static int a_write
P_ ((int, Lisp_Object
, int, int,
240 Lisp_Object
*, struct coding_system
*));
241 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
245 report_file_error (string
, data
)
249 Lisp_Object errstring
;
252 synchronize_system_messages_locale ();
253 errstring
= code_convert_string_norecord (build_string (strerror (errorno
)),
254 Vlocale_coding_system
, 0);
260 Fsignal (Qfile_already_exists
, Fcons (errstring
, data
));
263 /* System error messages are capitalized. Downcase the initial
264 unless it is followed by a slash. */
265 if (SREF (errstring
, 1) != '/')
266 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
268 Fsignal (Qfile_error
,
269 Fcons (build_string (string
), Fcons (errstring
, data
)));
274 close_file_unwind (fd
)
277 emacs_close (XFASTINT (fd
));
281 /* Restore point, having saved it as a marker. */
284 restore_point_unwind (location
)
285 Lisp_Object location
;
287 Fgoto_char (location
);
288 Fset_marker (location
, Qnil
, Qnil
);
292 Lisp_Object Qexpand_file_name
;
293 Lisp_Object Qsubstitute_in_file_name
;
294 Lisp_Object Qdirectory_file_name
;
295 Lisp_Object Qfile_name_directory
;
296 Lisp_Object Qfile_name_nondirectory
;
297 Lisp_Object Qunhandled_file_name_directory
;
298 Lisp_Object Qfile_name_as_directory
;
299 Lisp_Object Qcopy_file
;
300 Lisp_Object Qmake_directory_internal
;
301 Lisp_Object Qmake_directory
;
302 Lisp_Object Qdelete_directory
;
303 Lisp_Object Qdelete_file
;
304 Lisp_Object Qrename_file
;
305 Lisp_Object Qadd_name_to_file
;
306 Lisp_Object Qmake_symbolic_link
;
307 Lisp_Object Qfile_exists_p
;
308 Lisp_Object Qfile_executable_p
;
309 Lisp_Object Qfile_readable_p
;
310 Lisp_Object Qfile_writable_p
;
311 Lisp_Object Qfile_symlink_p
;
312 Lisp_Object Qaccess_file
;
313 Lisp_Object Qfile_directory_p
;
314 Lisp_Object Qfile_regular_p
;
315 Lisp_Object Qfile_accessible_directory_p
;
316 Lisp_Object Qfile_modes
;
317 Lisp_Object Qset_file_modes
;
318 Lisp_Object Qfile_newer_than_file_p
;
319 Lisp_Object Qinsert_file_contents
;
320 Lisp_Object Qwrite_region
;
321 Lisp_Object Qverify_visited_file_modtime
;
322 Lisp_Object Qset_visited_file_modtime
;
324 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
325 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
326 Otherwise, return nil.
327 A file name is handled if one of the regular expressions in
328 `file-name-handler-alist' matches it.
330 If OPERATION equals `inhibit-file-name-operation', then we ignore
331 any handlers that are members of `inhibit-file-name-handlers',
332 but we still do run any other handlers. This lets handlers
333 use the standard functions without calling themselves recursively. */)
334 (filename
, operation
)
335 Lisp_Object filename
, operation
;
337 /* This function must not munge the match data. */
338 Lisp_Object chain
, inhibited_handlers
, result
;
342 CHECK_STRING (filename
);
344 if (EQ (operation
, Vinhibit_file_name_operation
))
345 inhibited_handlers
= Vinhibit_file_name_handlers
;
347 inhibited_handlers
= Qnil
;
349 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
350 chain
= XCDR (chain
))
360 && (match_pos
= fast_string_match (string
, filename
)) > pos
)
362 Lisp_Object handler
, tem
;
364 handler
= XCDR (elt
);
365 tem
= Fmemq (handler
, inhibited_handlers
);
379 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
381 doc
: /* Return the directory component in file name FILENAME.
382 Return nil if FILENAME does not include a directory.
383 Otherwise return a directory spec.
384 Given a Unix syntax file name, returns a string ending in slash;
385 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
387 Lisp_Object filename
;
390 register const unsigned char *beg
;
392 register unsigned char *beg
;
394 register const unsigned char *p
;
397 CHECK_STRING (filename
);
399 /* If the file name has special constructs in it,
400 call the corresponding file handler. */
401 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
403 return call2 (handler
, Qfile_name_directory
, filename
);
405 #ifdef FILE_SYSTEM_CASE
406 filename
= FILE_SYSTEM_CASE (filename
);
408 beg
= SDATA (filename
);
410 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
412 p
= beg
+ SBYTES (filename
);
414 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
416 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
419 /* only recognise drive specifier at the beginning */
421 /* handle the "/:d:foo" and "/:foo" cases correctly */
422 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
423 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
430 /* Expansion of "c:" to drive and default directory. */
433 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
434 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
435 unsigned char *r
= res
;
437 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
439 strncpy (res
, beg
, 2);
444 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
446 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
449 p
= beg
+ strlen (beg
);
452 CORRECT_DIR_SEPS (beg
);
455 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
458 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
459 Sfile_name_nondirectory
, 1, 1, 0,
460 doc
: /* Return file name FILENAME sans its directory.
461 For example, in a Unix-syntax file name,
462 this is everything after the last slash,
463 or the entire name if it contains no slash. */)
465 Lisp_Object filename
;
467 register const unsigned char *beg
, *p
, *end
;
470 CHECK_STRING (filename
);
472 /* If the file name has special constructs in it,
473 call the corresponding file handler. */
474 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
476 return call2 (handler
, Qfile_name_nondirectory
, filename
);
478 beg
= SDATA (filename
);
479 end
= p
= beg
+ SBYTES (filename
);
481 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
483 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
486 /* only recognise drive specifier at beginning */
488 /* handle the "/:d:foo" case correctly */
489 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
494 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
497 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
498 Sunhandled_file_name_directory
, 1, 1, 0,
499 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
500 A `directly usable' directory name is one that may be used without the
501 intervention of any file handler.
502 If FILENAME is a directly usable file itself, return
503 \(file-name-directory FILENAME).
504 The `call-process' and `start-process' functions use this function to
505 get a current directory to run processes in. */)
507 Lisp_Object filename
;
511 /* If the file name has special constructs in it,
512 call the corresponding file handler. */
513 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
515 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
517 return Ffile_name_directory (filename
);
522 file_name_as_directory (out
, in
)
525 int size
= strlen (in
) - 1;
538 /* Is it already a directory string? */
539 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
541 /* Is it a VMS directory file name? If so, hack VMS syntax. */
542 else if (! index (in
, '/')
543 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
544 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
545 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
546 || ! strncmp (&in
[size
- 5], ".dir", 4))
547 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
548 && in
[size
] == '1')))
550 register char *p
, *dot
;
554 dir:x.dir --> dir:[x]
555 dir:[x]y.dir --> dir:[x.y] */
557 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
560 strncpy (out
, in
, p
- in
);
579 dot
= index (p
, '.');
582 /* blindly remove any extension */
583 size
= strlen (out
) + (dot
- p
);
584 strncat (out
, p
, dot
- p
);
595 /* For Unix syntax, Append a slash if necessary */
596 if (!IS_DIRECTORY_SEP (out
[size
]))
598 /* Cannot use DIRECTORY_SEP, which could have any value */
600 out
[size
+ 2] = '\0';
603 CORRECT_DIR_SEPS (out
);
609 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
610 Sfile_name_as_directory
, 1, 1, 0,
611 doc
: /* Return a string representing the file name FILE interpreted as a directory.
612 This operation exists because a directory is also a file, but its name as
613 a directory is different from its name as a file.
614 The result can be used as the value of `default-directory'
615 or passed as second argument to `expand-file-name'.
616 For a Unix-syntax file name, just appends a slash.
617 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
628 /* If the file name has special constructs in it,
629 call the corresponding file handler. */
630 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
632 return call2 (handler
, Qfile_name_as_directory
, file
);
634 buf
= (char *) alloca (SBYTES (file
) + 10);
635 file_name_as_directory (buf
, SDATA (file
));
636 return make_specified_string (buf
, -1, strlen (buf
),
637 STRING_MULTIBYTE (file
));
641 * Convert from directory name to filename.
643 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
644 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
645 * On UNIX, it's simple: just make sure there isn't a terminating /
647 * Value is nonzero if the string output is different from the input.
651 directory_file_name (src
, dst
)
659 struct FAB fab
= cc$rms_fab
;
660 struct NAM nam
= cc$rms_nam
;
661 char esa
[NAM$C_MAXRSS
];
666 if (! index (src
, '/')
667 && (src
[slen
- 1] == ']'
668 || src
[slen
- 1] == ':'
669 || src
[slen
- 1] == '>'))
671 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
673 fab
.fab$b_fns
= slen
;
674 fab
.fab$l_nam
= &nam
;
675 fab
.fab$l_fop
= FAB$M_NAM
;
678 nam
.nam$b_ess
= sizeof esa
;
679 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
681 /* We call SYS$PARSE to handle such things as [--] for us. */
682 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
684 slen
= nam
.nam$b_esl
;
685 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
690 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
692 /* what about when we have logical_name:???? */
693 if (src
[slen
- 1] == ':')
694 { /* Xlate logical name and see what we get */
695 ptr
= strcpy (dst
, src
); /* upper case for getenv */
698 if ('a' <= *ptr
&& *ptr
<= 'z')
702 dst
[slen
- 1] = 0; /* remove colon */
703 if (!(src
= egetenv (dst
)))
705 /* should we jump to the beginning of this procedure?
706 Good points: allows us to use logical names that xlate
708 Bad points: can be a problem if we just translated to a device
710 For now, I'll punt and always expect VMS names, and hope for
713 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
714 { /* no recursion here! */
720 { /* not a directory spec */
725 bracket
= src
[slen
- 1];
727 /* If bracket is ']' or '>', bracket - 2 is the corresponding
729 ptr
= index (src
, bracket
- 2);
731 { /* no opening bracket */
735 if (!(rptr
= rindex (src
, '.')))
738 strncpy (dst
, src
, slen
);
742 dst
[slen
++] = bracket
;
747 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
748 then translate the device and recurse. */
749 if (dst
[slen
- 1] == ':'
750 && dst
[slen
- 2] != ':' /* skip decnet nodes */
751 && strcmp (src
+ slen
, "[000000]") == 0)
753 dst
[slen
- 1] = '\0';
754 if ((ptr
= egetenv (dst
))
755 && (rlen
= strlen (ptr
) - 1) > 0
756 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
757 && ptr
[rlen
- 1] == '.')
759 char * buf
= (char *) alloca (strlen (ptr
) + 1);
763 return directory_file_name (buf
, dst
);
768 strcat (dst
, "[000000]");
772 rlen
= strlen (rptr
) - 1;
773 strncat (dst
, rptr
, rlen
);
774 dst
[slen
+ rlen
] = '\0';
775 strcat (dst
, ".DIR.1");
779 /* Process as Unix format: just remove any final slash.
780 But leave "/" unchanged; do not change it to "". */
783 /* Handle // as root for apollo's. */
784 if ((slen
> 2 && dst
[slen
- 1] == '/')
785 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
789 && IS_DIRECTORY_SEP (dst
[slen
- 1])
791 && !IS_ANY_SEP (dst
[slen
- 2])
797 CORRECT_DIR_SEPS (dst
);
802 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
804 doc
: /* Returns the file name of the directory named DIRECTORY.
805 This is the name of the file that holds the data for the directory DIRECTORY.
806 This operation exists because a directory is also a file, but its name as
807 a directory is different from its name as a file.
808 In Unix-syntax, this function just removes the final slash.
809 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
810 it returns a file name such as \"[X]Y.DIR.1\". */)
812 Lisp_Object directory
;
817 CHECK_STRING (directory
);
819 if (NILP (directory
))
822 /* If the file name has special constructs in it,
823 call the corresponding file handler. */
824 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
826 return call2 (handler
, Qdirectory_file_name
, directory
);
829 /* 20 extra chars is insufficient for VMS, since we might perform a
830 logical name translation. an equivalence string can be up to 255
831 chars long, so grab that much extra space... - sss */
832 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
834 buf
= (char *) alloca (SBYTES (directory
) + 20);
836 directory_file_name (SDATA (directory
), buf
);
837 return make_specified_string (buf
, -1, strlen (buf
),
838 STRING_MULTIBYTE (directory
));
841 static char make_temp_name_tbl
[64] =
843 'A','B','C','D','E','F','G','H',
844 'I','J','K','L','M','N','O','P',
845 'Q','R','S','T','U','V','W','X',
846 'Y','Z','a','b','c','d','e','f',
847 'g','h','i','j','k','l','m','n',
848 'o','p','q','r','s','t','u','v',
849 'w','x','y','z','0','1','2','3',
850 '4','5','6','7','8','9','-','_'
853 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
855 /* Value is a temporary file name starting with PREFIX, a string.
857 The Emacs process number forms part of the result, so there is
858 no danger of generating a name being used by another process.
859 In addition, this function makes an attempt to choose a name
860 which has no existing file. To make this work, PREFIX should be
861 an absolute file name.
863 BASE64_P non-zero means add the pid as 3 characters in base64
864 encoding. In this case, 6 characters will be added to PREFIX to
865 form the file name. Otherwise, if Emacs is running on a system
866 with long file names, add the pid as a decimal number.
868 This function signals an error if no unique file name could be
872 make_temp_name (prefix
, base64_p
)
879 unsigned char *p
, *data
;
883 CHECK_STRING (prefix
);
885 /* VAL is created by adding 6 characters to PREFIX. The first
886 three are the PID of this process, in base 64, and the second
887 three are incremented if the file already exists. This ensures
888 262144 unique file names per PID per PREFIX. */
890 pid
= (int) getpid ();
894 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
895 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
896 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
901 #ifdef HAVE_LONG_FILE_NAMES
902 sprintf (pidbuf
, "%d", pid
);
903 pidlen
= strlen (pidbuf
);
905 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
906 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
907 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
912 len
= SCHARS (prefix
);
913 val
= make_uninit_string (len
+ 3 + pidlen
);
915 bcopy(SDATA (prefix
), data
, len
);
918 bcopy (pidbuf
, p
, pidlen
);
921 /* Here we try to minimize useless stat'ing when this function is
922 invoked many times successively with the same PREFIX. We achieve
923 this by initializing count to a random value, and incrementing it
926 We don't want make-temp-name to be called while dumping,
927 because then make_temp_name_count_initialized_p would get set
928 and then make_temp_name_count would not be set when Emacs starts. */
930 if (!make_temp_name_count_initialized_p
)
932 make_temp_name_count
= (unsigned) time (NULL
);
933 make_temp_name_count_initialized_p
= 1;
939 unsigned num
= make_temp_name_count
;
941 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
942 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
943 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
945 /* Poor man's congruential RN generator. Replace with
946 ++make_temp_name_count for debugging. */
947 make_temp_name_count
+= 25229;
948 make_temp_name_count
%= 225307;
950 if (stat (data
, &ignored
) < 0)
952 /* We want to return only if errno is ENOENT. */
956 /* The error here is dubious, but there is little else we
957 can do. The alternatives are to return nil, which is
958 as bad as (and in many cases worse than) throwing the
959 error, or to ignore the error, which will likely result
960 in looping through 225307 stat's, which is not only
961 dog-slow, but also useless since it will fallback to
962 the errow below, anyway. */
963 report_file_error ("Cannot create temporary name for prefix",
964 Fcons (prefix
, Qnil
));
969 error ("Cannot create temporary name for prefix `%s'",
975 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
976 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
977 The Emacs process number forms part of the result,
978 so there is no danger of generating a name being used by another process.
980 In addition, this function makes an attempt to choose a name
981 which has no existing file. To make this work,
982 PREFIX should be an absolute file name.
984 There is a race condition between calling `make-temp-name' and creating the
985 file which opens all kinds of security holes. For that reason, you should
986 probably use `make-temp-file' instead, except in three circumstances:
988 * If you are creating the file in the user's home directory.
989 * If you are creating a directory rather than an ordinary file.
990 * If you are taking special precautions as `make-temp-file' does. */)
994 return make_temp_name (prefix
, 0);
999 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1000 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1001 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1002 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
1003 the current buffer's value of default-directory is used.
1004 File name components that are `.' are removed, and
1005 so are file name components followed by `..', along with the `..' itself;
1006 note that these simplifications are done without checking the resulting
1007 file names in the file system.
1008 An initial `~/' expands to your home directory.
1009 An initial `~USER/' expands to USER's home directory.
1010 See also the function `substitute-in-file-name'. */)
1011 (name
, default_directory
)
1012 Lisp_Object name
, default_directory
;
1016 register unsigned char *newdir
, *p
, *o
;
1018 unsigned char *target
;
1021 unsigned char * colon
= 0;
1022 unsigned char * close
= 0;
1023 unsigned char * slash
= 0;
1024 unsigned char * brack
= 0;
1025 int lbrack
= 0, rbrack
= 0;
1030 int collapse_newdir
= 1;
1034 Lisp_Object handler
, result
;
1036 CHECK_STRING (name
);
1038 /* If the file name has special constructs in it,
1039 call the corresponding file handler. */
1040 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1041 if (!NILP (handler
))
1042 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1044 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1045 if (NILP (default_directory
))
1046 default_directory
= current_buffer
->directory
;
1047 if (! STRINGP (default_directory
))
1050 /* "/" is not considered a root directory on DOS_NT, so using "/"
1051 here causes an infinite recursion in, e.g., the following:
1053 (let (default-directory)
1054 (expand-file-name "a"))
1056 To avoid this, we set default_directory to the root of the
1058 extern char *emacs_root_dir (void);
1060 default_directory
= build_string (emacs_root_dir ());
1062 default_directory
= build_string ("/");
1066 if (!NILP (default_directory
))
1068 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1069 if (!NILP (handler
))
1070 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1073 o
= SDATA (default_directory
);
1075 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1076 It would be better to do this down below where we actually use
1077 default_directory. Unfortunately, calling Fexpand_file_name recursively
1078 could invoke GC, and the strings might be relocated. This would
1079 be annoying because we have pointers into strings lying around
1080 that would need adjusting, and people would add new pointers to
1081 the code and forget to adjust them, resulting in intermittent bugs.
1082 Putting this call here avoids all that crud.
1084 The EQ test avoids infinite recursion. */
1085 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1086 /* Save time in some common cases - as long as default_directory
1087 is not relative, it can be canonicalized with name below (if it
1088 is needed at all) without requiring it to be expanded now. */
1090 /* Detect MSDOS file names with drive specifiers. */
1091 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1093 /* Detect Windows file names in UNC format. */
1094 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1096 #else /* not DOS_NT */
1097 /* Detect Unix absolute file names (/... alone is not absolute on
1099 && ! (IS_DIRECTORY_SEP (o
[0]))
1100 #endif /* not DOS_NT */
1103 struct gcpro gcpro1
;
1106 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1111 /* Filenames on VMS are always upper case. */
1112 name
= Fupcase (name
);
1114 #ifdef FILE_SYSTEM_CASE
1115 name
= FILE_SYSTEM_CASE (name
);
1121 /* We will force directory separators to be either all \ or /, so make
1122 a local copy to modify, even if there ends up being no change. */
1123 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1125 /* Note if special escape prefix is present, but remove for now. */
1126 if (nm
[0] == '/' && nm
[1] == ':')
1132 /* Find and remove drive specifier if present; this makes nm absolute
1133 even if the rest of the name appears to be relative. Only look for
1134 drive specifier at the beginning. */
1135 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1142 /* If we see "c://somedir", we want to strip the first slash after the
1143 colon when stripping the drive letter. Otherwise, this expands to
1145 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1147 #endif /* WINDOWSNT */
1151 /* Discard any previous drive specifier if nm is now in UNC format. */
1152 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1158 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1159 none are found, we can probably return right away. We will avoid
1160 allocating a new string if name is already fully expanded. */
1162 IS_DIRECTORY_SEP (nm
[0])
1164 && drive
&& !is_escaped
1167 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1174 /* If it turns out that the filename we want to return is just a
1175 suffix of FILENAME, we don't need to go through and edit
1176 things; we just need to construct a new string using data
1177 starting at the middle of FILENAME. If we set lose to a
1178 non-zero value, that means we've discovered that we can't do
1185 /* Since we know the name is absolute, we can assume that each
1186 element starts with a "/". */
1188 /* "." and ".." are hairy. */
1189 if (IS_DIRECTORY_SEP (p
[0])
1191 && (IS_DIRECTORY_SEP (p
[2])
1193 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1196 /* We want to replace multiple `/' in a row with a single
1199 && IS_DIRECTORY_SEP (p
[0])
1200 && IS_DIRECTORY_SEP (p
[1]))
1207 /* if dev:[dir]/, move nm to / */
1208 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1209 nm
= (brack
? brack
+ 1 : colon
+ 1);
1210 lbrack
= rbrack
= 0;
1218 /* VMS pre V4.4,convert '-'s in filenames. */
1219 if (lbrack
== rbrack
)
1221 if (dots
< 2) /* this is to allow negative version numbers */
1226 if (lbrack
> rbrack
&&
1227 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1228 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1234 /* count open brackets, reset close bracket pointer */
1235 if (p
[0] == '[' || p
[0] == '<')
1236 lbrack
++, brack
= 0;
1237 /* count close brackets, set close bracket pointer */
1238 if (p
[0] == ']' || p
[0] == '>')
1239 rbrack
++, brack
= p
;
1240 /* detect ][ or >< */
1241 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1243 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1244 nm
= p
+ 1, lose
= 1;
1245 if (p
[0] == ':' && (colon
|| slash
))
1246 /* if dev1:[dir]dev2:, move nm to dev2: */
1252 /* if /name/dev:, move nm to dev: */
1255 /* if node::dev:, move colon following dev */
1256 else if (colon
&& colon
[-1] == ':')
1258 /* if dev1:dev2:, move nm to dev2: */
1259 else if (colon
&& colon
[-1] != ':')
1264 if (p
[0] == ':' && !colon
)
1270 if (lbrack
== rbrack
)
1273 else if (p
[0] == '.')
1281 if (index (nm
, '/'))
1283 nm
= sys_translate_unix (nm
);
1284 return make_specified_string (nm
, -1, strlen (nm
),
1285 STRING_MULTIBYTE (name
));
1289 /* Make sure directories are all separated with / or \ as
1290 desired, but avoid allocation of a new string when not
1292 CORRECT_DIR_SEPS (nm
);
1294 if (IS_DIRECTORY_SEP (nm
[1]))
1296 if (strcmp (nm
, SDATA (name
)) != 0)
1297 name
= make_specified_string (nm
, -1, strlen (nm
),
1298 STRING_MULTIBYTE (name
));
1302 /* drive must be set, so this is okay */
1303 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1307 name
= make_specified_string (nm
, -1, p
- nm
,
1308 STRING_MULTIBYTE (name
));
1309 temp
[0] = DRIVE_LETTER (drive
);
1310 name
= concat2 (build_string (temp
), name
);
1313 #else /* not DOS_NT */
1314 if (nm
== SDATA (name
))
1316 return make_specified_string (nm
, -1, strlen (nm
),
1317 STRING_MULTIBYTE (name
));
1318 #endif /* not DOS_NT */
1322 /* At this point, nm might or might not be an absolute file name. We
1323 need to expand ~ or ~user if present, otherwise prefix nm with
1324 default_directory if nm is not absolute, and finally collapse /./
1325 and /foo/../ sequences.
1327 We set newdir to be the appropriate prefix if one is needed:
1328 - the relevant user directory if nm starts with ~ or ~user
1329 - the specified drive's working dir (DOS/NT only) if nm does not
1331 - the value of default_directory.
1333 Note that these prefixes are not guaranteed to be absolute (except
1334 for the working dir of a drive). Therefore, to ensure we always
1335 return an absolute name, if the final prefix is not absolute we
1336 append it to the current working directory. */
1340 if (nm
[0] == '~') /* prefix ~ */
1342 if (IS_DIRECTORY_SEP (nm
[1])
1346 || nm
[1] == 0) /* ~ by itself */
1348 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1349 newdir
= (unsigned char *) "";
1352 collapse_newdir
= 0;
1355 nm
++; /* Don't leave the slash in nm. */
1358 else /* ~user/filename */
1360 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1365 o
= (unsigned char *) alloca (p
- nm
+ 1);
1366 bcopy ((char *) nm
, o
, p
- nm
);
1369 pw
= (struct passwd
*) getpwnam (o
+ 1);
1372 newdir
= (unsigned char *) pw
-> pw_dir
;
1374 nm
= p
+ 1; /* skip the terminator */
1378 collapse_newdir
= 0;
1383 /* If we don't find a user of that name, leave the name
1384 unchanged; don't move nm forward to p. */
1389 /* On DOS and Windows, nm is absolute if a drive name was specified;
1390 use the drive's current directory as the prefix if needed. */
1391 if (!newdir
&& drive
)
1393 /* Get default directory if needed to make nm absolute. */
1394 if (!IS_DIRECTORY_SEP (nm
[0]))
1396 newdir
= alloca (MAXPATHLEN
+ 1);
1397 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1402 /* Either nm starts with /, or drive isn't mounted. */
1403 newdir
= alloca (4);
1404 newdir
[0] = DRIVE_LETTER (drive
);
1412 /* Finally, if no prefix has been specified and nm is not absolute,
1413 then it must be expanded relative to default_directory. */
1417 /* /... alone is not absolute on DOS and Windows. */
1418 && !IS_DIRECTORY_SEP (nm
[0])
1421 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1428 newdir
= SDATA (default_directory
);
1430 /* Note if special escape prefix is present, but remove for now. */
1431 if (newdir
[0] == '/' && newdir
[1] == ':')
1442 /* First ensure newdir is an absolute name. */
1444 /* Detect MSDOS file names with drive specifiers. */
1445 ! (IS_DRIVE (newdir
[0])
1446 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1448 /* Detect Windows file names in UNC format. */
1449 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1453 /* Effectively, let newdir be (expand-file-name newdir cwd).
1454 Because of the admonition against calling expand-file-name
1455 when we have pointers into lisp strings, we accomplish this
1456 indirectly by prepending newdir to nm if necessary, and using
1457 cwd (or the wd of newdir's drive) as the new newdir. */
1459 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1464 if (!IS_DIRECTORY_SEP (nm
[0]))
1466 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1467 file_name_as_directory (tmp
, newdir
);
1471 newdir
= alloca (MAXPATHLEN
+ 1);
1474 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1481 /* Strip off drive name from prefix, if present. */
1482 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1488 /* Keep only a prefix from newdir if nm starts with slash
1489 (//server/share for UNC, nothing otherwise). */
1490 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1493 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1495 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1497 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1499 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1511 /* Get rid of any slash at the end of newdir, unless newdir is
1512 just / or // (an incomplete UNC name). */
1513 length
= strlen (newdir
);
1514 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1516 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1520 unsigned char *temp
= (unsigned char *) alloca (length
);
1521 bcopy (newdir
, temp
, length
- 1);
1522 temp
[length
- 1] = 0;
1530 /* Now concatenate the directory and name to new space in the stack frame */
1531 tlen
+= strlen (nm
) + 1;
1533 /* Reserve space for drive specifier and escape prefix, since either
1534 or both may need to be inserted. (The Microsoft x86 compiler
1535 produces incorrect code if the following two lines are combined.) */
1536 target
= (unsigned char *) alloca (tlen
+ 4);
1538 #else /* not DOS_NT */
1539 target
= (unsigned char *) alloca (tlen
);
1540 #endif /* not DOS_NT */
1546 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1549 /* If newdir is effectively "C:/", then the drive letter will have
1550 been stripped and newdir will be "/". Concatenating with an
1551 absolute directory in nm produces "//", which will then be
1552 incorrectly treated as a network share. Ignore newdir in
1553 this case (keeping the drive letter). */
1554 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1555 && newdir
[1] == '\0'))
1557 strcpy (target
, newdir
);
1561 file_name_as_directory (target
, newdir
);
1564 strcat (target
, nm
);
1566 if (index (target
, '/'))
1567 strcpy (target
, sys_translate_unix (target
));
1570 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1572 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1581 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1587 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1588 /* brackets are offset from each other by 2 */
1591 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1592 /* convert [foo][bar] to [bar] */
1593 while (o
[-1] != '[' && o
[-1] != '<')
1595 else if (*p
== '-' && *o
!= '.')
1598 else if (p
[0] == '-' && o
[-1] == '.' &&
1599 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1600 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1604 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1605 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1607 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1609 /* else [foo.-] ==> [-] */
1615 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1616 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1622 if (!IS_DIRECTORY_SEP (*p
))
1626 else if (IS_DIRECTORY_SEP (p
[0])
1628 && (IS_DIRECTORY_SEP (p
[2])
1631 /* If "/." is the entire filename, keep the "/". Otherwise,
1632 just delete the whole "/.". */
1633 if (o
== target
&& p
[2] == '\0')
1637 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1638 /* `/../' is the "superroot" on certain file systems. */
1640 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1642 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1644 /* Keep initial / only if this is the whole name. */
1645 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1650 && IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1]))
1652 /* Collapse multiple `/' in a row. */
1654 while (IS_DIRECTORY_SEP (*p
))
1661 #endif /* not VMS */
1665 /* At last, set drive name. */
1667 /* Except for network file name. */
1668 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1669 #endif /* WINDOWSNT */
1671 if (!drive
) abort ();
1673 target
[0] = DRIVE_LETTER (drive
);
1676 /* Reinsert the escape prefix if required. */
1683 CORRECT_DIR_SEPS (target
);
1686 result
= make_specified_string (target
, -1, o
- target
,
1687 STRING_MULTIBYTE (name
));
1689 /* Again look to see if the file name has special constructs in it
1690 and perhaps call the corresponding file handler. This is needed
1691 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1692 the ".." component gives us "/user@host:/bar/../baz" which needs
1693 to be expanded again. */
1694 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1695 if (!NILP (handler
))
1696 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1702 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1703 This is the old version of expand-file-name, before it was thoroughly
1704 rewritten for Emacs 10.31. We leave this version here commented-out,
1705 because the code is very complex and likely to have subtle bugs. If
1706 bugs _are_ found, it might be of interest to look at the old code and
1707 see what did it do in the relevant situation.
1709 Don't remove this code: it's true that it will be accessible via CVS,
1710 but a few years from deletion, people will forget it is there. */
1712 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1713 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1714 "Convert FILENAME to absolute, and canonicalize it.\n\
1715 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1716 (does not start with slash); if DEFAULT is nil or missing,\n\
1717 the current buffer's value of default-directory is used.\n\
1718 Filenames containing `.' or `..' as components are simplified;\n\
1719 initial `~/' expands to your home directory.\n\
1720 See also the function `substitute-in-file-name'.")
1722 Lisp_Object name
, defalt
;
1726 register unsigned char *newdir
, *p
, *o
;
1728 unsigned char *target
;
1732 unsigned char * colon
= 0;
1733 unsigned char * close
= 0;
1734 unsigned char * slash
= 0;
1735 unsigned char * brack
= 0;
1736 int lbrack
= 0, rbrack
= 0;
1740 CHECK_STRING (name
);
1743 /* Filenames on VMS are always upper case. */
1744 name
= Fupcase (name
);
1749 /* If nm is absolute, flush ...// and detect /./ and /../.
1750 If no /./ or /../ we can return right away. */
1762 if (p
[0] == '/' && p
[1] == '/'
1764 /* // at start of filename is meaningful on Apollo system. */
1769 if (p
[0] == '/' && p
[1] == '~')
1770 nm
= p
+ 1, lose
= 1;
1771 if (p
[0] == '/' && p
[1] == '.'
1772 && (p
[2] == '/' || p
[2] == 0
1773 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1779 /* if dev:[dir]/, move nm to / */
1780 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1781 nm
= (brack
? brack
+ 1 : colon
+ 1);
1782 lbrack
= rbrack
= 0;
1790 /* VMS pre V4.4,convert '-'s in filenames. */
1791 if (lbrack
== rbrack
)
1793 if (dots
< 2) /* this is to allow negative version numbers */
1798 if (lbrack
> rbrack
&&
1799 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1800 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1806 /* count open brackets, reset close bracket pointer */
1807 if (p
[0] == '[' || p
[0] == '<')
1808 lbrack
++, brack
= 0;
1809 /* count close brackets, set close bracket pointer */
1810 if (p
[0] == ']' || p
[0] == '>')
1811 rbrack
++, brack
= p
;
1812 /* detect ][ or >< */
1813 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1815 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1816 nm
= p
+ 1, lose
= 1;
1817 if (p
[0] == ':' && (colon
|| slash
))
1818 /* if dev1:[dir]dev2:, move nm to dev2: */
1824 /* If /name/dev:, move nm to dev: */
1827 /* If node::dev:, move colon following dev */
1828 else if (colon
&& colon
[-1] == ':')
1830 /* If dev1:dev2:, move nm to dev2: */
1831 else if (colon
&& colon
[-1] != ':')
1836 if (p
[0] == ':' && !colon
)
1842 if (lbrack
== rbrack
)
1845 else if (p
[0] == '.')
1853 if (index (nm
, '/'))
1854 return build_string (sys_translate_unix (nm
));
1856 if (nm
== SDATA (name
))
1858 return build_string (nm
);
1862 /* Now determine directory to start with and put it in NEWDIR */
1866 if (nm
[0] == '~') /* prefix ~ */
1871 || nm
[1] == 0)/* ~/filename */
1873 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1874 newdir
= (unsigned char *) "";
1877 nm
++; /* Don't leave the slash in nm. */
1880 else /* ~user/filename */
1882 /* Get past ~ to user */
1883 unsigned char *user
= nm
+ 1;
1884 /* Find end of name. */
1885 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1886 int len
= ptr
? ptr
- user
: strlen (user
);
1888 unsigned char *ptr1
= index (user
, ':');
1889 if (ptr1
!= 0 && ptr1
- user
< len
)
1892 /* Copy the user name into temp storage. */
1893 o
= (unsigned char *) alloca (len
+ 1);
1894 bcopy ((char *) user
, o
, len
);
1897 /* Look up the user name. */
1898 pw
= (struct passwd
*) getpwnam (o
+ 1);
1900 error ("\"%s\" isn't a registered user", o
+ 1);
1902 newdir
= (unsigned char *) pw
->pw_dir
;
1904 /* Discard the user name from NM. */
1911 #endif /* not VMS */
1915 defalt
= current_buffer
->directory
;
1916 CHECK_STRING (defalt
);
1917 newdir
= SDATA (defalt
);
1920 /* Now concatenate the directory and name to new space in the stack frame */
1922 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1923 target
= (unsigned char *) alloca (tlen
);
1929 if (nm
[0] == 0 || nm
[0] == '/')
1930 strcpy (target
, newdir
);
1933 file_name_as_directory (target
, newdir
);
1936 strcat (target
, nm
);
1938 if (index (target
, '/'))
1939 strcpy (target
, sys_translate_unix (target
));
1942 /* Now canonicalize by removing /. and /foo/.. if they appear */
1950 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1956 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1957 /* brackets are offset from each other by 2 */
1960 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1961 /* convert [foo][bar] to [bar] */
1962 while (o
[-1] != '[' && o
[-1] != '<')
1964 else if (*p
== '-' && *o
!= '.')
1967 else if (p
[0] == '-' && o
[-1] == '.' &&
1968 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1969 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1973 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1974 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1976 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1978 /* else [foo.-] ==> [-] */
1984 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1985 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1995 else if (!strncmp (p
, "//", 2)
1997 /* // at start of filename is meaningful in Apollo system. */
2005 else if (p
[0] == '/' && p
[1] == '.' &&
2006 (p
[2] == '/' || p
[2] == 0))
2008 else if (!strncmp (p
, "/..", 3)
2009 /* `/../' is the "superroot" on certain file systems. */
2011 && (p
[3] == '/' || p
[3] == 0))
2013 while (o
!= target
&& *--o
!= '/')
2016 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2020 if (o
== target
&& *o
== '/')
2028 #endif /* not VMS */
2031 return make_string (target
, o
- target
);
2035 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2036 Ssubstitute_in_file_name
, 1, 1, 0,
2037 doc
: /* Substitute environment variables referred to in FILENAME.
2038 `$FOO' where FOO is an environment variable name means to substitute
2039 the value of that variable. The variable name should be terminated
2040 with a character not a letter, digit or underscore; otherwise, enclose
2041 the entire variable name in braces.
2042 If `/~' appears, all of FILENAME through that `/' is discarded.
2044 On VMS, `$' substitution is not done; this function does little and only
2045 duplicates what `expand-file-name' does. */)
2047 Lisp_Object filename
;
2051 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2052 unsigned char *target
= NULL
;
2054 int substituted
= 0;
2057 Lisp_Object handler
;
2059 CHECK_STRING (filename
);
2061 /* If the file name has special constructs in it,
2062 call the corresponding file handler. */
2063 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2064 if (!NILP (handler
))
2065 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2067 nm
= SDATA (filename
);
2069 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2070 CORRECT_DIR_SEPS (nm
);
2071 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2073 endp
= nm
+ SBYTES (filename
);
2075 /* If /~ or // appears, discard everything through first slash. */
2077 for (p
= nm
; p
!= endp
; p
++)
2080 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2081 /* // at start of file name is meaningful in Apollo,
2082 WindowsNT and Cygwin systems. */
2083 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
2084 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2085 || IS_DIRECTORY_SEP (p
[0])
2086 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2091 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2093 || IS_DIRECTORY_SEP (p
[-1])))
2095 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2100 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2102 o
= (unsigned char *) alloca (s
- p
+ 1);
2103 bcopy ((char *) p
, o
, s
- p
);
2106 pw
= (struct passwd
*) getpwnam (o
+ 1);
2108 /* If we have ~/ or ~user and `user' exists, discard
2109 everything up to ~. But if `user' does not exist, leave
2110 ~user alone, it might be a literal file name. */
2111 if (IS_DIRECTORY_SEP (p
[0]) || s
== p
+ 1 || pw
)
2118 /* see comment in expand-file-name about drive specifiers */
2119 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2120 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
2129 return make_specified_string (nm
, -1, strlen (nm
),
2130 STRING_MULTIBYTE (filename
));
2133 /* See if any variables are substituted into the string
2134 and find the total length of their values in `total' */
2136 for (p
= nm
; p
!= endp
;)
2146 /* "$$" means a single "$" */
2155 while (p
!= endp
&& *p
!= '}') p
++;
2156 if (*p
!= '}') goto missingclose
;
2162 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2166 /* Copy out the variable name */
2167 target
= (unsigned char *) alloca (s
- o
+ 1);
2168 strncpy (target
, o
, s
- o
);
2171 strupr (target
); /* $home == $HOME etc. */
2174 /* Get variable value */
2175 o
= (unsigned char *) egetenv (target
);
2178 total
+= strlen (o
);
2188 /* If substitution required, recopy the string and do it */
2189 /* Make space in stack frame for the new copy */
2190 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2193 /* Copy the rest of the name through, replacing $ constructs with values */
2210 while (p
!= endp
&& *p
!= '}') p
++;
2211 if (*p
!= '}') goto missingclose
;
2217 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2221 /* Copy out the variable name */
2222 target
= (unsigned char *) alloca (s
- o
+ 1);
2223 strncpy (target
, o
, s
- o
);
2226 strupr (target
); /* $home == $HOME etc. */
2229 /* Get variable value */
2230 o
= (unsigned char *) egetenv (target
);
2234 strcpy (x
, target
); x
+= strlen (target
);
2236 else if (STRING_MULTIBYTE (filename
))
2238 /* If the original string is multibyte,
2239 convert what we substitute into multibyte. */
2242 int c
= unibyte_char_to_multibyte (*o
++);
2243 x
+= CHAR_STRING (c
, x
);
2255 /* If /~ or // appears, discard everything through first slash. */
2257 for (p
= xnm
; p
!= x
; p
++)
2259 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2260 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2261 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2262 || IS_DIRECTORY_SEP (p
[0])
2263 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2265 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2268 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2269 && p
> xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2273 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2276 error ("Bad format environment-variable substitution");
2278 error ("Missing \"}\" in environment-variable substitution");
2280 error ("Substituting nonexistent environment variable \"%s\"", target
);
2283 #endif /* not VMS */
2287 /* A slightly faster and more convenient way to get
2288 (directory-file-name (expand-file-name FOO)). */
2291 expand_and_dir_to_file (filename
, defdir
)
2292 Lisp_Object filename
, defdir
;
2294 register Lisp_Object absname
;
2296 absname
= Fexpand_file_name (filename
, defdir
);
2299 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2300 if (c
== ':' || c
== ']' || c
== '>')
2301 absname
= Fdirectory_file_name (absname
);
2304 /* Remove final slash, if any (unless this is the root dir).
2305 stat behaves differently depending! */
2306 if (SCHARS (absname
) > 1
2307 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2308 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2309 /* We cannot take shortcuts; they might be wrong for magic file names. */
2310 absname
= Fdirectory_file_name (absname
);
2315 /* Signal an error if the file ABSNAME already exists.
2316 If INTERACTIVE is nonzero, ask the user whether to proceed,
2317 and bypass the error if the user says to go ahead.
2318 QUERYSTRING is a name for the action that is being considered
2321 *STATPTR is used to store the stat information if the file exists.
2322 If the file does not exist, STATPTR->st_mode is set to 0.
2323 If STATPTR is null, we don't store into it.
2325 If QUICK is nonzero, we ask for y or n, not yes or no. */
2328 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2329 Lisp_Object absname
;
2330 unsigned char *querystring
;
2332 struct stat
*statptr
;
2335 register Lisp_Object tem
, encoded_filename
;
2336 struct stat statbuf
;
2337 struct gcpro gcpro1
;
2339 encoded_filename
= ENCODE_FILE (absname
);
2341 /* stat is a good way to tell whether the file exists,
2342 regardless of what access permissions it has. */
2343 if (stat (SDATA (encoded_filename
), &statbuf
) >= 0)
2346 Fsignal (Qfile_already_exists
,
2347 Fcons (build_string ("File already exists"),
2348 Fcons (absname
, Qnil
)));
2350 tem
= format2 ("File %s already exists; %s anyway? ",
2351 absname
, build_string (querystring
));
2353 tem
= Fy_or_n_p (tem
);
2355 tem
= do_yes_or_no_p (tem
);
2358 Fsignal (Qfile_already_exists
,
2359 Fcons (build_string ("File already exists"),
2360 Fcons (absname
, Qnil
)));
2367 statptr
->st_mode
= 0;
2372 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2373 "fCopy file: \nFCopy %s to file: \np\nP",
2374 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2375 If NEWNAME names a directory, copy FILE there.
2376 Signals a `file-already-exists' error if file NEWNAME already exists,
2377 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
2378 A number as third arg means request confirmation if NEWNAME already exists.
2379 This is what happens in interactive use with M-x.
2380 Fourth arg KEEP-TIME non-nil means give the new file the same
2381 last-modified time as the old one. (This works on only some systems.)
2382 A prefix arg makes KEEP-TIME non-nil. */)
2383 (file
, newname
, ok_if_already_exists
, keep_time
)
2384 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2387 char buf
[16 * 1024];
2388 struct stat st
, out_st
;
2389 Lisp_Object handler
;
2390 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2391 int count
= SPECPDL_INDEX ();
2392 int input_file_statable_p
;
2393 Lisp_Object encoded_file
, encoded_newname
;
2395 encoded_file
= encoded_newname
= Qnil
;
2396 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2397 CHECK_STRING (file
);
2398 CHECK_STRING (newname
);
2400 if (!NILP (Ffile_directory_p (newname
)))
2401 newname
= Fexpand_file_name (file
, newname
);
2403 newname
= Fexpand_file_name (newname
, Qnil
);
2405 file
= Fexpand_file_name (file
, Qnil
);
2407 /* If the input file name has special constructs in it,
2408 call the corresponding file handler. */
2409 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2410 /* Likewise for output file name. */
2412 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2413 if (!NILP (handler
))
2414 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2415 ok_if_already_exists
, keep_time
));
2417 encoded_file
= ENCODE_FILE (file
);
2418 encoded_newname
= ENCODE_FILE (newname
);
2420 if (NILP (ok_if_already_exists
)
2421 || INTEGERP (ok_if_already_exists
))
2422 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2423 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2424 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2428 if (!CopyFile (SDATA (encoded_file
),
2429 SDATA (encoded_newname
),
2431 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2432 /* CopyFile retains the timestamp by default. */
2433 else if (NILP (keep_time
))
2439 EMACS_GET_TIME (now
);
2440 filename
= SDATA (encoded_newname
);
2442 /* Ensure file is writable while its modified time is set. */
2443 attributes
= GetFileAttributes (filename
);
2444 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2445 if (set_file_times (filename
, now
, now
))
2447 /* Restore original attributes. */
2448 SetFileAttributes (filename
, attributes
);
2449 Fsignal (Qfile_date_error
,
2450 Fcons (build_string ("Cannot set file date"),
2451 Fcons (newname
, Qnil
)));
2453 /* Restore original attributes. */
2454 SetFileAttributes (filename
, attributes
);
2456 #else /* not WINDOWSNT */
2458 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2462 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2464 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2466 /* We can only copy regular files and symbolic links. Other files are not
2468 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2470 #if !defined (DOS_NT) || __DJGPP__ > 1
2471 if (out_st
.st_mode
!= 0
2472 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2475 report_file_error ("Input and output files are the same",
2476 Fcons (file
, Fcons (newname
, Qnil
)));
2480 #if defined (S_ISREG) && defined (S_ISLNK)
2481 if (input_file_statable_p
)
2483 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2485 #if defined (EISDIR)
2486 /* Get a better looking error message. */
2489 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2492 #endif /* S_ISREG && S_ISLNK */
2495 /* Create the copy file with the same record format as the input file */
2496 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2499 /* System's default file type was set to binary by _fmode in emacs.c. */
2500 ofd
= creat (SDATA (encoded_newname
), S_IREAD
| S_IWRITE
);
2501 #else /* not MSDOS */
2502 ofd
= creat (SDATA (encoded_newname
), 0666);
2503 #endif /* not MSDOS */
2506 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2508 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2512 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2513 if (emacs_write (ofd
, buf
, n
) != n
)
2514 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2517 /* Closing the output clobbers the file times on some systems. */
2518 if (emacs_close (ofd
) < 0)
2519 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2521 if (input_file_statable_p
)
2523 if (!NILP (keep_time
))
2525 EMACS_TIME atime
, mtime
;
2526 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2527 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2528 if (set_file_times (SDATA (encoded_newname
),
2530 Fsignal (Qfile_date_error
,
2531 Fcons (build_string ("Cannot set file date"),
2532 Fcons (newname
, Qnil
)));
2535 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2537 #if defined (__DJGPP__) && __DJGPP__ > 1
2538 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2539 and if it can't, it tells so. Otherwise, under MSDOS we usually
2540 get only the READ bit, which will make the copied file read-only,
2541 so it's better not to chmod at all. */
2542 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2543 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2544 #endif /* DJGPP version 2 or newer */
2549 #endif /* WINDOWSNT */
2551 /* Discard the unwind protects. */
2552 specpdl_ptr
= specpdl
+ count
;
2558 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2559 Smake_directory_internal
, 1, 1, 0,
2560 doc
: /* Create a new directory named DIRECTORY. */)
2562 Lisp_Object directory
;
2564 const unsigned char *dir
;
2565 Lisp_Object handler
;
2566 Lisp_Object encoded_dir
;
2568 CHECK_STRING (directory
);
2569 directory
= Fexpand_file_name (directory
, Qnil
);
2571 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2572 if (!NILP (handler
))
2573 return call2 (handler
, Qmake_directory_internal
, directory
);
2575 encoded_dir
= ENCODE_FILE (directory
);
2577 dir
= SDATA (encoded_dir
);
2580 if (mkdir (dir
) != 0)
2582 if (mkdir (dir
, 0777) != 0)
2584 report_file_error ("Creating directory", Flist (1, &directory
));
2589 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2590 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2592 Lisp_Object directory
;
2594 const unsigned char *dir
;
2595 Lisp_Object handler
;
2596 Lisp_Object encoded_dir
;
2598 CHECK_STRING (directory
);
2599 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2601 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2602 if (!NILP (handler
))
2603 return call2 (handler
, Qdelete_directory
, directory
);
2605 encoded_dir
= ENCODE_FILE (directory
);
2607 dir
= SDATA (encoded_dir
);
2609 if (rmdir (dir
) != 0)
2610 report_file_error ("Removing directory", Flist (1, &directory
));
2615 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2616 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2617 If file has multiple names, it continues to exist with the other names. */)
2619 Lisp_Object filename
;
2621 Lisp_Object handler
;
2622 Lisp_Object encoded_file
;
2623 struct gcpro gcpro1
;
2626 if (!NILP (Ffile_directory_p (filename
))
2627 && NILP (Ffile_symlink_p (filename
)))
2628 Fsignal (Qfile_error
,
2629 Fcons (build_string ("Removing old name: is a directory"),
2630 Fcons (filename
, Qnil
)));
2632 filename
= Fexpand_file_name (filename
, Qnil
);
2634 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2635 if (!NILP (handler
))
2636 return call2 (handler
, Qdelete_file
, filename
);
2638 encoded_file
= ENCODE_FILE (filename
);
2640 if (0 > unlink (SDATA (encoded_file
)))
2641 report_file_error ("Removing old name", Flist (1, &filename
));
2646 internal_delete_file_1 (ignore
)
2652 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2655 internal_delete_file (filename
)
2656 Lisp_Object filename
;
2658 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2659 Qt
, internal_delete_file_1
));
2662 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2663 "fRename file: \nFRename %s to file: \np",
2664 doc
: /* Rename FILE as NEWNAME. Both args strings.
2665 If file has names other than FILE, it continues to have those names.
2666 Signals a `file-already-exists' error if a file NEWNAME already exists
2667 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2668 A number as third arg means request confirmation if NEWNAME already exists.
2669 This is what happens in interactive use with M-x. */)
2670 (file
, newname
, ok_if_already_exists
)
2671 Lisp_Object file
, newname
, ok_if_already_exists
;
2674 Lisp_Object args
[2];
2676 Lisp_Object handler
;
2677 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2678 Lisp_Object encoded_file
, encoded_newname
;
2680 encoded_file
= encoded_newname
= Qnil
;
2681 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2682 CHECK_STRING (file
);
2683 CHECK_STRING (newname
);
2684 file
= Fexpand_file_name (file
, Qnil
);
2685 newname
= Fexpand_file_name (newname
, Qnil
);
2687 /* If the file name has special constructs in it,
2688 call the corresponding file handler. */
2689 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2691 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2692 if (!NILP (handler
))
2693 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2694 file
, newname
, ok_if_already_exists
));
2696 encoded_file
= ENCODE_FILE (file
);
2697 encoded_newname
= ENCODE_FILE (newname
);
2700 /* If the file names are identical but for the case, don't ask for
2701 confirmation: they simply want to change the letter-case of the
2703 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2705 if (NILP (ok_if_already_exists
)
2706 || INTEGERP (ok_if_already_exists
))
2707 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2708 INTEGERP (ok_if_already_exists
), 0, 0);
2710 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2712 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2713 || 0 > unlink (SDATA (encoded_file
)))
2718 Fcopy_file (file
, newname
,
2719 /* We have already prompted if it was an integer,
2720 so don't have copy-file prompt again. */
2721 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2722 Fdelete_file (file
);
2729 report_file_error ("Renaming", Flist (2, args
));
2732 report_file_error ("Renaming", Flist (2, &file
));
2739 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2740 "fAdd name to file: \nFName to add to %s: \np",
2741 doc
: /* Give FILE additional name NEWNAME. Both args strings.
2742 Signals a `file-already-exists' error if a file NEWNAME already exists
2743 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2744 A number as third arg means request confirmation if NEWNAME already exists.
2745 This is what happens in interactive use with M-x. */)
2746 (file
, newname
, ok_if_already_exists
)
2747 Lisp_Object file
, newname
, ok_if_already_exists
;
2750 Lisp_Object args
[2];
2752 Lisp_Object handler
;
2753 Lisp_Object encoded_file
, encoded_newname
;
2754 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2756 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2757 encoded_file
= encoded_newname
= Qnil
;
2758 CHECK_STRING (file
);
2759 CHECK_STRING (newname
);
2760 file
= Fexpand_file_name (file
, Qnil
);
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
, Qadd_name_to_file
);
2766 if (!NILP (handler
))
2767 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2768 newname
, ok_if_already_exists
));
2770 /* If the new name has special constructs in it,
2771 call the corresponding file handler. */
2772 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2773 if (!NILP (handler
))
2774 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2775 newname
, ok_if_already_exists
));
2777 encoded_file
= ENCODE_FILE (file
);
2778 encoded_newname
= ENCODE_FILE (newname
);
2780 if (NILP (ok_if_already_exists
)
2781 || INTEGERP (ok_if_already_exists
))
2782 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2783 INTEGERP (ok_if_already_exists
), 0, 0);
2785 unlink (SDATA (newname
));
2786 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2791 report_file_error ("Adding new name", Flist (2, args
));
2793 report_file_error ("Adding new name", Flist (2, &file
));
2802 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2803 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2804 doc
: /* Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2805 Signals a `file-already-exists' error if a file LINKNAME already exists
2806 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2807 A number as third arg means request confirmation if LINKNAME already exists.
2808 This happens for interactive use with M-x. */)
2809 (filename
, linkname
, ok_if_already_exists
)
2810 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2813 Lisp_Object args
[2];
2815 Lisp_Object handler
;
2816 Lisp_Object encoded_filename
, encoded_linkname
;
2817 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2819 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2820 encoded_filename
= encoded_linkname
= Qnil
;
2821 CHECK_STRING (filename
);
2822 CHECK_STRING (linkname
);
2823 /* If the link target has a ~, we must expand it to get
2824 a truly valid file name. Otherwise, do not expand;
2825 we want to permit links to relative file names. */
2826 if (SREF (filename
, 0) == '~')
2827 filename
= Fexpand_file_name (filename
, Qnil
);
2828 linkname
= Fexpand_file_name (linkname
, Qnil
);
2830 /* If the file name has special constructs in it,
2831 call the corresponding file handler. */
2832 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2833 if (!NILP (handler
))
2834 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2835 linkname
, ok_if_already_exists
));
2837 /* If the new link name has special constructs in it,
2838 call the corresponding file handler. */
2839 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2840 if (!NILP (handler
))
2841 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2842 linkname
, ok_if_already_exists
));
2844 encoded_filename
= ENCODE_FILE (filename
);
2845 encoded_linkname
= ENCODE_FILE (linkname
);
2847 if (NILP (ok_if_already_exists
)
2848 || INTEGERP (ok_if_already_exists
))
2849 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2850 INTEGERP (ok_if_already_exists
), 0, 0);
2851 if (0 > symlink (SDATA (encoded_filename
),
2852 SDATA (encoded_linkname
)))
2854 /* If we didn't complain already, silently delete existing file. */
2855 if (errno
== EEXIST
)
2857 unlink (SDATA (encoded_linkname
));
2858 if (0 <= symlink (SDATA (encoded_filename
),
2859 SDATA (encoded_linkname
)))
2869 report_file_error ("Making symbolic link", Flist (2, args
));
2871 report_file_error ("Making symbolic link", Flist (2, &filename
));
2877 #endif /* S_IFLNK */
2881 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2882 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2883 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2884 If STRING is nil or a null string, the logical name NAME is deleted. */)
2889 CHECK_STRING (name
);
2891 delete_logical_name (SDATA (name
));
2894 CHECK_STRING (string
);
2896 if (SCHARS (string
) == 0)
2897 delete_logical_name (SDATA (name
));
2899 define_logical_name (SDATA (name
), SDATA (string
));
2908 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2909 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2911 Lisp_Object path
, login
;
2915 CHECK_STRING (path
);
2916 CHECK_STRING (login
);
2918 netresult
= netunam (SDATA (path
), SDATA (login
));
2920 if (netresult
== -1)
2925 #endif /* HPUX_NET */
2927 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2929 doc
: /* Return t if file FILENAME specifies an absolute file name.
2930 On Unix, this is a name starting with a `/' or a `~'. */)
2932 Lisp_Object filename
;
2934 const unsigned char *ptr
;
2936 CHECK_STRING (filename
);
2937 ptr
= SDATA (filename
);
2938 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2940 /* ??? This criterion is probably wrong for '<'. */
2941 || index (ptr
, ':') || index (ptr
, '<')
2942 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2946 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2954 /* Return nonzero if file FILENAME exists and can be executed. */
2957 check_executable (filename
)
2961 int len
= strlen (filename
);
2964 if (stat (filename
, &st
) < 0)
2966 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2967 return ((st
.st_mode
& S_IEXEC
) != 0);
2969 return (S_ISREG (st
.st_mode
)
2971 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2972 || stricmp (suffix
, ".exe") == 0
2973 || stricmp (suffix
, ".bat") == 0)
2974 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2975 #endif /* not WINDOWSNT */
2976 #else /* not DOS_NT */
2977 #ifdef HAVE_EUIDACCESS
2978 return (euidaccess (filename
, 1) >= 0);
2980 /* Access isn't quite right because it uses the real uid
2981 and we really want to test with the effective uid.
2982 But Unix doesn't give us a right way to do it. */
2983 return (access (filename
, 1) >= 0);
2985 #endif /* not DOS_NT */
2988 /* Return nonzero if file FILENAME exists and can be written. */
2991 check_writable (filename
)
2996 if (stat (filename
, &st
) < 0)
2998 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2999 #else /* not MSDOS */
3000 #ifdef HAVE_EUIDACCESS
3001 return (euidaccess (filename
, 2) >= 0);
3003 /* Access isn't quite right because it uses the real uid
3004 and we really want to test with the effective uid.
3005 But Unix doesn't give us a right way to do it.
3006 Opening with O_WRONLY could work for an ordinary file,
3007 but would lose for directories. */
3008 return (access (filename
, 2) >= 0);
3010 #endif /* not MSDOS */
3013 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3014 doc
: /* Return t if file FILENAME exists. (This does not mean you can read it.)
3015 See also `file-readable-p' and `file-attributes'. */)
3017 Lisp_Object filename
;
3019 Lisp_Object absname
;
3020 Lisp_Object handler
;
3021 struct stat statbuf
;
3023 CHECK_STRING (filename
);
3024 absname
= Fexpand_file_name (filename
, Qnil
);
3026 /* If the file name has special constructs in it,
3027 call the corresponding file handler. */
3028 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3029 if (!NILP (handler
))
3030 return call2 (handler
, Qfile_exists_p
, absname
);
3032 absname
= ENCODE_FILE (absname
);
3034 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3037 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3038 doc
: /* Return t if FILENAME can be executed by you.
3039 For a directory, this means you can access files in that directory. */)
3041 Lisp_Object filename
;
3043 Lisp_Object absname
;
3044 Lisp_Object handler
;
3046 CHECK_STRING (filename
);
3047 absname
= Fexpand_file_name (filename
, Qnil
);
3049 /* If the file name has special constructs in it,
3050 call the corresponding file handler. */
3051 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3052 if (!NILP (handler
))
3053 return call2 (handler
, Qfile_executable_p
, absname
);
3055 absname
= ENCODE_FILE (absname
);
3057 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3060 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3061 doc
: /* Return t if file FILENAME exists and you can read it.
3062 See also `file-exists-p' and `file-attributes'. */)
3064 Lisp_Object filename
;
3066 Lisp_Object absname
;
3067 Lisp_Object handler
;
3070 struct stat statbuf
;
3072 CHECK_STRING (filename
);
3073 absname
= Fexpand_file_name (filename
, Qnil
);
3075 /* If the file name has special constructs in it,
3076 call the corresponding file handler. */
3077 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3078 if (!NILP (handler
))
3079 return call2 (handler
, Qfile_readable_p
, absname
);
3081 absname
= ENCODE_FILE (absname
);
3083 #if defined(DOS_NT) || defined(macintosh)
3084 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3086 if (access (SDATA (absname
), 0) == 0)
3089 #else /* not DOS_NT and not macintosh */
3091 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3092 /* Opening a fifo without O_NONBLOCK can wait.
3093 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3094 except in the case of a fifo, on a system which handles it. */
3095 desc
= stat (SDATA (absname
), &statbuf
);
3098 if (S_ISFIFO (statbuf
.st_mode
))
3099 flags
|= O_NONBLOCK
;
3101 desc
= emacs_open (SDATA (absname
), flags
, 0);
3106 #endif /* not DOS_NT and not macintosh */
3109 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3111 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3112 doc
: /* Return t if file FILENAME can be written or created by you. */)
3114 Lisp_Object filename
;
3116 Lisp_Object absname
, dir
, encoded
;
3117 Lisp_Object handler
;
3118 struct stat statbuf
;
3120 CHECK_STRING (filename
);
3121 absname
= Fexpand_file_name (filename
, Qnil
);
3123 /* If the file name has special constructs in it,
3124 call the corresponding file handler. */
3125 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3126 if (!NILP (handler
))
3127 return call2 (handler
, Qfile_writable_p
, absname
);
3129 encoded
= ENCODE_FILE (absname
);
3130 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3131 return (check_writable (SDATA (encoded
))
3134 dir
= Ffile_name_directory (absname
);
3137 dir
= Fdirectory_file_name (dir
);
3141 dir
= Fdirectory_file_name (dir
);
3144 dir
= ENCODE_FILE (dir
);
3146 /* The read-only attribute of the parent directory doesn't affect
3147 whether a file or directory can be created within it. Some day we
3148 should check ACLs though, which do affect this. */
3149 if (stat (SDATA (dir
), &statbuf
) < 0)
3151 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3153 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3158 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3159 doc
: /* Access file FILENAME, and get an error if that does not work.
3160 The second argument STRING is used in the error message.
3161 If there is no error, we return nil. */)
3163 Lisp_Object filename
, string
;
3165 Lisp_Object handler
, encoded_filename
, absname
;
3168 CHECK_STRING (filename
);
3169 absname
= Fexpand_file_name (filename
, Qnil
);
3171 CHECK_STRING (string
);
3173 /* If the file name has special constructs in it,
3174 call the corresponding file handler. */
3175 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3176 if (!NILP (handler
))
3177 return call3 (handler
, Qaccess_file
, absname
, string
);
3179 encoded_filename
= ENCODE_FILE (absname
);
3181 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3183 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3189 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3190 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3191 The value is the link target, as a string.
3192 Otherwise returns nil. */)
3194 Lisp_Object filename
;
3196 Lisp_Object handler
;
3198 CHECK_STRING (filename
);
3199 filename
= Fexpand_file_name (filename
, Qnil
);
3201 /* If the file name has special constructs in it,
3202 call the corresponding file handler. */
3203 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3204 if (!NILP (handler
))
3205 return call2 (handler
, Qfile_symlink_p
, filename
);
3214 filename
= ENCODE_FILE (filename
);
3221 buf
= (char *) xrealloc (buf
, bufsize
);
3222 bzero (buf
, bufsize
);
3225 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3229 /* HP-UX reports ERANGE if buffer is too small. */
3230 if (errno
== ERANGE
)
3240 while (valsize
>= bufsize
);
3242 val
= make_string (buf
, valsize
);
3243 if (buf
[0] == '/' && index (buf
, ':'))
3244 val
= concat2 (build_string ("/:"), val
);
3246 val
= DECODE_FILE (val
);
3249 #else /* not S_IFLNK */
3251 #endif /* not S_IFLNK */
3254 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3255 doc
: /* Return t if FILENAME names an existing directory.
3256 Symbolic links to directories count as directories.
3257 See `file-symlink-p' to distinguish symlinks. */)
3259 Lisp_Object filename
;
3261 register Lisp_Object absname
;
3263 Lisp_Object handler
;
3265 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3267 /* If the file name has special constructs in it,
3268 call the corresponding file handler. */
3269 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3270 if (!NILP (handler
))
3271 return call2 (handler
, Qfile_directory_p
, absname
);
3273 absname
= ENCODE_FILE (absname
);
3275 if (stat (SDATA (absname
), &st
) < 0)
3277 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3280 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3281 doc
: /* Return t if file FILENAME names a directory you can open.
3282 For the value to be t, FILENAME must specify the name of a directory as a file,
3283 and the directory must allow you to open files in it. In order to use a
3284 directory as a buffer's current directory, this predicate must return true.
3285 A directory name spec may be given instead; then the value is t
3286 if the directory so specified exists and really is a readable and
3287 searchable directory. */)
3289 Lisp_Object filename
;
3291 Lisp_Object handler
;
3293 struct gcpro gcpro1
;
3295 /* If the file name has special constructs in it,
3296 call the corresponding file handler. */
3297 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3298 if (!NILP (handler
))
3299 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3302 tem
= (NILP (Ffile_directory_p (filename
))
3303 || NILP (Ffile_executable_p (filename
)));
3305 return tem
? Qnil
: Qt
;
3308 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3309 doc
: /* Return t if file FILENAME is the name of a regular file.
3310 This is the sort of file that holds an ordinary stream of data bytes. */)
3312 Lisp_Object filename
;
3314 register Lisp_Object absname
;
3316 Lisp_Object handler
;
3318 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3320 /* If the file name has special constructs in it,
3321 call the corresponding file handler. */
3322 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3323 if (!NILP (handler
))
3324 return call2 (handler
, Qfile_regular_p
, absname
);
3326 absname
= ENCODE_FILE (absname
);
3331 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3333 /* Tell stat to use expensive method to get accurate info. */
3334 Vw32_get_true_file_attributes
= Qt
;
3335 result
= stat (SDATA (absname
), &st
);
3336 Vw32_get_true_file_attributes
= tem
;
3340 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3343 if (stat (SDATA (absname
), &st
) < 0)
3345 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3349 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3350 doc
: /* Return mode bits of file named FILENAME, as an integer. */)
3352 Lisp_Object filename
;
3354 Lisp_Object absname
;
3356 Lisp_Object handler
;
3358 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3360 /* If the file name has special constructs in it,
3361 call the corresponding file handler. */
3362 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3363 if (!NILP (handler
))
3364 return call2 (handler
, Qfile_modes
, absname
);
3366 absname
= ENCODE_FILE (absname
);
3368 if (stat (SDATA (absname
), &st
) < 0)
3370 #if defined (MSDOS) && __DJGPP__ < 2
3371 if (check_executable (SDATA (absname
)))
3372 st
.st_mode
|= S_IEXEC
;
3373 #endif /* MSDOS && __DJGPP__ < 2 */
3375 return make_number (st
.st_mode
& 07777);
3378 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3379 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3380 Only the 12 low bits of MODE are used. */)
3382 Lisp_Object filename
, mode
;
3384 Lisp_Object absname
, encoded_absname
;
3385 Lisp_Object handler
;
3387 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3388 CHECK_NUMBER (mode
);
3390 /* If the file name has special constructs in it,
3391 call the corresponding file handler. */
3392 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3393 if (!NILP (handler
))
3394 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3396 encoded_absname
= ENCODE_FILE (absname
);
3398 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3399 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3404 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3405 doc
: /* Set the file permission bits for newly created files.
3406 The argument MODE should be an integer; only the low 9 bits are used.
3407 This setting is inherited by subprocesses. */)
3411 CHECK_NUMBER (mode
);
3413 umask ((~ XINT (mode
)) & 0777);
3418 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3419 doc
: /* Return the default file protection for created files.
3420 The value is an integer. */)
3426 realmask
= umask (0);
3429 XSETINT (value
, (~ realmask
) & 0777);
3439 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3440 doc
: /* Tell Unix to finish all pending disk updates. */)
3449 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3450 doc
: /* Return t if file FILE1 is newer than file FILE2.
3451 If FILE1 does not exist, the answer is nil;
3452 otherwise, if FILE2 does not exist, the answer is t. */)
3454 Lisp_Object file1
, file2
;
3456 Lisp_Object absname1
, absname2
;
3459 Lisp_Object handler
;
3460 struct gcpro gcpro1
, gcpro2
;
3462 CHECK_STRING (file1
);
3463 CHECK_STRING (file2
);
3466 GCPRO2 (absname1
, file2
);
3467 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3468 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3471 /* If the file name has special constructs in it,
3472 call the corresponding file handler. */
3473 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3475 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3476 if (!NILP (handler
))
3477 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3479 GCPRO2 (absname1
, absname2
);
3480 absname1
= ENCODE_FILE (absname1
);
3481 absname2
= ENCODE_FILE (absname2
);
3484 if (stat (SDATA (absname1
), &st
) < 0)
3487 mtime1
= st
.st_mtime
;
3489 if (stat (SDATA (absname2
), &st
) < 0)
3492 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3496 Lisp_Object Qfind_buffer_file_type
;
3499 #ifndef READ_BUF_SIZE
3500 #define READ_BUF_SIZE (64 << 10)
3503 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3505 /* This function is called after Lisp functions to decide a coding
3506 system are called, or when they cause an error. Before they are
3507 called, the current buffer is set unibyte and it contains only a
3508 newly inserted text (thus the buffer was empty before the
3511 The functions may set markers, overlays, text properties, or even
3512 alter the buffer contents, change the current buffer.
3514 Here, we reset all those changes by:
3515 o set back the current buffer.
3516 o move all markers and overlays to BEG.
3517 o remove all text properties.
3518 o set back the buffer multibyteness. */
3521 decide_coding_unwind (unwind_data
)
3522 Lisp_Object unwind_data
;
3524 Lisp_Object multibyte
, undo_list
, buffer
;
3526 multibyte
= XCAR (unwind_data
);
3527 unwind_data
= XCDR (unwind_data
);
3528 undo_list
= XCAR (unwind_data
);
3529 buffer
= XCDR (unwind_data
);
3531 if (current_buffer
!= XBUFFER (buffer
))
3532 set_buffer_internal (XBUFFER (buffer
));
3533 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3534 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3535 BUF_INTERVALS (current_buffer
) = 0;
3536 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3538 /* Now we are safe to change the buffer's multibyteness directly. */
3539 current_buffer
->enable_multibyte_characters
= multibyte
;
3540 current_buffer
->undo_list
= undo_list
;
3546 /* Used to pass values from insert-file-contents to read_non_regular. */
3548 static int non_regular_fd
;
3549 static int non_regular_inserted
;
3550 static int non_regular_nbytes
;
3553 /* Read from a non-regular file.
3554 Read non_regular_trytry bytes max from non_regular_fd.
3555 Non_regular_inserted specifies where to put the read bytes.
3556 Value is the number of bytes read. */
3565 nbytes
= emacs_read (non_regular_fd
,
3566 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3567 non_regular_nbytes
);
3569 return make_number (nbytes
);
3573 /* Condition-case handler used when reading from non-regular files
3574 in insert-file-contents. */
3577 read_non_regular_quit ()
3583 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3585 doc
: /* Insert contents of file FILENAME after point.
3586 Returns list of absolute file name and number of characters inserted.
3587 If second argument VISIT is non-nil, the buffer's visited filename
3588 and last save file modtime are set, and it is marked unmodified.
3589 If visiting and the file does not exist, visiting is completed
3590 before the error is signaled.
3591 The optional third and fourth arguments BEG and END
3592 specify what portion of the file to insert.
3593 These arguments count bytes in the file, not characters in the buffer.
3594 If VISIT is non-nil, BEG and END must be nil.
3596 If optional fifth argument REPLACE is non-nil,
3597 it means replace the current buffer contents (in the accessible portion)
3598 with the file contents. This is better than simply deleting and inserting
3599 the whole thing because (1) it preserves some marker positions
3600 and (2) it puts less data in the undo list.
3601 When REPLACE is non-nil, the value is the number of characters actually read,
3602 which is often less than the number of characters to be read.
3604 This does code conversion according to the value of
3605 `coding-system-for-read' or `file-coding-system-alist',
3606 and sets the variable `last-coding-system-used' to the coding system
3608 (filename
, visit
, beg
, end
, replace
)
3609 Lisp_Object filename
, visit
, beg
, end
, replace
;
3614 register int how_much
;
3615 register int unprocessed
;
3616 int count
= SPECPDL_INDEX ();
3617 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3618 Lisp_Object handler
, val
, insval
, orig_filename
;
3621 int not_regular
= 0;
3622 unsigned char read_buf
[READ_BUF_SIZE
];
3623 struct coding_system coding
;
3624 unsigned char buffer
[1 << 14];
3625 int replace_handled
= 0;
3626 int set_coding_system
= 0;
3627 int coding_system_decided
= 0;
3630 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3631 error ("Cannot do file visiting in an indirect buffer");
3633 if (!NILP (current_buffer
->read_only
))
3634 Fbarf_if_buffer_read_only ();
3638 orig_filename
= Qnil
;
3640 GCPRO4 (filename
, val
, p
, orig_filename
);
3642 CHECK_STRING (filename
);
3643 filename
= Fexpand_file_name (filename
, Qnil
);
3645 /* If the file name has special constructs in it,
3646 call the corresponding file handler. */
3647 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3648 if (!NILP (handler
))
3650 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3651 visit
, beg
, end
, replace
);
3652 if (CONSP (val
) && CONSP (XCDR (val
)))
3653 inserted
= XINT (XCAR (XCDR (val
)));
3657 orig_filename
= filename
;
3658 filename
= ENCODE_FILE (filename
);
3664 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3666 /* Tell stat to use expensive method to get accurate info. */
3667 Vw32_get_true_file_attributes
= Qt
;
3668 total
= stat (SDATA (filename
), &st
);
3669 Vw32_get_true_file_attributes
= tem
;
3674 if (stat (SDATA (filename
), &st
) < 0)
3676 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3677 || fstat (fd
, &st
) < 0)
3678 #endif /* not APOLLO */
3679 #endif /* WINDOWSNT */
3681 if (fd
>= 0) emacs_close (fd
);
3684 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3687 if (!NILP (Vcoding_system_for_read
))
3688 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3693 /* This code will need to be changed in order to work on named
3694 pipes, and it's probably just not worth it. So we should at
3695 least signal an error. */
3696 if (!S_ISREG (st
.st_mode
))
3703 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3704 Fsignal (Qfile_error
,
3705 Fcons (build_string ("not a regular file"),
3706 Fcons (orig_filename
, Qnil
)));
3711 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3714 /* Replacement should preserve point as it preserves markers. */
3715 if (!NILP (replace
))
3716 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3718 record_unwind_protect (close_file_unwind
, make_number (fd
));
3720 /* Supposedly happens on VMS. */
3721 /* Can happen on any platform that uses long as type of off_t, but allows
3722 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3723 give a message suitable for the latter case. */
3724 if (! not_regular
&& st
.st_size
< 0)
3725 error ("Maximum buffer size exceeded");
3727 /* Prevent redisplay optimizations. */
3728 current_buffer
->clip_changed
= 1;
3732 if (!NILP (beg
) || !NILP (end
))
3733 error ("Attempt to visit less than an entire file");
3734 if (BEG
< Z
&& NILP (replace
))
3735 error ("Cannot do file visiting in a non-empty buffer");
3741 XSETFASTINT (beg
, 0);
3749 XSETINT (end
, st
.st_size
);
3751 /* Arithmetic overflow can occur if an Emacs integer cannot
3752 represent the file size, or if the calculations below
3753 overflow. The calculations below double the file size
3754 twice, so check that it can be multiplied by 4 safely. */
3755 if (XINT (end
) != st
.st_size
3756 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3757 error ("Maximum buffer size exceeded");
3759 /* The file size returned from stat may be zero, but data
3760 may be readable nonetheless, for example when this is a
3761 file in the /proc filesystem. */
3762 if (st
.st_size
== 0)
3763 XSETINT (end
, READ_BUF_SIZE
);
3769 /* Decide the coding system to use for reading the file now
3770 because we can't use an optimized method for handling
3771 `coding:' tag if the current buffer is not empty. */
3775 if (!NILP (Vcoding_system_for_read
))
3776 val
= Vcoding_system_for_read
;
3777 else if (! NILP (replace
))
3778 /* In REPLACE mode, we can use the same coding system
3779 that was used to visit the file. */
3780 val
= current_buffer
->buffer_file_coding_system
;
3783 /* Don't try looking inside a file for a coding system
3784 specification if it is not seekable. */
3785 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3787 /* Find a coding system specified in the heading two
3788 lines or in the tailing several lines of the file.
3789 We assume that the 1K-byte and 3K-byte for heading
3790 and tailing respectively are sufficient for this
3794 if (st
.st_size
<= (1024 * 4))
3795 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3798 nread
= emacs_read (fd
, read_buf
, 1024);
3801 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3802 report_file_error ("Setting file position",
3803 Fcons (orig_filename
, Qnil
));
3804 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3809 error ("IO error reading %s: %s",
3810 SDATA (orig_filename
), emacs_strerror (errno
));
3813 struct buffer
*prev
= current_buffer
;
3817 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3819 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3820 buf
= XBUFFER (buffer
);
3822 buf
->directory
= current_buffer
->directory
;
3823 buf
->read_only
= Qnil
;
3824 buf
->filename
= Qnil
;
3825 buf
->undo_list
= Qt
;
3826 buf
->overlays_before
= Qnil
;
3827 buf
->overlays_after
= Qnil
;
3829 set_buffer_internal (buf
);
3831 buf
->enable_multibyte_characters
= Qnil
;
3833 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3834 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3835 val
= call2 (Vset_auto_coding_function
,
3836 filename
, make_number (nread
));
3837 set_buffer_internal (prev
);
3839 /* Discard the unwind protect for recovering the
3843 /* Rewind the file for the actual read done later. */
3844 if (lseek (fd
, 0, 0) < 0)
3845 report_file_error ("Setting file position",
3846 Fcons (orig_filename
, Qnil
));
3852 /* If we have not yet decided a coding system, check
3853 file-coding-system-alist. */
3854 Lisp_Object args
[6], coding_systems
;
3856 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3857 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3858 coding_systems
= Ffind_operation_coding_system (6, args
);
3859 if (CONSP (coding_systems
))
3860 val
= XCAR (coding_systems
);
3864 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3865 /* Ensure we set Vlast_coding_system_used. */
3866 set_coding_system
= 1;
3868 if (NILP (current_buffer
->enable_multibyte_characters
)
3870 /* We must suppress all character code conversion except for
3871 end-of-line conversion. */
3872 setup_raw_text_coding_system (&coding
);
3874 coding
.src_multibyte
= 0;
3875 coding
.dst_multibyte
3876 = !NILP (current_buffer
->enable_multibyte_characters
);
3877 coding_system_decided
= 1;
3880 /* If requested, replace the accessible part of the buffer
3881 with the file contents. Avoid replacing text at the
3882 beginning or end of the buffer that matches the file contents;
3883 that preserves markers pointing to the unchanged parts.
3885 Here we implement this feature in an optimized way
3886 for the case where code conversion is NOT needed.
3887 The following if-statement handles the case of conversion
3888 in a less optimal way.
3890 If the code conversion is "automatic" then we try using this
3891 method and hope for the best.
3892 But if we discover the need for conversion, we give up on this method
3893 and let the following if-statement handle the replace job. */
3896 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
3898 /* same_at_start and same_at_end count bytes,
3899 because file access counts bytes
3900 and BEG and END count bytes. */
3901 int same_at_start
= BEGV_BYTE
;
3902 int same_at_end
= ZV_BYTE
;
3904 /* There is still a possibility we will find the need to do code
3905 conversion. If that happens, we set this variable to 1 to
3906 give up on handling REPLACE in the optimized way. */
3907 int giveup_match_end
= 0;
3909 if (XINT (beg
) != 0)
3911 if (lseek (fd
, XINT (beg
), 0) < 0)
3912 report_file_error ("Setting file position",
3913 Fcons (orig_filename
, Qnil
));
3918 /* Count how many chars at the start of the file
3919 match the text at the beginning of the buffer. */
3924 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
3926 error ("IO error reading %s: %s",
3927 SDATA (orig_filename
), emacs_strerror (errno
));
3928 else if (nread
== 0)
3931 if (coding
.type
== coding_type_undecided
)
3932 detect_coding (&coding
, buffer
, nread
);
3933 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
3934 /* We found that the file should be decoded somehow.
3935 Let's give up here. */
3937 giveup_match_end
= 1;
3941 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3942 detect_eol (&coding
, buffer
, nread
);
3943 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3944 && coding
.eol_type
!= CODING_EOL_LF
)
3945 /* We found that the format of eol should be decoded.
3946 Let's give up here. */
3948 giveup_match_end
= 1;
3953 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3954 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3955 same_at_start
++, bufpos
++;
3956 /* If we found a discrepancy, stop the scan.
3957 Otherwise loop around and scan the next bufferful. */
3958 if (bufpos
!= nread
)
3962 /* If the file matches the buffer completely,
3963 there's no need to replace anything. */
3964 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3968 /* Truncate the buffer to the size of the file. */
3969 del_range_1 (same_at_start
, same_at_end
, 0, 0);
3974 /* Count how many chars at the end of the file
3975 match the text at the end of the buffer. But, if we have
3976 already found that decoding is necessary, don't waste time. */
3977 while (!giveup_match_end
)
3979 int total_read
, nread
, bufpos
, curpos
, trial
;
3981 /* At what file position are we now scanning? */
3982 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3983 /* If the entire file matches the buffer tail, stop the scan. */
3986 /* How much can we scan in the next step? */
3987 trial
= min (curpos
, sizeof buffer
);
3988 if (lseek (fd
, curpos
- trial
, 0) < 0)
3989 report_file_error ("Setting file position",
3990 Fcons (orig_filename
, Qnil
));
3992 total_read
= nread
= 0;
3993 while (total_read
< trial
)
3995 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
3997 error ("IO error reading %s: %s",
3998 SDATA (orig_filename
), emacs_strerror (errno
));
3999 else if (nread
== 0)
4001 total_read
+= nread
;
4004 /* Scan this bufferful from the end, comparing with
4005 the Emacs buffer. */
4006 bufpos
= total_read
;
4008 /* Compare with same_at_start to avoid counting some buffer text
4009 as matching both at the file's beginning and at the end. */
4010 while (bufpos
> 0 && same_at_end
> same_at_start
4011 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4012 same_at_end
--, bufpos
--;
4014 /* If we found a discrepancy, stop the scan.
4015 Otherwise loop around and scan the preceding bufferful. */
4018 /* If this discrepancy is because of code conversion,
4019 we cannot use this method; giveup and try the other. */
4020 if (same_at_end
> same_at_start
4021 && FETCH_BYTE (same_at_end
- 1) >= 0200
4022 && ! NILP (current_buffer
->enable_multibyte_characters
)
4023 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4024 giveup_match_end
= 1;
4033 if (! giveup_match_end
)
4037 /* We win! We can handle REPLACE the optimized way. */
4039 /* Extend the start of non-matching text area to multibyte
4040 character boundary. */
4041 if (! NILP (current_buffer
->enable_multibyte_characters
))
4042 while (same_at_start
> BEGV_BYTE
4043 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4046 /* Extend the end of non-matching text area to multibyte
4047 character boundary. */
4048 if (! NILP (current_buffer
->enable_multibyte_characters
))
4049 while (same_at_end
< ZV_BYTE
4050 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4053 /* Don't try to reuse the same piece of text twice. */
4054 overlap
= (same_at_start
- BEGV_BYTE
4055 - (same_at_end
+ st
.st_size
- ZV
));
4057 same_at_end
+= overlap
;
4059 /* Arrange to read only the nonmatching middle part of the file. */
4060 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4061 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4063 del_range_byte (same_at_start
, same_at_end
, 0);
4064 /* Insert from the file at the proper position. */
4065 temp
= BYTE_TO_CHAR (same_at_start
);
4066 SET_PT_BOTH (temp
, same_at_start
);
4068 /* If display currently starts at beginning of line,
4069 keep it that way. */
4070 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4071 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4073 replace_handled
= 1;
4077 /* If requested, replace the accessible part of the buffer
4078 with the file contents. Avoid replacing text at the
4079 beginning or end of the buffer that matches the file contents;
4080 that preserves markers pointing to the unchanged parts.
4082 Here we implement this feature for the case where code conversion
4083 is needed, in a simple way that needs a lot of memory.
4084 The preceding if-statement handles the case of no conversion
4085 in a more optimized way. */
4086 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4088 int same_at_start
= BEGV_BYTE
;
4089 int same_at_end
= ZV_BYTE
;
4092 /* Make sure that the gap is large enough. */
4093 int bufsize
= 2 * st
.st_size
;
4094 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4097 /* First read the whole file, performing code conversion into
4098 CONVERSION_BUFFER. */
4100 if (lseek (fd
, XINT (beg
), 0) < 0)
4102 xfree (conversion_buffer
);
4103 report_file_error ("Setting file position",
4104 Fcons (orig_filename
, Qnil
));
4107 total
= st
.st_size
; /* Total bytes in the file. */
4108 how_much
= 0; /* Bytes read from file so far. */
4109 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4110 unprocessed
= 0; /* Bytes not processed in previous loop. */
4112 while (how_much
< total
)
4114 /* try is reserved in some compilers (Microsoft C) */
4115 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4116 unsigned char *destination
= read_buf
+ unprocessed
;
4119 /* Allow quitting out of the actual I/O. */
4122 this = emacs_read (fd
, destination
, trytry
);
4125 if (this < 0 || this + unprocessed
== 0)
4133 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4135 int require
, result
;
4137 this += unprocessed
;
4139 /* If we are using more space than estimated,
4140 make CONVERSION_BUFFER bigger. */
4141 require
= decoding_buffer_size (&coding
, this);
4142 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4144 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4145 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4148 /* Convert this batch with results in CONVERSION_BUFFER. */
4149 if (how_much
>= total
) /* This is the last block. */
4150 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4151 if (coding
.composing
!= COMPOSITION_DISABLED
)
4152 coding_allocate_composition_data (&coding
, BEGV
);
4153 result
= decode_coding (&coding
, read_buf
,
4154 conversion_buffer
+ inserted
,
4155 this, bufsize
- inserted
);
4157 /* Save for next iteration whatever we didn't convert. */
4158 unprocessed
= this - coding
.consumed
;
4159 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4160 if (!NILP (current_buffer
->enable_multibyte_characters
))
4161 this = coding
.produced
;
4163 this = str_as_unibyte (conversion_buffer
+ inserted
,
4170 /* At this point, INSERTED is how many characters (i.e. bytes)
4171 are present in CONVERSION_BUFFER.
4172 HOW_MUCH should equal TOTAL,
4173 or should be <= 0 if we couldn't read the file. */
4177 xfree (conversion_buffer
);
4180 error ("IO error reading %s: %s",
4181 SDATA (orig_filename
), emacs_strerror (errno
));
4182 else if (how_much
== -2)
4183 error ("maximum buffer size exceeded");
4186 /* Compare the beginning of the converted file
4187 with the buffer text. */
4190 while (bufpos
< inserted
&& same_at_start
< same_at_end
4191 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4192 same_at_start
++, bufpos
++;
4194 /* If the file matches the buffer completely,
4195 there's no need to replace anything. */
4197 if (bufpos
== inserted
)
4199 xfree (conversion_buffer
);
4202 /* Truncate the buffer to the size of the file. */
4203 del_range_byte (same_at_start
, same_at_end
, 0);
4208 /* Extend the start of non-matching text area to multibyte
4209 character boundary. */
4210 if (! NILP (current_buffer
->enable_multibyte_characters
))
4211 while (same_at_start
> BEGV_BYTE
4212 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4215 /* Scan this bufferful from the end, comparing with
4216 the Emacs buffer. */
4219 /* Compare with same_at_start to avoid counting some buffer text
4220 as matching both at the file's beginning and at the end. */
4221 while (bufpos
> 0 && same_at_end
> same_at_start
4222 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4223 same_at_end
--, bufpos
--;
4225 /* Extend the end of non-matching text area to multibyte
4226 character boundary. */
4227 if (! NILP (current_buffer
->enable_multibyte_characters
))
4228 while (same_at_end
< ZV_BYTE
4229 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4232 /* Don't try to reuse the same piece of text twice. */
4233 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4235 same_at_end
+= overlap
;
4237 /* If display currently starts at beginning of line,
4238 keep it that way. */
4239 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4240 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4242 /* Replace the chars that we need to replace,
4243 and update INSERTED to equal the number of bytes
4244 we are taking from the file. */
4245 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
4247 if (same_at_end
!= same_at_start
)
4249 del_range_byte (same_at_start
, same_at_end
, 0);
4251 same_at_start
= GPT_BYTE
;
4255 temp
= BYTE_TO_CHAR (same_at_start
);
4257 /* Insert from the file at the proper position. */
4258 SET_PT_BOTH (temp
, same_at_start
);
4259 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
4261 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4262 coding_restore_composition (&coding
, Fcurrent_buffer ());
4263 coding_free_composition_data (&coding
);
4265 /* Set `inserted' to the number of inserted characters. */
4266 inserted
= PT
- temp
;
4268 xfree (conversion_buffer
);
4277 register Lisp_Object temp
;
4279 total
= XINT (end
) - XINT (beg
);
4281 /* Make sure point-max won't overflow after this insertion. */
4282 XSETINT (temp
, total
);
4283 if (total
!= XINT (temp
))
4284 error ("Maximum buffer size exceeded");
4287 /* For a special file, all we can do is guess. */
4288 total
= READ_BUF_SIZE
;
4290 if (NILP (visit
) && total
> 0)
4291 prepare_to_modify_buffer (PT
, PT
, NULL
);
4294 if (GAP_SIZE
< total
)
4295 make_gap (total
- GAP_SIZE
);
4297 if (XINT (beg
) != 0 || !NILP (replace
))
4299 if (lseek (fd
, XINT (beg
), 0) < 0)
4300 report_file_error ("Setting file position",
4301 Fcons (orig_filename
, Qnil
));
4304 /* In the following loop, HOW_MUCH contains the total bytes read so
4305 far for a regular file, and not changed for a special file. But,
4306 before exiting the loop, it is set to a negative value if I/O
4310 /* Total bytes inserted. */
4313 /* Here, we don't do code conversion in the loop. It is done by
4314 code_convert_region after all data are read into the buffer. */
4316 int gap_size
= GAP_SIZE
;
4318 while (how_much
< total
)
4320 /* try is reserved in some compilers (Microsoft C) */
4321 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4328 /* Maybe make more room. */
4329 if (gap_size
< trytry
)
4331 make_gap (total
- gap_size
);
4332 gap_size
= GAP_SIZE
;
4335 /* Read from the file, capturing `quit'. When an
4336 error occurs, end the loop, and arrange for a quit
4337 to be signaled after decoding the text we read. */
4338 non_regular_fd
= fd
;
4339 non_regular_inserted
= inserted
;
4340 non_regular_nbytes
= trytry
;
4341 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4342 read_non_regular_quit
);
4353 /* Allow quitting out of the actual I/O. We don't make text
4354 part of the buffer until all the reading is done, so a C-g
4355 here doesn't do any harm. */
4358 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4370 /* For a regular file, where TOTAL is the real size,
4371 count HOW_MUCH to compare with it.
4372 For a special file, where TOTAL is just a buffer size,
4373 so don't bother counting in HOW_MUCH.
4374 (INSERTED is where we count the number of characters inserted.) */
4381 /* Make the text read part of the buffer. */
4382 GAP_SIZE
-= inserted
;
4384 GPT_BYTE
+= inserted
;
4386 ZV_BYTE
+= inserted
;
4391 /* Put an anchor to ensure multi-byte form ends at gap. */
4396 /* Discard the unwind protect for closing the file. */
4400 error ("IO error reading %s: %s",
4401 SDATA (orig_filename
), emacs_strerror (errno
));
4405 if (! coding_system_decided
)
4407 /* The coding system is not yet decided. Decide it by an
4408 optimized method for handling `coding:' tag.
4410 Note that we can get here only if the buffer was empty
4411 before the insertion. */
4415 if (!NILP (Vcoding_system_for_read
))
4416 val
= Vcoding_system_for_read
;
4419 /* Since we are sure that the current buffer was empty
4420 before the insertion, we can toggle
4421 enable-multibyte-characters directly here without taking
4422 care of marker adjustment and byte combining problem. By
4423 this way, we can run Lisp program safely before decoding
4424 the inserted text. */
4425 Lisp_Object unwind_data
;
4426 int count
= SPECPDL_INDEX ();
4428 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4429 Fcons (current_buffer
->undo_list
,
4430 Fcurrent_buffer ()));
4431 current_buffer
->enable_multibyte_characters
= Qnil
;
4432 current_buffer
->undo_list
= Qt
;
4433 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4435 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4437 val
= call2 (Vset_auto_coding_function
,
4438 filename
, make_number (inserted
));
4443 /* If the coding system is not yet decided, check
4444 file-coding-system-alist. */
4445 Lisp_Object args
[6], coding_systems
;
4447 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4448 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4449 coding_systems
= Ffind_operation_coding_system (6, args
);
4450 if (CONSP (coding_systems
))
4451 val
= XCAR (coding_systems
);
4454 unbind_to (count
, Qnil
);
4455 inserted
= Z_BYTE
- BEG_BYTE
;
4458 /* The following kludgy code is to avoid some compiler bug.
4460 setup_coding_system (val, &coding);
4463 struct coding_system temp_coding
;
4464 setup_coding_system (val
, &temp_coding
);
4465 bcopy (&temp_coding
, &coding
, sizeof coding
);
4467 /* Ensure we set Vlast_coding_system_used. */
4468 set_coding_system
= 1;
4470 if (NILP (current_buffer
->enable_multibyte_characters
)
4472 /* We must suppress all character code conversion except for
4473 end-of-line conversion. */
4474 setup_raw_text_coding_system (&coding
);
4475 coding
.src_multibyte
= 0;
4476 coding
.dst_multibyte
4477 = !NILP (current_buffer
->enable_multibyte_characters
);
4481 /* Can't do this if part of the buffer might be preserved. */
4483 && (coding
.type
== coding_type_no_conversion
4484 || coding
.type
== coding_type_raw_text
))
4486 /* Visiting a file with these coding system makes the buffer
4488 current_buffer
->enable_multibyte_characters
= Qnil
;
4489 coding
.dst_multibyte
= 0;
4492 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4494 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4496 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4498 inserted
= coding
.produced_char
;
4501 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4505 /* Now INSERTED is measured in characters. */
4508 /* Use the conversion type to determine buffer-file-type
4509 (find-buffer-file-type is now used to help determine the
4511 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4512 || coding
.eol_type
== CODING_EOL_LF
)
4513 && ! CODING_REQUIRE_DECODING (&coding
))
4514 current_buffer
->buffer_file_type
= Qt
;
4516 current_buffer
->buffer_file_type
= Qnil
;
4523 if (!EQ (current_buffer
->undo_list
, Qt
))
4524 current_buffer
->undo_list
= Qnil
;
4526 stat (SDATA (filename
), &st
);
4531 current_buffer
->modtime
= st
.st_mtime
;
4532 current_buffer
->filename
= orig_filename
;
4535 SAVE_MODIFF
= MODIFF
;
4536 current_buffer
->auto_save_modified
= MODIFF
;
4537 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4538 #ifdef CLASH_DETECTION
4541 if (!NILP (current_buffer
->file_truename
))
4542 unlock_file (current_buffer
->file_truename
);
4543 unlock_file (filename
);
4545 #endif /* CLASH_DETECTION */
4547 Fsignal (Qfile_error
,
4548 Fcons (build_string ("not a regular file"),
4549 Fcons (orig_filename
, Qnil
)));
4552 if (set_coding_system
)
4553 Vlast_coding_system_used
= coding
.symbol
;
4555 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4557 insval
= call1 (Qafter_insert_file_set_coding
, make_number (inserted
));
4558 if (! NILP (insval
))
4560 CHECK_NUMBER (insval
);
4561 inserted
= XFASTINT (insval
);
4565 /* Decode file format */
4568 int empty_undo_list_p
= 0;
4570 /* If we're anyway going to discard undo information, don't
4571 record it in the first place. The buffer's undo list at this
4572 point is either nil or t when visiting a file. */
4575 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4576 current_buffer
->undo_list
= Qt
;
4579 insval
= call3 (Qformat_decode
,
4580 Qnil
, make_number (inserted
), visit
);
4581 CHECK_NUMBER (insval
);
4582 inserted
= XFASTINT (insval
);
4585 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4588 /* Call after-change hooks for the inserted text, aside from the case
4589 of normal visiting (not with REPLACE), which is done in a new buffer
4590 "before" the buffer is changed. */
4591 if (inserted
> 0 && total
> 0
4592 && (NILP (visit
) || !NILP (replace
)))
4594 signal_after_change (PT
, 0, inserted
);
4595 update_compositions (PT
, PT
, CHECK_BORDER
);
4598 p
= Vafter_insert_file_functions
;
4601 insval
= call1 (XCAR (p
), make_number (inserted
));
4604 CHECK_NUMBER (insval
);
4605 inserted
= XFASTINT (insval
);
4612 && current_buffer
->modtime
== -1)
4614 /* If visiting nonexistent file, return nil. */
4615 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4619 Fsignal (Qquit
, Qnil
);
4621 /* ??? Retval needs to be dealt with in all cases consistently. */
4623 val
= Fcons (orig_filename
,
4624 Fcons (make_number (inserted
),
4627 RETURN_UNGCPRO (unbind_to (count
, val
));
4630 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4631 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4632 Lisp_Object
, Lisp_Object
));
4634 /* If build_annotations switched buffers, switch back to BUF.
4635 Kill the temporary buffer that was selected in the meantime.
4637 Since this kill only the last temporary buffer, some buffers remain
4638 not killed if build_annotations switched buffers more than once.
4642 build_annotations_unwind (buf
)
4647 if (XBUFFER (buf
) == current_buffer
)
4649 tembuf
= Fcurrent_buffer ();
4651 Fkill_buffer (tembuf
);
4655 /* Decide the coding-system to encode the data with. */
4658 choose_write_coding_system (start
, end
, filename
,
4659 append
, visit
, lockname
, coding
)
4660 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4661 struct coding_system
*coding
;
4667 else if (!NILP (Vcoding_system_for_write
))
4669 val
= Vcoding_system_for_write
;
4670 if (coding_system_require_warning
4671 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4672 /* Confirm that VAL can surely encode the current region. */
4673 val
= call5 (Vselect_safe_coding_system_function
,
4674 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4679 /* If the variable `buffer-file-coding-system' is set locally,
4680 it means that the file was read with some kind of code
4681 conversion or the variable is explicitly set by users. We
4682 had better write it out with the same coding system even if
4683 `enable-multibyte-characters' is nil.
4685 If it is not set locally, we anyway have to convert EOL
4686 format if the default value of `buffer-file-coding-system'
4687 tells that it is not Unix-like (LF only) format. */
4688 int using_default_coding
= 0;
4689 int force_raw_text
= 0;
4691 val
= current_buffer
->buffer_file_coding_system
;
4693 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4696 if (NILP (current_buffer
->enable_multibyte_characters
))
4702 /* Check file-coding-system-alist. */
4703 Lisp_Object args
[7], coding_systems
;
4705 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4706 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4708 coding_systems
= Ffind_operation_coding_system (7, args
);
4709 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4710 val
= XCDR (coding_systems
);
4714 && !NILP (current_buffer
->buffer_file_coding_system
))
4716 /* If we still have not decided a coding system, use the
4717 default value of buffer-file-coding-system. */
4718 val
= current_buffer
->buffer_file_coding_system
;
4719 using_default_coding
= 1;
4723 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4724 /* Confirm that VAL can surely encode the current region. */
4725 val
= call5 (Vselect_safe_coding_system_function
,
4726 start
, end
, val
, Qnil
, filename
);
4728 setup_coding_system (Fcheck_coding_system (val
), coding
);
4729 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4730 && !using_default_coding
)
4732 if (! EQ (default_buffer_file_coding
.symbol
,
4733 buffer_defaults
.buffer_file_coding_system
))
4734 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4735 &default_buffer_file_coding
);
4736 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4738 Lisp_Object subsidiaries
;
4740 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4741 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4742 if (VECTORP (subsidiaries
)
4743 && XVECTOR (subsidiaries
)->size
== 3)
4745 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4750 setup_raw_text_coding_system (coding
);
4751 goto done_setup_coding
;
4754 setup_coding_system (Fcheck_coding_system (val
), coding
);
4757 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4758 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4761 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4762 "r\nFWrite region to file: \ni\ni\ni\np",
4763 doc
: /* Write current region into specified file.
4764 When called from a program, requires three arguments:
4765 START, END and FILENAME. START and END are normally buffer positions
4766 specifying the part of the buffer to write.
4767 If START is nil, that means to use the entire buffer contents.
4768 If START is a string, then output that string to the file
4769 instead of any buffer contents; END is ignored.
4771 Optional fourth argument APPEND if non-nil means
4772 append to existing file contents (if any). If it is an integer,
4773 seek to that offset in the file before writing.
4774 Optional fifth argument VISIT if t means
4775 set the last-save-file-modtime of buffer to this file's modtime
4776 and mark buffer not modified.
4777 If VISIT is a string, it is a second file name;
4778 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4779 VISIT is also the file name to lock and unlock for clash detection.
4780 If VISIT is neither t nor nil nor a string,
4781 that means do not display the \"Wrote file\" message.
4782 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4783 use for locking and unlocking, overriding FILENAME and VISIT.
4784 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4785 for an existing file with the same name. If MUSTBENEW is `excl',
4786 that means to get an error if the file already exists; never overwrite.
4787 If MUSTBENEW is neither nil nor `excl', that means ask for
4788 confirmation before overwriting, but do go ahead and overwrite the file
4789 if the user confirms.
4791 This does code conversion according to the value of
4792 `coding-system-for-write', `buffer-file-coding-system', or
4793 `file-coding-system-alist', and sets the variable
4794 `last-coding-system-used' to the coding system actually used. */)
4795 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4796 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4801 const unsigned char *fn
;
4804 int count
= SPECPDL_INDEX ();
4807 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4809 Lisp_Object handler
;
4810 Lisp_Object visit_file
;
4811 Lisp_Object annotations
;
4812 Lisp_Object encoded_filename
;
4813 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4814 int quietly
= !NILP (visit
);
4815 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4816 struct buffer
*given_buffer
;
4818 int buffer_file_type
= O_BINARY
;
4820 struct coding_system coding
;
4822 if (current_buffer
->base_buffer
&& visiting
)
4823 error ("Cannot do file visiting in an indirect buffer");
4825 if (!NILP (start
) && !STRINGP (start
))
4826 validate_region (&start
, &end
);
4828 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4830 filename
= Fexpand_file_name (filename
, Qnil
);
4832 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4833 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4835 if (STRINGP (visit
))
4836 visit_file
= Fexpand_file_name (visit
, Qnil
);
4838 visit_file
= filename
;
4840 if (NILP (lockname
))
4841 lockname
= visit_file
;
4845 /* If the file name has special constructs in it,
4846 call the corresponding file handler. */
4847 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4848 /* If FILENAME has no handler, see if VISIT has one. */
4849 if (NILP (handler
) && STRINGP (visit
))
4850 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4852 if (!NILP (handler
))
4855 val
= call6 (handler
, Qwrite_region
, start
, end
,
4856 filename
, append
, visit
);
4860 SAVE_MODIFF
= MODIFF
;
4861 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4862 current_buffer
->filename
= visit_file
;
4868 /* Special kludge to simplify auto-saving. */
4871 XSETFASTINT (start
, BEG
);
4872 XSETFASTINT (end
, Z
);
4875 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4876 count1
= SPECPDL_INDEX ();
4878 given_buffer
= current_buffer
;
4880 if (!STRINGP (start
))
4882 annotations
= build_annotations (start
, end
);
4884 if (current_buffer
!= given_buffer
)
4886 XSETFASTINT (start
, BEGV
);
4887 XSETFASTINT (end
, ZV
);
4893 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4895 /* Decide the coding-system to encode the data with.
4896 We used to make this choice before calling build_annotations, but that
4897 leads to problems when a write-annotate-function takes care of
4898 unsavable chars (as was the case with X-Symbol). */
4899 choose_write_coding_system (start
, end
, filename
,
4900 append
, visit
, lockname
, &coding
);
4901 Vlast_coding_system_used
= coding
.symbol
;
4903 given_buffer
= current_buffer
;
4904 if (! STRINGP (start
))
4906 annotations
= build_annotations_2 (start
, end
,
4907 coding
.pre_write_conversion
, annotations
);
4908 if (current_buffer
!= given_buffer
)
4910 XSETFASTINT (start
, BEGV
);
4911 XSETFASTINT (end
, ZV
);
4915 #ifdef CLASH_DETECTION
4918 #if 0 /* This causes trouble for GNUS. */
4919 /* If we've locked this file for some other buffer,
4920 query before proceeding. */
4921 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4922 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4925 lock_file (lockname
);
4927 #endif /* CLASH_DETECTION */
4929 encoded_filename
= ENCODE_FILE (filename
);
4931 fn
= SDATA (encoded_filename
);
4935 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
4936 #else /* not DOS_NT */
4937 desc
= emacs_open (fn
, O_WRONLY
, 0);
4938 #endif /* not DOS_NT */
4940 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4942 if (auto_saving
) /* Overwrite any previous version of autosave file */
4944 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4945 desc
= emacs_open (fn
, O_RDWR
, 0);
4947 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4948 ? SDATA (current_buffer
->filename
) : 0,
4951 else /* Write to temporary name and rename if no errors */
4953 Lisp_Object temp_name
;
4954 temp_name
= Ffile_name_directory (filename
);
4956 if (!NILP (temp_name
))
4958 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4959 build_string ("$$SAVE$$")));
4960 fname
= SDATA (filename
);
4961 fn
= SDATA (temp_name
);
4962 desc
= creat_copy_attrs (fname
, fn
);
4965 /* If we can't open the temporary file, try creating a new
4966 version of the original file. VMS "creat" creates a
4967 new version rather than truncating an existing file. */
4970 desc
= creat (fn
, 0666);
4971 #if 0 /* This can clobber an existing file and fail to replace it,
4972 if the user runs out of space. */
4975 /* We can't make a new version;
4976 try to truncate and rewrite existing version if any. */
4978 desc
= emacs_open (fn
, O_RDWR
, 0);
4984 desc
= creat (fn
, 0666);
4988 desc
= emacs_open (fn
,
4989 O_WRONLY
| O_CREAT
| buffer_file_type
4990 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
4991 S_IREAD
| S_IWRITE
);
4992 #else /* not DOS_NT */
4993 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
4994 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
4995 auto_saving
? auto_save_mode_bits
: 0666);
4996 #endif /* not DOS_NT */
4997 #endif /* not VMS */
5001 #ifdef CLASH_DETECTION
5003 if (!auto_saving
) unlock_file (lockname
);
5005 #endif /* CLASH_DETECTION */
5007 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5010 record_unwind_protect (close_file_unwind
, make_number (desc
));
5012 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5016 if (NUMBERP (append
))
5017 ret
= lseek (desc
, XINT (append
), 1);
5019 ret
= lseek (desc
, 0, 2);
5022 #ifdef CLASH_DETECTION
5023 if (!auto_saving
) unlock_file (lockname
);
5024 #endif /* CLASH_DETECTION */
5026 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5034 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5035 * if we do writes that don't end with a carriage return. Furthermore
5036 * it cannot handle writes of more then 16K. The modified
5037 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5038 * this EXCEPT for the last record (iff it doesn't end with a carriage
5039 * return). This implies that if your buffer doesn't end with a carriage
5040 * return, you get one free... tough. However it also means that if
5041 * we make two calls to sys_write (a la the following code) you can
5042 * get one at the gap as well. The easiest way to fix this (honest)
5043 * is to move the gap to the next newline (or the end of the buffer).
5048 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5049 move_gap (find_next_newline (GPT
, 1));
5051 /* Whether VMS or not, we must move the gap to the next of newline
5052 when we must put designation sequences at beginning of line. */
5053 if (INTEGERP (start
)
5054 && coding
.type
== coding_type_iso2022
5055 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5056 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5058 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5059 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5060 move_gap_both (PT
, PT_BYTE
);
5061 SET_PT_BOTH (opoint
, opoint_byte
);
5068 if (STRINGP (start
))
5070 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5071 &annotations
, &coding
);
5074 else if (XINT (start
) != XINT (end
))
5076 tem
= CHAR_TO_BYTE (XINT (start
));
5078 if (XINT (start
) < GPT
)
5080 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5081 min (GPT
, XINT (end
)) - XINT (start
),
5082 &annotations
, &coding
);
5086 if (XINT (end
) > GPT
&& !failure
)
5088 tem
= max (XINT (start
), GPT
);
5089 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5090 &annotations
, &coding
);
5096 /* If file was empty, still need to write the annotations */
5097 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5098 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5102 if (CODING_REQUIRE_FLUSHING (&coding
)
5103 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5106 /* We have to flush out a data. */
5107 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5108 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5115 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5116 Disk full in NFS may be reported here. */
5117 /* mib says that closing the file will try to write as fast as NFS can do
5118 it, and that means the fsync here is not crucial for autosave files. */
5119 if (!auto_saving
&& fsync (desc
) < 0)
5121 /* If fsync fails with EINTR, don't treat that as serious. */
5123 failure
= 1, save_errno
= errno
;
5127 /* Spurious "file has changed on disk" warnings have been
5128 observed on Suns as well.
5129 It seems that `close' can change the modtime, under nfs.
5131 (This has supposedly been fixed in Sunos 4,
5132 but who knows about all the other machines with NFS?) */
5135 /* On VMS and APOLLO, must do the stat after the close
5136 since closing changes the modtime. */
5139 /* Recall that #if defined does not work on VMS. */
5146 /* NFS can report a write failure now. */
5147 if (emacs_close (desc
) < 0)
5148 failure
= 1, save_errno
= errno
;
5151 /* If we wrote to a temporary name and had no errors, rename to real name. */
5155 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5163 /* Discard the unwind protect for close_file_unwind. */
5164 specpdl_ptr
= specpdl
+ count1
;
5165 /* Restore the original current buffer. */
5166 visit_file
= unbind_to (count
, visit_file
);
5168 #ifdef CLASH_DETECTION
5170 unlock_file (lockname
);
5171 #endif /* CLASH_DETECTION */
5173 /* Do this before reporting IO error
5174 to avoid a "file has changed on disk" warning on
5175 next attempt to save. */
5177 current_buffer
->modtime
= st
.st_mtime
;
5180 error ("IO error writing %s: %s", SDATA (filename
),
5181 emacs_strerror (save_errno
));
5185 SAVE_MODIFF
= MODIFF
;
5186 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5187 current_buffer
->filename
= visit_file
;
5188 update_mode_lines
++;
5194 message_with_string ("Wrote %s", visit_file
, 1);
5199 Lisp_Object
merge ();
5201 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5202 doc
: /* Return t if (car A) is numerically less than (car B). */)
5206 return Flss (Fcar (a
), Fcar (b
));
5209 /* Build the complete list of annotations appropriate for writing out
5210 the text between START and END, by calling all the functions in
5211 write-region-annotate-functions and merging the lists they return.
5212 If one of these functions switches to a different buffer, we assume
5213 that buffer contains altered text. Therefore, the caller must
5214 make sure to restore the current buffer in all cases,
5215 as save-excursion would do. */
5218 build_annotations (start
, end
)
5219 Lisp_Object start
, end
;
5221 Lisp_Object annotations
;
5223 struct gcpro gcpro1
, gcpro2
;
5224 Lisp_Object original_buffer
;
5225 int i
, used_global
= 0;
5227 XSETBUFFER (original_buffer
, current_buffer
);
5230 p
= Vwrite_region_annotate_functions
;
5231 GCPRO2 (annotations
, p
);
5234 struct buffer
*given_buffer
= current_buffer
;
5235 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5236 { /* Use the global value of the hook. */
5239 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5241 p
= Fappend (2, arg
);
5244 Vwrite_region_annotations_so_far
= annotations
;
5245 res
= call2 (XCAR (p
), start
, end
);
5246 /* If the function makes a different buffer current,
5247 assume that means this buffer contains altered text to be output.
5248 Reset START and END from the buffer bounds
5249 and discard all previous annotations because they should have
5250 been dealt with by this function. */
5251 if (current_buffer
!= given_buffer
)
5253 XSETFASTINT (start
, BEGV
);
5254 XSETFASTINT (end
, ZV
);
5257 Flength (res
); /* Check basic validity of return value */
5258 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5262 /* Now do the same for annotation functions implied by the file-format */
5263 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
5264 p
= Vauto_save_file_format
;
5266 p
= current_buffer
->file_format
;
5267 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5269 struct buffer
*given_buffer
= current_buffer
;
5271 Vwrite_region_annotations_so_far
= annotations
;
5273 /* Value is either a list of annotations or nil if the function
5274 has written annotations to a temporary buffer, which is now
5276 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5277 original_buffer
, make_number (i
));
5278 if (current_buffer
!= given_buffer
)
5280 XSETFASTINT (start
, BEGV
);
5281 XSETFASTINT (end
, ZV
);
5286 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5294 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5295 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5297 struct gcpro gcpro1
;
5300 GCPRO1 (annotations
);
5301 /* At last, do the same for the function PRE_WRITE_CONVERSION
5302 implied by the current coding-system. */
5303 if (!NILP (pre_write_conversion
))
5305 struct buffer
*given_buffer
= current_buffer
;
5306 Vwrite_region_annotations_so_far
= annotations
;
5307 res
= call2 (pre_write_conversion
, start
, end
);
5309 annotations
= (current_buffer
!= given_buffer
5311 : merge (annotations
, res
, Qcar_less_than_car
));
5318 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5319 If STRING is nil, POS is the character position in the current buffer.
5320 Intersperse with them the annotations from *ANNOT
5321 which fall within the range of POS to POS + NCHARS,
5322 each at its appropriate position.
5324 We modify *ANNOT by discarding elements as we use them up.
5326 The return value is negative in case of system call failure. */
5329 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5332 register int nchars
;
5335 struct coding_system
*coding
;
5339 int lastpos
= pos
+ nchars
;
5341 while (NILP (*annot
) || CONSP (*annot
))
5343 tem
= Fcar_safe (Fcar (*annot
));
5346 nextpos
= XFASTINT (tem
);
5348 /* If there are no more annotations in this range,
5349 output the rest of the range all at once. */
5350 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5351 return e_write (desc
, string
, pos
, lastpos
, coding
);
5353 /* Output buffer text up to the next annotation's position. */
5356 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5360 /* Output the annotation. */
5361 tem
= Fcdr (Fcar (*annot
));
5364 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5367 *annot
= Fcdr (*annot
);
5372 #ifndef WRITE_BUF_SIZE
5373 #define WRITE_BUF_SIZE (16 * 1024)
5376 /* Write text in the range START and END into descriptor DESC,
5377 encoding them with coding system CODING. If STRING is nil, START
5378 and END are character positions of the current buffer, else they
5379 are indexes to the string STRING. */
5382 e_write (desc
, string
, start
, end
, coding
)
5386 struct coding_system
*coding
;
5388 register char *addr
;
5389 register int nbytes
;
5390 char buf
[WRITE_BUF_SIZE
];
5394 coding
->composing
= COMPOSITION_DISABLED
;
5395 if (coding
->composing
!= COMPOSITION_DISABLED
)
5396 coding_save_composition (coding
, start
, end
, string
);
5398 if (STRINGP (string
))
5400 addr
= SDATA (string
);
5401 nbytes
= SBYTES (string
);
5402 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5404 else if (start
< end
)
5406 /* It is assured that the gap is not in the range START and END-1. */
5407 addr
= CHAR_POS_ADDR (start
);
5408 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5409 coding
->src_multibyte
5410 = !NILP (current_buffer
->enable_multibyte_characters
);
5416 coding
->src_multibyte
= 1;
5419 /* We used to have a code for handling selective display here. But,
5420 now it is handled within encode_coding. */
5425 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5426 if (coding
->produced
> 0)
5428 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5429 if (coding
->produced
)
5435 nbytes
-= coding
->consumed
;
5436 addr
+= coding
->consumed
;
5437 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5440 /* The source text ends by an incomplete multibyte form.
5441 There's no way other than write it out as is. */
5442 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5451 start
+= coding
->consumed_char
;
5452 if (coding
->cmp_data
)
5453 coding_adjust_composition_offset (coding
, start
);
5456 if (coding
->cmp_data
)
5457 coding_free_composition_data (coding
);
5462 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5463 Sverify_visited_file_modtime
, 1, 1, 0,
5464 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5465 This means that the file has not been changed since it was visited or saved. */)
5471 Lisp_Object handler
;
5472 Lisp_Object filename
;
5477 if (!STRINGP (b
->filename
)) return Qt
;
5478 if (b
->modtime
== 0) return Qt
;
5480 /* If the file name has special constructs in it,
5481 call the corresponding file handler. */
5482 handler
= Ffind_file_name_handler (b
->filename
,
5483 Qverify_visited_file_modtime
);
5484 if (!NILP (handler
))
5485 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5487 filename
= ENCODE_FILE (b
->filename
);
5489 if (stat (SDATA (filename
), &st
) < 0)
5491 /* If the file doesn't exist now and didn't exist before,
5492 we say that it isn't modified, provided the error is a tame one. */
5493 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5498 if (st
.st_mtime
== b
->modtime
5499 /* If both are positive, accept them if they are off by one second. */
5500 || (st
.st_mtime
> 0 && b
->modtime
> 0
5501 && (st
.st_mtime
== b
->modtime
+ 1
5502 || st
.st_mtime
== b
->modtime
- 1)))
5507 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5508 Sclear_visited_file_modtime
, 0, 0, 0,
5509 doc
: /* Clear out records of last mod time of visited file.
5510 Next attempt to save will certainly not complain of a discrepancy. */)
5513 current_buffer
->modtime
= 0;
5517 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5518 Svisited_file_modtime
, 0, 0, 0,
5519 doc
: /* Return the current buffer's recorded visited file modification time.
5520 The value is a list of the form (HIGH . LOW), like the time values
5521 that `file-attributes' returns. */)
5524 return long_to_cons ((unsigned long) current_buffer
->modtime
);
5527 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5528 Sset_visited_file_modtime
, 0, 1, 0,
5529 doc
: /* Update buffer's recorded modification time from the visited file's time.
5530 Useful if the buffer was not read from the file normally
5531 or if the file itself has been changed for some known benign reason.
5532 An argument specifies the modification time value to use
5533 \(instead of that of the visited file), in the form of a list
5534 \(HIGH . LOW) or (HIGH LOW). */)
5536 Lisp_Object time_list
;
5538 if (!NILP (time_list
))
5539 current_buffer
->modtime
= cons_to_long (time_list
);
5542 register Lisp_Object filename
;
5544 Lisp_Object handler
;
5546 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5548 /* If the file name has special constructs in it,
5549 call the corresponding file handler. */
5550 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5551 if (!NILP (handler
))
5552 /* The handler can find the file name the same way we did. */
5553 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5555 filename
= ENCODE_FILE (filename
);
5557 if (stat (SDATA (filename
), &st
) >= 0)
5558 current_buffer
->modtime
= st
.st_mtime
;
5565 auto_save_error (error
)
5568 Lisp_Object args
[3], msg
;
5570 struct gcpro gcpro1
;
5574 args
[0] = build_string ("Auto-saving %s: %s");
5575 args
[1] = current_buffer
->name
;
5576 args
[2] = Ferror_message_string (error
);
5577 msg
= Fformat (3, args
);
5579 nbytes
= SBYTES (msg
);
5581 for (i
= 0; i
< 3; ++i
)
5584 message2 (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5586 message2_nolog (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5587 Fsleep_for (make_number (1), Qnil
);
5599 /* Get visited file's mode to become the auto save file's mode. */
5600 if (! NILP (current_buffer
->filename
)
5601 && stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5602 /* But make sure we can overwrite it later! */
5603 auto_save_mode_bits
= st
.st_mode
| 0600;
5605 auto_save_mode_bits
= 0666;
5608 Fwrite_region (Qnil
, Qnil
,
5609 current_buffer
->auto_save_file_name
,
5610 Qnil
, Qlambda
, Qnil
, Qnil
);
5614 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5619 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5620 | XFASTINT (XCDR (stream
))));
5625 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5628 minibuffer_auto_raise
= XINT (value
);
5633 do_auto_save_make_dir (dir
)
5636 return call2 (Qmake_directory
, dir
, Qt
);
5640 do_auto_save_eh (ignore
)
5646 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5647 doc
: /* Auto-save all buffers that need it.
5648 This is all buffers that have auto-saving enabled
5649 and are changed since last auto-saved.
5650 Auto-saving writes the buffer into a file
5651 so that your editing is not lost if the system crashes.
5652 This file is not the file you visited; that changes only when you save.
5653 Normally we run the normal hook `auto-save-hook' before saving.
5655 A non-nil NO-MESSAGE argument means do not print any message if successful.
5656 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5657 (no_message
, current_only
)
5658 Lisp_Object no_message
, current_only
;
5660 struct buffer
*old
= current_buffer
, *b
;
5661 Lisp_Object tail
, buf
;
5663 int do_handled_files
;
5666 Lisp_Object lispstream
;
5667 int count
= SPECPDL_INDEX ();
5668 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5669 int old_message_p
= 0;
5670 struct gcpro gcpro1
, gcpro2
;
5672 if (max_specpdl_size
< specpdl_size
+ 40)
5673 max_specpdl_size
= specpdl_size
+ 40;
5678 if (NILP (no_message
))
5680 old_message_p
= push_message ();
5681 record_unwind_protect (pop_message_unwind
, Qnil
);
5684 /* Ordinarily don't quit within this function,
5685 but don't make it impossible to quit (in case we get hung in I/O). */
5689 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5690 point to non-strings reached from Vbuffer_alist. */
5692 if (!NILP (Vrun_hooks
))
5693 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5695 if (STRINGP (Vauto_save_list_file_name
))
5697 Lisp_Object listfile
;
5699 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5701 /* Don't try to create the directory when shutting down Emacs,
5702 because creating the directory might signal an error, and
5703 that would leave Emacs in a strange state. */
5704 if (!NILP (Vrun_hooks
))
5708 GCPRO2 (dir
, listfile
);
5709 dir
= Ffile_name_directory (listfile
);
5710 if (NILP (Ffile_directory_p (dir
)))
5711 internal_condition_case_1 (do_auto_save_make_dir
,
5712 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5717 stream
= fopen (SDATA (listfile
), "w");
5720 /* Arrange to close that file whether or not we get an error.
5721 Also reset auto_saving to 0. */
5722 lispstream
= Fcons (Qnil
, Qnil
);
5723 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
5724 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
5735 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5736 record_unwind_protect (do_auto_save_unwind_1
,
5737 make_number (minibuffer_auto_raise
));
5738 minibuffer_auto_raise
= 0;
5741 /* First, save all files which don't have handlers. If Emacs is
5742 crashing, the handlers may tweak what is causing Emacs to crash
5743 in the first place, and it would be a shame if Emacs failed to
5744 autosave perfectly ordinary files because it couldn't handle some
5746 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5747 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5749 buf
= XCDR (XCAR (tail
));
5752 /* Record all the buffers that have auto save mode
5753 in the special file that lists them. For each of these buffers,
5754 Record visited name (if any) and auto save name. */
5755 if (STRINGP (b
->auto_save_file_name
)
5756 && stream
!= NULL
&& do_handled_files
== 0)
5758 if (!NILP (b
->filename
))
5760 fwrite (SDATA (b
->filename
), 1,
5761 SBYTES (b
->filename
), stream
);
5763 putc ('\n', stream
);
5764 fwrite (SDATA (b
->auto_save_file_name
), 1,
5765 SBYTES (b
->auto_save_file_name
), stream
);
5766 putc ('\n', stream
);
5769 if (!NILP (current_only
)
5770 && b
!= current_buffer
)
5773 /* Don't auto-save indirect buffers.
5774 The base buffer takes care of it. */
5778 /* Check for auto save enabled
5779 and file changed since last auto save
5780 and file changed since last real save. */
5781 if (STRINGP (b
->auto_save_file_name
)
5782 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5783 && b
->auto_save_modified
< BUF_MODIFF (b
)
5784 /* -1 means we've turned off autosaving for a while--see below. */
5785 && XINT (b
->save_length
) >= 0
5786 && (do_handled_files
5787 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5790 EMACS_TIME before_time
, after_time
;
5792 EMACS_GET_TIME (before_time
);
5794 /* If we had a failure, don't try again for 20 minutes. */
5795 if (b
->auto_save_failure_time
>= 0
5796 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5799 if ((XFASTINT (b
->save_length
) * 10
5800 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5801 /* A short file is likely to change a large fraction;
5802 spare the user annoying messages. */
5803 && XFASTINT (b
->save_length
) > 5000
5804 /* These messages are frequent and annoying for `*mail*'. */
5805 && !EQ (b
->filename
, Qnil
)
5806 && NILP (no_message
))
5808 /* It has shrunk too much; turn off auto-saving here. */
5809 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5810 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5812 minibuffer_auto_raise
= 0;
5813 /* Turn off auto-saving until there's a real save,
5814 and prevent any more warnings. */
5815 XSETINT (b
->save_length
, -1);
5816 Fsleep_for (make_number (1), Qnil
);
5819 set_buffer_internal (b
);
5820 if (!auto_saved
&& NILP (no_message
))
5821 message1 ("Auto-saving...");
5822 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5824 b
->auto_save_modified
= BUF_MODIFF (b
);
5825 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5826 set_buffer_internal (old
);
5828 EMACS_GET_TIME (after_time
);
5830 /* If auto-save took more than 60 seconds,
5831 assume it was an NFS failure that got a timeout. */
5832 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5833 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5837 /* Prevent another auto save till enough input events come in. */
5838 record_auto_save ();
5840 if (auto_saved
&& NILP (no_message
))
5844 /* If we are going to restore an old message,
5845 give time to read ours. */
5846 sit_for (1, 0, 0, 0, 0);
5850 /* If we displayed a message and then restored a state
5851 with no message, leave a "done" message on the screen. */
5852 message1 ("Auto-saving...done");
5857 /* This restores the message-stack status. */
5858 unbind_to (count
, Qnil
);
5862 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5863 Sset_buffer_auto_saved
, 0, 0, 0,
5864 doc
: /* Mark current buffer as auto-saved with its current text.
5865 No auto-save file will be written until the buffer changes again. */)
5868 current_buffer
->auto_save_modified
= MODIFF
;
5869 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5870 current_buffer
->auto_save_failure_time
= -1;
5874 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5875 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5876 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5879 current_buffer
->auto_save_failure_time
= -1;
5883 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5885 doc
: /* Return t if buffer has been auto-saved since last read in or saved. */)
5888 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5891 /* Reading and completing file names */
5892 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
5894 /* In the string VAL, change each $ to $$ and return the result. */
5897 double_dollars (val
)
5900 register const unsigned char *old
;
5901 register unsigned char *new;
5905 osize
= SBYTES (val
);
5907 /* Count the number of $ characters. */
5908 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
5909 if (*old
++ == '$') count
++;
5913 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
5916 for (n
= osize
; n
> 0; n
--)
5930 read_file_name_cleanup (arg
)
5933 return (current_buffer
->directory
= arg
);
5936 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
5938 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
5939 (string
, dir
, action
)
5940 Lisp_Object string
, dir
, action
;
5941 /* action is nil for complete, t for return list of completions,
5942 lambda for verify final value */
5944 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
5946 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5948 CHECK_STRING (string
);
5955 /* No need to protect ACTION--we only compare it with t and nil. */
5956 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
5958 if (SCHARS (string
) == 0)
5960 if (EQ (action
, Qlambda
))
5968 orig_string
= string
;
5969 string
= Fsubstitute_in_file_name (string
);
5970 changed
= NILP (Fstring_equal (string
, orig_string
));
5971 name
= Ffile_name_nondirectory (string
);
5972 val
= Ffile_name_directory (string
);
5974 realdir
= Fexpand_file_name (val
, realdir
);
5979 specdir
= Ffile_name_directory (string
);
5980 val
= Ffile_name_completion (name
, realdir
);
5985 return double_dollars (string
);
5989 if (!NILP (specdir
))
5990 val
= concat2 (specdir
, val
);
5992 return double_dollars (val
);
5995 #endif /* not VMS */
5999 if (EQ (action
, Qt
))
6001 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6005 if (NILP (Vread_file_name_predicate
)
6006 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6010 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6012 /* Brute-force speed up for directory checking:
6013 Discard strings which don't end in a slash. */
6014 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6016 Lisp_Object tem
= XCAR (all
);
6018 if (STRINGP (tem
) &&
6019 (len
= SCHARS (tem
), len
> 0) &&
6020 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6021 comp
= Fcons (tem
, comp
);
6027 /* Must do it the hard (and slow) way. */
6028 GCPRO3 (all
, comp
, specdir
);
6029 count
= SPECPDL_INDEX ();
6030 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6031 current_buffer
->directory
= realdir
;
6032 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6033 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
6034 comp
= Fcons (XCAR (all
), comp
);
6035 unbind_to (count
, Qnil
);
6038 return Fnreverse (comp
);
6041 /* Only other case actually used is ACTION = lambda */
6043 /* Supposedly this helps commands such as `cd' that read directory names,
6044 but can someone explain how it helps them? -- RMS */
6045 if (SCHARS (name
) == 0)
6048 if (!NILP (Vread_file_name_predicate
))
6049 return call1 (Vread_file_name_predicate
, string
);
6050 return Ffile_exists_p (string
);
6053 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6054 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6055 Value is not expanded---you must call `expand-file-name' yourself.
6056 Default name to DEFAULT-FILENAME if user enters a null string.
6057 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6058 except that if INITIAL is specified, that combined with DIR is used.)
6059 Fourth arg MUSTMATCH non-nil means require existing file's name.
6060 Non-nil and non-t means also require confirmation after completion.
6061 Fifth arg INITIAL specifies text to start with.
6062 If optional sixth arg PREDICATE is non-nil, possible completions and the
6063 resulting file name must satisfy (funcall PREDICATE NAME).
6064 DIR defaults to current buffer's directory default.
6066 If this command was invoked with the mouse, use a file dialog box if
6067 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6068 provides a file dialog box. */)
6069 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6070 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6072 Lisp_Object val
, insdef
, tem
;
6073 struct gcpro gcpro1
, gcpro2
;
6074 register char *homedir
;
6075 Lisp_Object decoded_homedir
;
6076 int replace_in_history
= 0;
6077 int add_to_history
= 0;
6081 dir
= current_buffer
->directory
;
6082 if (NILP (default_filename
))
6083 default_filename
= !NILP (initial
)
6084 ? Fexpand_file_name (initial
, dir
)
6085 : current_buffer
->filename
;
6087 /* If dir starts with user's homedir, change that to ~. */
6088 homedir
= (char *) egetenv ("HOME");
6090 /* homedir can be NULL in temacs, since Vprocess_environment is not
6091 yet set up. We shouldn't crash in that case. */
6094 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6095 CORRECT_DIR_SEPS (homedir
);
6100 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6103 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6104 SBYTES (decoded_homedir
))
6105 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6107 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6108 dir
= concat2 (build_string ("~"), dir
);
6110 /* Likewise for default_filename. */
6112 && STRINGP (default_filename
)
6113 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6114 SBYTES (decoded_homedir
))
6115 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6118 = Fsubstring (default_filename
,
6119 make_number (SCHARS (decoded_homedir
)), Qnil
);
6120 default_filename
= concat2 (build_string ("~"), default_filename
);
6122 if (!NILP (default_filename
))
6124 CHECK_STRING (default_filename
);
6125 default_filename
= double_dollars (default_filename
);
6128 if (insert_default_directory
&& STRINGP (dir
))
6131 if (!NILP (initial
))
6133 Lisp_Object args
[2], pos
;
6137 insdef
= Fconcat (2, args
);
6138 pos
= make_number (SCHARS (double_dollars (dir
)));
6139 insdef
= Fcons (double_dollars (insdef
), pos
);
6142 insdef
= double_dollars (insdef
);
6144 else if (STRINGP (initial
))
6145 insdef
= Fcons (double_dollars (initial
), make_number (0));
6149 if (!NILP (Vread_file_name_function
))
6151 Lisp_Object args
[7];
6153 GCPRO2 (insdef
, default_filename
);
6154 args
[0] = Vread_file_name_function
;
6157 args
[3] = default_filename
;
6158 args
[4] = mustmatch
;
6160 args
[6] = predicate
;
6161 RETURN_UNGCPRO (Ffuncall (7, args
));
6164 count
= SPECPDL_INDEX ();
6166 specbind (intern ("completion-ignore-case"), Qt
);
6169 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6170 specbind (intern ("read-file-name-predicate"),
6171 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6173 GCPRO2 (insdef
, default_filename
);
6175 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
6176 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6180 /* If DIR contains a file name, split it. */
6182 file
= Ffile_name_nondirectory (dir
);
6183 if (SCHARS (file
) && NILP (default_filename
))
6185 default_filename
= file
;
6186 dir
= Ffile_name_directory (dir
);
6188 if (!NILP(default_filename
))
6189 default_filename
= Fexpand_file_name (default_filename
, dir
);
6190 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
);
6195 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6196 dir
, mustmatch
, insdef
,
6197 Qfile_name_history
, default_filename
, Qnil
);
6199 tem
= Fsymbol_value (Qfile_name_history
);
6200 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6201 replace_in_history
= 1;
6203 /* If Fcompleting_read returned the inserted default string itself
6204 (rather than a new string with the same contents),
6205 it has to mean that the user typed RET with the minibuffer empty.
6206 In that case, we really want to return ""
6207 so that commands such as set-visited-file-name can distinguish. */
6208 if (EQ (val
, default_filename
))
6210 /* In this case, Fcompleting_read has not added an element
6211 to the history. Maybe we should. */
6212 if (! replace_in_history
)
6218 unbind_to (count
, Qnil
);
6221 error ("No file name specified");
6223 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6225 if (!NILP (tem
) && !NILP (default_filename
))
6226 val
= default_filename
;
6227 else if (SCHARS (val
) == 0 && NILP (insdef
))
6229 if (!NILP (default_filename
))
6230 val
= default_filename
;
6232 error ("No default file name");
6234 val
= Fsubstitute_in_file_name (val
);
6236 if (replace_in_history
)
6237 /* Replace what Fcompleting_read added to the history
6238 with what we will actually return. */
6239 XSETCAR (Fsymbol_value (Qfile_name_history
), double_dollars (val
));
6240 else if (add_to_history
)
6242 /* Add the value to the history--but not if it matches
6243 the last value already there. */
6244 Lisp_Object val1
= double_dollars (val
);
6245 tem
= Fsymbol_value (Qfile_name_history
);
6246 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6247 Fset (Qfile_name_history
,
6258 /* Must be set before any path manipulation is performed. */
6259 XSETFASTINT (Vdirectory_sep_char
, '/');
6266 Qexpand_file_name
= intern ("expand-file-name");
6267 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6268 Qdirectory_file_name
= intern ("directory-file-name");
6269 Qfile_name_directory
= intern ("file-name-directory");
6270 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6271 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6272 Qfile_name_as_directory
= intern ("file-name-as-directory");
6273 Qcopy_file
= intern ("copy-file");
6274 Qmake_directory_internal
= intern ("make-directory-internal");
6275 Qmake_directory
= intern ("make-directory");
6276 Qdelete_directory
= intern ("delete-directory");
6277 Qdelete_file
= intern ("delete-file");
6278 Qrename_file
= intern ("rename-file");
6279 Qadd_name_to_file
= intern ("add-name-to-file");
6280 Qmake_symbolic_link
= intern ("make-symbolic-link");
6281 Qfile_exists_p
= intern ("file-exists-p");
6282 Qfile_executable_p
= intern ("file-executable-p");
6283 Qfile_readable_p
= intern ("file-readable-p");
6284 Qfile_writable_p
= intern ("file-writable-p");
6285 Qfile_symlink_p
= intern ("file-symlink-p");
6286 Qaccess_file
= intern ("access-file");
6287 Qfile_directory_p
= intern ("file-directory-p");
6288 Qfile_regular_p
= intern ("file-regular-p");
6289 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6290 Qfile_modes
= intern ("file-modes");
6291 Qset_file_modes
= intern ("set-file-modes");
6292 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6293 Qinsert_file_contents
= intern ("insert-file-contents");
6294 Qwrite_region
= intern ("write-region");
6295 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6296 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6298 staticpro (&Qexpand_file_name
);
6299 staticpro (&Qsubstitute_in_file_name
);
6300 staticpro (&Qdirectory_file_name
);
6301 staticpro (&Qfile_name_directory
);
6302 staticpro (&Qfile_name_nondirectory
);
6303 staticpro (&Qunhandled_file_name_directory
);
6304 staticpro (&Qfile_name_as_directory
);
6305 staticpro (&Qcopy_file
);
6306 staticpro (&Qmake_directory_internal
);
6307 staticpro (&Qmake_directory
);
6308 staticpro (&Qdelete_directory
);
6309 staticpro (&Qdelete_file
);
6310 staticpro (&Qrename_file
);
6311 staticpro (&Qadd_name_to_file
);
6312 staticpro (&Qmake_symbolic_link
);
6313 staticpro (&Qfile_exists_p
);
6314 staticpro (&Qfile_executable_p
);
6315 staticpro (&Qfile_readable_p
);
6316 staticpro (&Qfile_writable_p
);
6317 staticpro (&Qaccess_file
);
6318 staticpro (&Qfile_symlink_p
);
6319 staticpro (&Qfile_directory_p
);
6320 staticpro (&Qfile_regular_p
);
6321 staticpro (&Qfile_accessible_directory_p
);
6322 staticpro (&Qfile_modes
);
6323 staticpro (&Qset_file_modes
);
6324 staticpro (&Qfile_newer_than_file_p
);
6325 staticpro (&Qinsert_file_contents
);
6326 staticpro (&Qwrite_region
);
6327 staticpro (&Qverify_visited_file_modtime
);
6328 staticpro (&Qset_visited_file_modtime
);
6330 Qfile_name_history
= intern ("file-name-history");
6331 Fset (Qfile_name_history
, Qnil
);
6332 staticpro (&Qfile_name_history
);
6334 Qfile_error
= intern ("file-error");
6335 staticpro (&Qfile_error
);
6336 Qfile_already_exists
= intern ("file-already-exists");
6337 staticpro (&Qfile_already_exists
);
6338 Qfile_date_error
= intern ("file-date-error");
6339 staticpro (&Qfile_date_error
);
6340 Qexcl
= intern ("excl");
6344 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6345 staticpro (&Qfind_buffer_file_type
);
6348 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6349 doc
: /* *Coding system for encoding file names.
6350 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6351 Vfile_name_coding_system
= Qnil
;
6353 DEFVAR_LISP ("default-file-name-coding-system",
6354 &Vdefault_file_name_coding_system
,
6355 doc
: /* Default coding system for encoding file names.
6356 This variable is used only when `file-name-coding-system' is nil.
6358 This variable is set/changed by the command `set-language-environment'.
6359 User should not set this variable manually,
6360 instead use `file-name-coding-system' to get a constant encoding
6361 of file names regardless of the current language environment. */);
6362 Vdefault_file_name_coding_system
= Qnil
;
6364 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
6365 doc
: /* *Format in which to write auto-save files.
6366 Should be a list of symbols naming formats that are defined in `format-alist'.
6367 If it is t, which is the default, auto-save files are written in the
6368 same format as a regular save would use. */);
6369 Vauto_save_file_format
= Qt
;
6371 Qformat_decode
= intern ("format-decode");
6372 staticpro (&Qformat_decode
);
6373 Qformat_annotate_function
= intern ("format-annotate-function");
6374 staticpro (&Qformat_annotate_function
);
6375 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6376 staticpro (&Qafter_insert_file_set_coding
);
6378 Qcar_less_than_car
= intern ("car-less-than-car");
6379 staticpro (&Qcar_less_than_car
);
6381 Fput (Qfile_error
, Qerror_conditions
,
6382 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6383 Fput (Qfile_error
, Qerror_message
,
6384 build_string ("File error"));
6386 Fput (Qfile_already_exists
, Qerror_conditions
,
6387 Fcons (Qfile_already_exists
,
6388 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6389 Fput (Qfile_already_exists
, Qerror_message
,
6390 build_string ("File already exists"));
6392 Fput (Qfile_date_error
, Qerror_conditions
,
6393 Fcons (Qfile_date_error
,
6394 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6395 Fput (Qfile_date_error
, Qerror_message
,
6396 build_string ("Cannot set file date"));
6398 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6399 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6400 Vread_file_name_function
= Qnil
;
6402 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6403 doc
: /* Current predicate used by `read-file-name-internal'. */);
6404 Vread_file_name_predicate
= Qnil
;
6406 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6407 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer. */);
6408 insert_default_directory
= 1;
6410 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6411 doc
: /* *Non-nil means write new files with record format `stmlf'.
6412 nil means use format `var'. This variable is meaningful only on VMS. */);
6413 vms_stmlf_recfm
= 0;
6415 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6416 doc
: /* Directory separator character for built-in functions that return file names.
6417 The value is always ?/. Don't use this variable, just use `/'. */);
6419 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6420 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6421 If a file name matches REGEXP, then all I/O on that file is done by calling
6424 The first argument given to HANDLER is the name of the I/O primitive
6425 to be handled; the remaining arguments are the arguments that were
6426 passed to that primitive. For example, if you do
6427 (file-exists-p FILENAME)
6428 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6429 (funcall HANDLER 'file-exists-p FILENAME)
6430 The function `find-file-name-handler' checks this list for a handler
6431 for its argument. */);
6432 Vfile_name_handler_alist
= Qnil
;
6434 DEFVAR_LISP ("set-auto-coding-function",
6435 &Vset_auto_coding_function
,
6436 doc
: /* If non-nil, a function to call to decide a coding system of file.
6437 Two arguments are passed to this function: the file name
6438 and the length of a file contents following the point.
6439 This function should return a coding system to decode the file contents.
6440 It should check the file name against `auto-coding-alist'.
6441 If no coding system is decided, it should check a coding system
6442 specified in the heading lines with the format:
6443 -*- ... coding: CODING-SYSTEM; ... -*-
6444 or local variable spec of the tailing lines with `coding:' tag. */);
6445 Vset_auto_coding_function
= Qnil
;
6447 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6448 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6449 Each is passed one argument, the number of characters inserted.
6450 It should return the new character count, and leave point the same.
6451 If `insert-file-contents' is intercepted by a handler from
6452 `file-name-handler-alist', that handler is responsible for calling the
6453 functions in `after-insert-file-functions' if appropriate. */);
6454 Vafter_insert_file_functions
= Qnil
;
6456 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6457 doc
: /* A list of functions to be called at the start of `write-region'.
6458 Each is passed two arguments, START and END as for `write-region'.
6459 These are usually two numbers but not always; see the documentation
6460 for `write-region'. The function should return a list of pairs
6461 of the form (POSITION . STRING), consisting of strings to be effectively
6462 inserted at the specified positions of the file being written (1 means to
6463 insert before the first byte written). The POSITIONs must be sorted into
6464 increasing order. If there are several functions in the list, the several
6465 lists are merged destructively. Alternatively, the function can return
6466 with a different buffer current; in that case it should pay attention
6467 to the annotations returned by previous functions and listed in
6468 `write-region-annotations-so-far'.*/);
6469 Vwrite_region_annotate_functions
= Qnil
;
6470 staticpro (&Qwrite_region_annotate_functions
);
6471 Qwrite_region_annotate_functions
6472 = intern ("write-region-annotate-functions");
6474 DEFVAR_LISP ("write-region-annotations-so-far",
6475 &Vwrite_region_annotations_so_far
,
6476 doc
: /* When an annotation function is called, this holds the previous annotations.
6477 These are the annotations made by other annotation functions
6478 that were already called. See also `write-region-annotate-functions'. */);
6479 Vwrite_region_annotations_so_far
= Qnil
;
6481 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6482 doc
: /* A list of file name handlers that temporarily should not be used.
6483 This applies only to the operation `inhibit-file-name-operation'. */);
6484 Vinhibit_file_name_handlers
= Qnil
;
6486 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6487 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6488 Vinhibit_file_name_operation
= Qnil
;
6490 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6491 doc
: /* File name in which we write a list of all auto save file names.
6492 This variable is initialized automatically from `auto-save-list-file-prefix'
6493 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6494 a non-nil value. */);
6495 Vauto_save_list_file_name
= Qnil
;
6497 defsubr (&Sfind_file_name_handler
);
6498 defsubr (&Sfile_name_directory
);
6499 defsubr (&Sfile_name_nondirectory
);
6500 defsubr (&Sunhandled_file_name_directory
);
6501 defsubr (&Sfile_name_as_directory
);
6502 defsubr (&Sdirectory_file_name
);
6503 defsubr (&Smake_temp_name
);
6504 defsubr (&Sexpand_file_name
);
6505 defsubr (&Ssubstitute_in_file_name
);
6506 defsubr (&Scopy_file
);
6507 defsubr (&Smake_directory_internal
);
6508 defsubr (&Sdelete_directory
);
6509 defsubr (&Sdelete_file
);
6510 defsubr (&Srename_file
);
6511 defsubr (&Sadd_name_to_file
);
6513 defsubr (&Smake_symbolic_link
);
6514 #endif /* S_IFLNK */
6516 defsubr (&Sdefine_logical_name
);
6519 defsubr (&Ssysnetunam
);
6520 #endif /* HPUX_NET */
6521 defsubr (&Sfile_name_absolute_p
);
6522 defsubr (&Sfile_exists_p
);
6523 defsubr (&Sfile_executable_p
);
6524 defsubr (&Sfile_readable_p
);
6525 defsubr (&Sfile_writable_p
);
6526 defsubr (&Saccess_file
);
6527 defsubr (&Sfile_symlink_p
);
6528 defsubr (&Sfile_directory_p
);
6529 defsubr (&Sfile_accessible_directory_p
);
6530 defsubr (&Sfile_regular_p
);
6531 defsubr (&Sfile_modes
);
6532 defsubr (&Sset_file_modes
);
6533 defsubr (&Sset_default_file_modes
);
6534 defsubr (&Sdefault_file_modes
);
6535 defsubr (&Sfile_newer_than_file_p
);
6536 defsubr (&Sinsert_file_contents
);
6537 defsubr (&Swrite_region
);
6538 defsubr (&Scar_less_than_car
);
6539 defsubr (&Sverify_visited_file_modtime
);
6540 defsubr (&Sclear_visited_file_modtime
);
6541 defsubr (&Svisited_file_modtime
);
6542 defsubr (&Sset_visited_file_modtime
);
6543 defsubr (&Sdo_auto_save
);
6544 defsubr (&Sset_buffer_auto_saved
);
6545 defsubr (&Sclear_buffer_auto_save_failure
);
6546 defsubr (&Srecent_auto_save_p
);
6548 defsubr (&Sread_file_name_internal
);
6549 defsubr (&Sread_file_name
);
6552 defsubr (&Sunix_sync
);