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. */
22 #define _GNU_SOURCE /* for euidaccess */
26 #if defined (USG5) || defined (BSD_SYSTEM) || defined (LINUX)
31 #include <sys/types.h>
38 #if !defined (S_ISLNK) && defined (S_IFLNK)
39 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
42 #if !defined (S_ISFIFO) && defined (S_IFIFO)
43 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
46 #if !defined (S_ISREG) && defined (S_IFREG)
47 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
88 #include "intervals.h"
99 #endif /* not WINDOWSNT */
103 #include <sys/param.h>
111 #define CORRECT_DIR_SEPS(s) \
112 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
113 else unixtodos_filename (s); \
115 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
116 redirector allows the six letters between 'Z' and 'a' as well. */
118 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
121 #define IS_DRIVE(x) isalpha (x)
123 /* Need to lower-case the drive letter, or else expanded
124 filenames will sometimes compare inequal, because
125 `expand-file-name' doesn't always down-case the drive letter. */
126 #define DRIVE_LETTER(x) (tolower (x))
147 #include "commands.h"
148 extern int use_dialog_box
;
162 #ifndef FILE_SYSTEM_CASE
163 #define FILE_SYSTEM_CASE(filename) (filename)
166 #define min(a, b) ((a) < (b) ? (a) : (b))
167 #define max(a, b) ((a) > (b) ? (a) : (b))
169 /* Nonzero during writing of auto-save files */
172 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
173 a new file with the same mode as the original */
174 int auto_save_mode_bits
;
176 /* Coding system for file names, or nil if none. */
177 Lisp_Object Vfile_name_coding_system
;
179 /* Coding system for file names used only when
180 Vfile_name_coding_system is nil. */
181 Lisp_Object Vdefault_file_name_coding_system
;
183 /* Alist of elements (REGEXP . HANDLER) for file names
184 whose I/O is done with a special handler. */
185 Lisp_Object Vfile_name_handler_alist
;
187 /* Format for auto-save files */
188 Lisp_Object Vauto_save_file_format
;
190 /* Lisp functions for translating file formats */
191 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
193 /* Function to be called to decide a coding system of a reading file. */
194 Lisp_Object Vset_auto_coding_function
;
196 /* Functions to be called to process text properties in inserted file. */
197 Lisp_Object Vafter_insert_file_functions
;
199 /* Functions to be called to create text property annotations for file. */
200 Lisp_Object Vwrite_region_annotate_functions
;
202 /* During build_annotations, each time an annotation function is called,
203 this holds the annotations made by the previous functions. */
204 Lisp_Object Vwrite_region_annotations_so_far
;
206 /* File name in which we write a list of all our auto save files. */
207 Lisp_Object Vauto_save_list_file_name
;
209 /* Nonzero means, when reading a filename in the minibuffer,
210 start out by inserting the default directory into the minibuffer. */
211 int insert_default_directory
;
213 /* On VMS, nonzero means write new files with record format stmlf.
214 Zero means use var format. */
217 /* On NT, specifies the directory separator character, used (eg.) when
218 expanding file names. This can be bound to / or \. */
219 Lisp_Object Vdirectory_sep_char
;
221 extern Lisp_Object Vuser_login_name
;
224 extern Lisp_Object Vw32_get_true_file_attributes
;
227 extern int minibuf_level
;
229 extern int minibuffer_auto_raise
;
231 /* These variables describe handlers that have "already" had a chance
232 to handle the current operation.
234 Vinhibit_file_name_handlers is a list of file name handlers.
235 Vinhibit_file_name_operation is the operation being handled.
236 If we try to handle that operation, we ignore those handlers. */
238 static Lisp_Object Vinhibit_file_name_handlers
;
239 static Lisp_Object Vinhibit_file_name_operation
;
241 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
243 Lisp_Object Qfile_name_history
;
245 Lisp_Object Qcar_less_than_car
;
247 static int a_write
P_ ((int, Lisp_Object
, int, int,
248 Lisp_Object
*, struct coding_system
*));
249 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
253 report_file_error (string
, data
)
257 Lisp_Object errstring
;
260 synchronize_system_messages_locale ();
261 errstring
= code_convert_string_norecord (build_string (strerror (errorno
)),
262 Vlocale_coding_system
, 0);
268 Fsignal (Qfile_already_exists
, Fcons (errstring
, data
));
271 /* System error messages are capitalized. Downcase the initial
272 unless it is followed by a slash. */
273 if (XSTRING (errstring
)->data
[1] != '/')
274 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
276 Fsignal (Qfile_error
,
277 Fcons (build_string (string
), Fcons (errstring
, data
)));
282 close_file_unwind (fd
)
285 emacs_close (XFASTINT (fd
));
289 /* Restore point, having saved it as a marker. */
292 restore_point_unwind (location
)
293 Lisp_Object location
;
295 Fgoto_char (location
);
296 Fset_marker (location
, Qnil
, Qnil
);
300 Lisp_Object Qexpand_file_name
;
301 Lisp_Object Qsubstitute_in_file_name
;
302 Lisp_Object Qdirectory_file_name
;
303 Lisp_Object Qfile_name_directory
;
304 Lisp_Object Qfile_name_nondirectory
;
305 Lisp_Object Qunhandled_file_name_directory
;
306 Lisp_Object Qfile_name_as_directory
;
307 Lisp_Object Qcopy_file
;
308 Lisp_Object Qmake_directory_internal
;
309 Lisp_Object Qmake_directory
;
310 Lisp_Object Qdelete_directory
;
311 Lisp_Object Qdelete_file
;
312 Lisp_Object Qrename_file
;
313 Lisp_Object Qadd_name_to_file
;
314 Lisp_Object Qmake_symbolic_link
;
315 Lisp_Object Qfile_exists_p
;
316 Lisp_Object Qfile_executable_p
;
317 Lisp_Object Qfile_readable_p
;
318 Lisp_Object Qfile_writable_p
;
319 Lisp_Object Qfile_symlink_p
;
320 Lisp_Object Qaccess_file
;
321 Lisp_Object Qfile_directory_p
;
322 Lisp_Object Qfile_regular_p
;
323 Lisp_Object Qfile_accessible_directory_p
;
324 Lisp_Object Qfile_modes
;
325 Lisp_Object Qset_file_modes
;
326 Lisp_Object Qfile_newer_than_file_p
;
327 Lisp_Object Qinsert_file_contents
;
328 Lisp_Object Qwrite_region
;
329 Lisp_Object Qverify_visited_file_modtime
;
330 Lisp_Object Qset_visited_file_modtime
;
332 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
333 "Return FILENAME's handler function for OPERATION, if it has one.\n\
334 Otherwise, return nil.\n\
335 A file name is handled if one of the regular expressions in\n\
336 `file-name-handler-alist' matches it.\n\n\
337 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
338 any handlers that are members of `inhibit-file-name-handlers',\n\
339 but we still do run any other handlers. This lets handlers\n\
340 use the standard functions without calling themselves recursively.")
341 (filename
, operation
)
342 Lisp_Object filename
, operation
;
344 /* This function must not munge the match data. */
345 Lisp_Object chain
, inhibited_handlers
;
347 CHECK_STRING (filename
, 0);
349 if (EQ (operation
, Vinhibit_file_name_operation
))
350 inhibited_handlers
= Vinhibit_file_name_handlers
;
352 inhibited_handlers
= Qnil
;
354 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
355 chain
= XCDR (chain
))
363 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
365 Lisp_Object handler
, tem
;
367 handler
= XCDR (elt
);
368 tem
= Fmemq (handler
, inhibited_handlers
);
379 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
381 "Return the directory component in file name FILENAME.\n\
382 Return nil if FILENAME does not include a directory.\n\
383 Otherwise return a directory spec.\n\
384 Given a Unix syntax file name, returns a string ending in slash;\n\
385 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
387 Lisp_Object filename
;
389 register unsigned char *beg
;
390 register unsigned char *p
;
393 CHECK_STRING (filename
, 0);
395 /* If the file name has special constructs in it,
396 call the corresponding file handler. */
397 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
399 return call2 (handler
, Qfile_name_directory
, filename
);
401 filename
= FILE_SYSTEM_CASE (filename
);
402 beg
= XSTRING (filename
)->data
;
404 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
406 p
= beg
+ STRING_BYTES (XSTRING (filename
));
408 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
410 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
413 /* only recognise drive specifier at the beginning */
415 /* handle the "/:d:foo" and "/:foo" cases correctly */
416 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
417 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
424 /* Expansion of "c:" to drive and default directory. */
427 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
428 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
429 unsigned char *r
= res
;
431 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
433 strncpy (res
, beg
, 2);
438 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
440 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
443 p
= beg
+ strlen (beg
);
446 CORRECT_DIR_SEPS (beg
);
449 if (STRING_MULTIBYTE (filename
))
450 return make_string (beg
, p
- beg
);
451 return make_unibyte_string (beg
, p
- beg
);
454 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
455 Sfile_name_nondirectory
, 1, 1, 0,
456 "Return file name FILENAME sans its directory.\n\
457 For example, in a Unix-syntax file name,\n\
458 this is everything after the last slash,\n\
459 or the entire name if it contains no slash.")
461 Lisp_Object filename
;
463 register unsigned char *beg
, *p
, *end
;
466 CHECK_STRING (filename
, 0);
468 /* If the file name has special constructs in it,
469 call the corresponding file handler. */
470 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
472 return call2 (handler
, Qfile_name_nondirectory
, filename
);
474 beg
= XSTRING (filename
)->data
;
475 end
= p
= beg
+ STRING_BYTES (XSTRING (filename
));
477 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
479 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
482 /* only recognise drive specifier at beginning */
484 /* handle the "/:d:foo" case correctly */
485 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
490 if (STRING_MULTIBYTE (filename
))
491 return make_string (p
, end
- p
);
492 return make_unibyte_string (p
, end
- p
);
495 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
496 Sunhandled_file_name_directory
, 1, 1, 0,
497 "Return a directly usable directory name somehow associated with FILENAME.\n\
498 A `directly usable' directory name is one that may be used without the\n\
499 intervention of any file handler.\n\
500 If FILENAME is a directly usable file itself, return\n\
501 \(file-name-directory FILENAME).\n\
502 The `call-process' and `start-process' functions use this function to\n\
503 get a current directory to run processes in.")
505 Lisp_Object filename
;
509 /* If the file name has special constructs in it,
510 call the corresponding file handler. */
511 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
513 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
515 return Ffile_name_directory (filename
);
520 file_name_as_directory (out
, in
)
523 int size
= strlen (in
) - 1;
536 /* Is it already a directory string? */
537 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
539 /* Is it a VMS directory file name? If so, hack VMS syntax. */
540 else if (! index (in
, '/')
541 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
542 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
543 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
544 || ! strncmp (&in
[size
- 5], ".dir", 4))
545 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
546 && in
[size
] == '1')))
548 register char *p
, *dot
;
552 dir:x.dir --> dir:[x]
553 dir:[x]y.dir --> dir:[x.y] */
555 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
558 strncpy (out
, in
, p
- in
);
577 dot
= index (p
, '.');
580 /* blindly remove any extension */
581 size
= strlen (out
) + (dot
- p
);
582 strncat (out
, p
, dot
- p
);
593 /* For Unix syntax, Append a slash if necessary */
594 if (!IS_DIRECTORY_SEP (out
[size
]))
596 out
[size
+ 1] = DIRECTORY_SEP
;
597 out
[size
+ 2] = '\0';
600 CORRECT_DIR_SEPS (out
);
606 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
607 Sfile_name_as_directory
, 1, 1, 0,
608 "Return a string representing file FILENAME interpreted as a directory.\n\
609 This operation exists because a directory is also a file, but its name as\n\
610 a directory is different from its name as a file.\n\
611 The result can be used as the value of `default-directory'\n\
612 or passed as second argument to `expand-file-name'.\n\
613 For a Unix-syntax file name, just appends a slash.\n\
614 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
621 CHECK_STRING (file
, 0);
625 /* If the file name has special constructs in it,
626 call the corresponding file handler. */
627 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
629 return call2 (handler
, Qfile_name_as_directory
, file
);
631 buf
= (char *) alloca (STRING_BYTES (XSTRING (file
)) + 10);
632 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
636 * Convert from directory name to filename.
638 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
639 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
640 * On UNIX, it's simple: just make sure there isn't a terminating /
642 * Value is nonzero if the string output is different from the input.
646 directory_file_name (src
, dst
)
654 struct FAB fab
= cc$rms_fab
;
655 struct NAM nam
= cc$rms_nam
;
656 char esa
[NAM$C_MAXRSS
];
661 if (! index (src
, '/')
662 && (src
[slen
- 1] == ']'
663 || src
[slen
- 1] == ':'
664 || src
[slen
- 1] == '>'))
666 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
668 fab
.fab$b_fns
= slen
;
669 fab
.fab$l_nam
= &nam
;
670 fab
.fab$l_fop
= FAB$M_NAM
;
673 nam
.nam$b_ess
= sizeof esa
;
674 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
676 /* We call SYS$PARSE to handle such things as [--] for us. */
677 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
679 slen
= nam
.nam$b_esl
;
680 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
685 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
687 /* what about when we have logical_name:???? */
688 if (src
[slen
- 1] == ':')
689 { /* Xlate logical name and see what we get */
690 ptr
= strcpy (dst
, src
); /* upper case for getenv */
693 if ('a' <= *ptr
&& *ptr
<= 'z')
697 dst
[slen
- 1] = 0; /* remove colon */
698 if (!(src
= egetenv (dst
)))
700 /* should we jump to the beginning of this procedure?
701 Good points: allows us to use logical names that xlate
703 Bad points: can be a problem if we just translated to a device
705 For now, I'll punt and always expect VMS names, and hope for
708 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
709 { /* no recursion here! */
715 { /* not a directory spec */
720 bracket
= src
[slen
- 1];
722 /* If bracket is ']' or '>', bracket - 2 is the corresponding
724 ptr
= index (src
, bracket
- 2);
726 { /* no opening bracket */
730 if (!(rptr
= rindex (src
, '.')))
733 strncpy (dst
, src
, slen
);
737 dst
[slen
++] = bracket
;
742 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
743 then translate the device and recurse. */
744 if (dst
[slen
- 1] == ':'
745 && dst
[slen
- 2] != ':' /* skip decnet nodes */
746 && strcmp (src
+ slen
, "[000000]") == 0)
748 dst
[slen
- 1] = '\0';
749 if ((ptr
= egetenv (dst
))
750 && (rlen
= strlen (ptr
) - 1) > 0
751 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
752 && ptr
[rlen
- 1] == '.')
754 char * buf
= (char *) alloca (strlen (ptr
) + 1);
758 return directory_file_name (buf
, dst
);
763 strcat (dst
, "[000000]");
767 rlen
= strlen (rptr
) - 1;
768 strncat (dst
, rptr
, rlen
);
769 dst
[slen
+ rlen
] = '\0';
770 strcat (dst
, ".DIR.1");
774 /* Process as Unix format: just remove any final slash.
775 But leave "/" unchanged; do not change it to "". */
778 /* Handle // as root for apollo's. */
779 if ((slen
> 2 && dst
[slen
- 1] == '/')
780 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
784 && IS_DIRECTORY_SEP (dst
[slen
- 1])
786 && !IS_ANY_SEP (dst
[slen
- 2])
792 CORRECT_DIR_SEPS (dst
);
797 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
799 "Returns the file name of the directory named DIRECTORY.\n\
800 This is the name of the file that holds the data for the directory DIRECTORY.\n\
801 This operation exists because a directory is also a file, but its name as\n\
802 a directory is different from its name as a file.\n\
803 In Unix-syntax, this function just removes the final slash.\n\
804 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
805 it returns a file name such as \"[X]Y.DIR.1\".")
807 Lisp_Object directory
;
812 CHECK_STRING (directory
, 0);
814 if (NILP (directory
))
817 /* If the file name has special constructs in it,
818 call the corresponding file handler. */
819 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
821 return call2 (handler
, Qdirectory_file_name
, directory
);
824 /* 20 extra chars is insufficient for VMS, since we might perform a
825 logical name translation. an equivalence string can be up to 255
826 chars long, so grab that much extra space... - sss */
827 buf
= (char *) alloca (STRING_BYTES (XSTRING (directory
)) + 20 + 255);
829 buf
= (char *) alloca (STRING_BYTES (XSTRING (directory
)) + 20);
831 directory_file_name (XSTRING (directory
)->data
, buf
);
832 return build_string (buf
);
835 static char make_temp_name_tbl
[64] =
837 'A','B','C','D','E','F','G','H',
838 'I','J','K','L','M','N','O','P',
839 'Q','R','S','T','U','V','W','X',
840 'Y','Z','a','b','c','d','e','f',
841 'g','h','i','j','k','l','m','n',
842 'o','p','q','r','s','t','u','v',
843 'w','x','y','z','0','1','2','3',
844 '4','5','6','7','8','9','-','_'
847 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
849 /* Value is a temporary file name starting with PREFIX, a string.
851 The Emacs process number forms part of the result, so there is
852 no danger of generating a name being used by another process.
853 In addition, this function makes an attempt to choose a name
854 which has no existing file. To make this work, PREFIX should be
855 an absolute file name.
857 BASE64_P non-zero means add the pid as 3 characters in base64
858 encoding. In this case, 6 characters will be added to PREFIX to
859 form the file name. Otherwise, if Emacs is running on a system
860 with long file names, add the pid as a decimal number.
862 This function signals an error if no unique file name could be
866 make_temp_name (prefix
, base64_p
)
873 unsigned char *p
, *data
;
877 CHECK_STRING (prefix
, 0);
879 /* VAL is created by adding 6 characters to PREFIX. The first
880 three are the PID of this process, in base 64, and the second
881 three are incremented if the file already exists. This ensures
882 262144 unique file names per PID per PREFIX. */
884 pid
= (int) getpid ();
888 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
889 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
890 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
895 #ifdef HAVE_LONG_FILE_NAMES
896 sprintf (pidbuf
, "%d", pid
);
897 pidlen
= strlen (pidbuf
);
899 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
900 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
901 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
906 len
= XSTRING (prefix
)->size
;
907 val
= make_uninit_string (len
+ 3 + pidlen
);
908 data
= XSTRING (val
)->data
;
909 bcopy(XSTRING (prefix
)->data
, data
, len
);
912 bcopy (pidbuf
, p
, pidlen
);
915 /* Here we try to minimize useless stat'ing when this function is
916 invoked many times successively with the same PREFIX. We achieve
917 this by initializing count to a random value, and incrementing it
920 We don't want make-temp-name to be called while dumping,
921 because then make_temp_name_count_initialized_p would get set
922 and then make_temp_name_count would not be set when Emacs starts. */
924 if (!make_temp_name_count_initialized_p
)
926 make_temp_name_count
= (unsigned) time (NULL
);
927 make_temp_name_count_initialized_p
= 1;
933 unsigned num
= make_temp_name_count
;
935 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
936 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
937 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
939 /* Poor man's congruential RN generator. Replace with
940 ++make_temp_name_count for debugging. */
941 make_temp_name_count
+= 25229;
942 make_temp_name_count
%= 225307;
944 if (stat (data
, &ignored
) < 0)
946 /* We want to return only if errno is ENOENT. */
950 /* The error here is dubious, but there is little else we
951 can do. The alternatives are to return nil, which is
952 as bad as (and in many cases worse than) throwing the
953 error, or to ignore the error, which will likely result
954 in looping through 225307 stat's, which is not only
955 dog-slow, but also useless since it will fallback to
956 the errow below, anyway. */
957 report_file_error ("Cannot create temporary name for prefix",
958 Fcons (prefix
, Qnil
));
963 error ("Cannot create temporary name for prefix `%s'",
964 XSTRING (prefix
)->data
);
969 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
970 "Generate temporary file name (string) starting with PREFIX (a string).\n\
971 The Emacs process number forms part of the result,\n\
972 so there is no danger of generating a name being used by another process.\n\
974 In addition, this function makes an attempt to choose a name\n\
975 which has no existing file. To make this work,\n\
976 PREFIX should be an absolute file name.\n\
978 There is a race condition between calling `make-temp-name' and creating the\n\
979 file which opens all kinds of security holes. For that reason, you should\n\
980 probably use `make-temp-file' instead.")
984 return make_temp_name (prefix
, 0);
989 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
990 "Convert filename NAME to absolute, and canonicalize it.\n\
991 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative\n\
992 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,\n\
993 the current buffer's value of default-directory is used.\n\
994 File name components that are `.' are removed, and \n\
995 so are file name components followed by `..', along with the `..' itself;\n\
996 note that these simplifications are done without checking the resulting\n\
997 file names in the file system.\n\
998 An initial `~/' expands to your home directory.\n\
999 An initial `~USER/' expands to USER's home directory.\n\
1000 See also the function `substitute-in-file-name'.")
1001 (name
, default_directory
)
1002 Lisp_Object name
, default_directory
;
1006 register unsigned char *newdir
, *p
, *o
;
1008 unsigned char *target
;
1011 unsigned char * colon
= 0;
1012 unsigned char * close
= 0;
1013 unsigned char * slash
= 0;
1014 unsigned char * brack
= 0;
1015 int lbrack
= 0, rbrack
= 0;
1020 int collapse_newdir
= 1;
1024 Lisp_Object handler
;
1026 CHECK_STRING (name
, 0);
1028 /* If the file name has special constructs in it,
1029 call the corresponding file handler. */
1030 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1031 if (!NILP (handler
))
1032 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1034 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1035 if (NILP (default_directory
))
1036 default_directory
= current_buffer
->directory
;
1037 if (! STRINGP (default_directory
))
1038 default_directory
= build_string ("/");
1040 if (!NILP (default_directory
))
1042 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1043 if (!NILP (handler
))
1044 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1047 o
= XSTRING (default_directory
)->data
;
1049 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1050 It would be better to do this down below where we actually use
1051 default_directory. Unfortunately, calling Fexpand_file_name recursively
1052 could invoke GC, and the strings might be relocated. This would
1053 be annoying because we have pointers into strings lying around
1054 that would need adjusting, and people would add new pointers to
1055 the code and forget to adjust them, resulting in intermittent bugs.
1056 Putting this call here avoids all that crud.
1058 The EQ test avoids infinite recursion. */
1059 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1060 /* Save time in some common cases - as long as default_directory
1061 is not relative, it can be canonicalized with name below (if it
1062 is needed at all) without requiring it to be expanded now. */
1064 /* Detect MSDOS file names with drive specifiers. */
1065 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1067 /* Detect Windows file names in UNC format. */
1068 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1070 #else /* not DOS_NT */
1071 /* Detect Unix absolute file names (/... alone is not absolute on
1073 && ! (IS_DIRECTORY_SEP (o
[0]))
1074 #endif /* not DOS_NT */
1077 struct gcpro gcpro1
;
1080 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1084 name
= FILE_SYSTEM_CASE (name
);
1085 nm
= XSTRING (name
)->data
;
1088 /* We will force directory separators to be either all \ or /, so make
1089 a local copy to modify, even if there ends up being no change. */
1090 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1092 /* Note if special escape prefix is present, but remove for now. */
1093 if (nm
[0] == '/' && nm
[1] == ':')
1099 /* Find and remove drive specifier if present; this makes nm absolute
1100 even if the rest of the name appears to be relative. Only look for
1101 drive specifier at the beginning. */
1102 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1109 /* If we see "c://somedir", we want to strip the first slash after the
1110 colon when stripping the drive letter. Otherwise, this expands to
1112 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1114 #endif /* WINDOWSNT */
1118 /* Discard any previous drive specifier if nm is now in UNC format. */
1119 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1125 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1126 none are found, we can probably return right away. We will avoid
1127 allocating a new string if name is already fully expanded. */
1129 IS_DIRECTORY_SEP (nm
[0])
1131 && drive
&& !is_escaped
1134 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1141 /* If it turns out that the filename we want to return is just a
1142 suffix of FILENAME, we don't need to go through and edit
1143 things; we just need to construct a new string using data
1144 starting at the middle of FILENAME. If we set lose to a
1145 non-zero value, that means we've discovered that we can't do
1152 /* Since we know the name is absolute, we can assume that each
1153 element starts with a "/". */
1155 /* "." and ".." are hairy. */
1156 if (IS_DIRECTORY_SEP (p
[0])
1158 && (IS_DIRECTORY_SEP (p
[2])
1160 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1163 /* We want to replace multiple `/' in a row with a single
1166 && IS_DIRECTORY_SEP (p
[0])
1167 && IS_DIRECTORY_SEP (p
[1]))
1174 /* if dev:[dir]/, move nm to / */
1175 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1176 nm
= (brack
? brack
+ 1 : colon
+ 1);
1177 lbrack
= rbrack
= 0;
1184 #ifdef NO_HYPHENS_IN_FILENAMES
1185 if (lbrack
== rbrack
)
1187 /* Avoid clobbering negative version numbers. */
1192 #endif /* NO_HYPHENS_IN_FILENAMES */
1193 if (lbrack
> rbrack
&&
1194 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1195 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1197 #ifdef NO_HYPHENS_IN_FILENAMES
1200 #endif /* NO_HYPHENS_IN_FILENAMES */
1201 /* count open brackets, reset close bracket pointer */
1202 if (p
[0] == '[' || p
[0] == '<')
1203 lbrack
++, brack
= 0;
1204 /* count close brackets, set close bracket pointer */
1205 if (p
[0] == ']' || p
[0] == '>')
1206 rbrack
++, brack
= p
;
1207 /* detect ][ or >< */
1208 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1210 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1211 nm
= p
+ 1, lose
= 1;
1212 if (p
[0] == ':' && (colon
|| slash
))
1213 /* if dev1:[dir]dev2:, move nm to dev2: */
1219 /* if /name/dev:, move nm to dev: */
1222 /* if node::dev:, move colon following dev */
1223 else if (colon
&& colon
[-1] == ':')
1225 /* if dev1:dev2:, move nm to dev2: */
1226 else if (colon
&& colon
[-1] != ':')
1231 if (p
[0] == ':' && !colon
)
1237 if (lbrack
== rbrack
)
1240 else if (p
[0] == '.')
1248 if (index (nm
, '/'))
1249 return build_string (sys_translate_unix (nm
));
1252 /* Make sure directories are all separated with / or \ as
1253 desired, but avoid allocation of a new string when not
1255 CORRECT_DIR_SEPS (nm
);
1257 if (IS_DIRECTORY_SEP (nm
[1]))
1259 if (strcmp (nm
, XSTRING (name
)->data
) != 0)
1260 name
= build_string (nm
);
1264 /* drive must be set, so this is okay */
1265 if (strcmp (nm
- 2, XSTRING (name
)->data
) != 0)
1267 name
= make_string (nm
- 2, p
- nm
+ 2);
1268 XSTRING (name
)->data
[0] = DRIVE_LETTER (drive
);
1269 XSTRING (name
)->data
[1] = ':';
1272 #else /* not DOS_NT */
1273 if (nm
== XSTRING (name
)->data
)
1275 return build_string (nm
);
1276 #endif /* not DOS_NT */
1280 /* At this point, nm might or might not be an absolute file name. We
1281 need to expand ~ or ~user if present, otherwise prefix nm with
1282 default_directory if nm is not absolute, and finally collapse /./
1283 and /foo/../ sequences.
1285 We set newdir to be the appropriate prefix if one is needed:
1286 - the relevant user directory if nm starts with ~ or ~user
1287 - the specified drive's working dir (DOS/NT only) if nm does not
1289 - the value of default_directory.
1291 Note that these prefixes are not guaranteed to be absolute (except
1292 for the working dir of a drive). Therefore, to ensure we always
1293 return an absolute name, if the final prefix is not absolute we
1294 append it to the current working directory. */
1298 if (nm
[0] == '~') /* prefix ~ */
1300 if (IS_DIRECTORY_SEP (nm
[1])
1304 || nm
[1] == 0) /* ~ by itself */
1306 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1307 newdir
= (unsigned char *) "";
1310 collapse_newdir
= 0;
1313 nm
++; /* Don't leave the slash in nm. */
1316 else /* ~user/filename */
1318 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1323 o
= (unsigned char *) alloca (p
- nm
+ 1);
1324 bcopy ((char *) nm
, o
, p
- nm
);
1327 pw
= (struct passwd
*) getpwnam (o
+ 1);
1330 newdir
= (unsigned char *) pw
-> pw_dir
;
1332 nm
= p
+ 1; /* skip the terminator */
1336 collapse_newdir
= 0;
1341 /* If we don't find a user of that name, leave the name
1342 unchanged; don't move nm forward to p. */
1347 /* On DOS and Windows, nm is absolute if a drive name was specified;
1348 use the drive's current directory as the prefix if needed. */
1349 if (!newdir
&& drive
)
1351 /* Get default directory if needed to make nm absolute. */
1352 if (!IS_DIRECTORY_SEP (nm
[0]))
1354 newdir
= alloca (MAXPATHLEN
+ 1);
1355 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1360 /* Either nm starts with /, or drive isn't mounted. */
1361 newdir
= alloca (4);
1362 newdir
[0] = DRIVE_LETTER (drive
);
1370 /* Finally, if no prefix has been specified and nm is not absolute,
1371 then it must be expanded relative to default_directory. */
1375 /* /... alone is not absolute on DOS and Windows. */
1376 && !IS_DIRECTORY_SEP (nm
[0])
1379 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1386 newdir
= XSTRING (default_directory
)->data
;
1388 /* Note if special escape prefix is present, but remove for now. */
1389 if (newdir
[0] == '/' && newdir
[1] == ':')
1400 /* First ensure newdir is an absolute name. */
1402 /* Detect MSDOS file names with drive specifiers. */
1403 ! (IS_DRIVE (newdir
[0])
1404 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1406 /* Detect Windows file names in UNC format. */
1407 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1411 /* Effectively, let newdir be (expand-file-name newdir cwd).
1412 Because of the admonition against calling expand-file-name
1413 when we have pointers into lisp strings, we accomplish this
1414 indirectly by prepending newdir to nm if necessary, and using
1415 cwd (or the wd of newdir's drive) as the new newdir. */
1417 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1422 if (!IS_DIRECTORY_SEP (nm
[0]))
1424 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1425 file_name_as_directory (tmp
, newdir
);
1429 newdir
= alloca (MAXPATHLEN
+ 1);
1432 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1439 /* Strip off drive name from prefix, if present. */
1440 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1446 /* Keep only a prefix from newdir if nm starts with slash
1447 (//server/share for UNC, nothing otherwise). */
1448 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1451 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1453 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1455 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1457 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1469 /* Get rid of any slash at the end of newdir, unless newdir is
1470 just / or // (an incomplete UNC name). */
1471 length
= strlen (newdir
);
1472 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1474 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1478 unsigned char *temp
= (unsigned char *) alloca (length
);
1479 bcopy (newdir
, temp
, length
- 1);
1480 temp
[length
- 1] = 0;
1488 /* Now concatenate the directory and name to new space in the stack frame */
1489 tlen
+= strlen (nm
) + 1;
1491 /* Reserve space for drive specifier and escape prefix, since either
1492 or both may need to be inserted. (The Microsoft x86 compiler
1493 produces incorrect code if the following two lines are combined.) */
1494 target
= (unsigned char *) alloca (tlen
+ 4);
1496 #else /* not DOS_NT */
1497 target
= (unsigned char *) alloca (tlen
);
1498 #endif /* not DOS_NT */
1504 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1507 /* If newdir is effectively "C:/", then the drive letter will have
1508 been stripped and newdir will be "/". Concatenating with an
1509 absolute directory in nm produces "//", which will then be
1510 incorrectly treated as a network share. Ignore newdir in
1511 this case (keeping the drive letter). */
1512 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1513 && newdir
[1] == '\0'))
1515 strcpy (target
, newdir
);
1519 file_name_as_directory (target
, newdir
);
1522 strcat (target
, nm
);
1524 if (index (target
, '/'))
1525 strcpy (target
, sys_translate_unix (target
));
1528 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1530 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1539 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1545 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1546 /* brackets are offset from each other by 2 */
1549 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1550 /* convert [foo][bar] to [bar] */
1551 while (o
[-1] != '[' && o
[-1] != '<')
1553 else if (*p
== '-' && *o
!= '.')
1556 else if (p
[0] == '-' && o
[-1] == '.' &&
1557 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1558 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1562 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1563 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1565 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1567 /* else [foo.-] ==> [-] */
1571 #ifdef NO_HYPHENS_IN_FILENAMES
1573 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1574 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1576 #endif /* NO_HYPHENS_IN_FILENAMES */
1580 if (!IS_DIRECTORY_SEP (*p
))
1584 else if (IS_DIRECTORY_SEP (p
[0])
1586 && (IS_DIRECTORY_SEP (p
[2])
1589 /* If "/." is the entire filename, keep the "/". Otherwise,
1590 just delete the whole "/.". */
1591 if (o
== target
&& p
[2] == '\0')
1595 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1596 /* `/../' is the "superroot" on certain file systems. */
1598 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1600 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1602 /* Keep initial / only if this is the whole name. */
1603 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1608 && IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1]))
1610 /* Collapse multiple `/' in a row. */
1612 while (IS_DIRECTORY_SEP (*p
))
1619 #endif /* not VMS */
1623 /* At last, set drive name. */
1625 /* Except for network file name. */
1626 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1627 #endif /* WINDOWSNT */
1629 if (!drive
) abort ();
1631 target
[0] = DRIVE_LETTER (drive
);
1634 /* Reinsert the escape prefix if required. */
1641 CORRECT_DIR_SEPS (target
);
1644 return make_string (target
, o
- target
);
1648 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1649 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1650 "Convert FILENAME to absolute, and canonicalize it.\n\
1651 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1652 (does not start with slash); if DEFAULT is nil or missing,\n\
1653 the current buffer's value of default-directory is used.\n\
1654 Filenames containing `.' or `..' as components are simplified;\n\
1655 initial `~/' expands to your home directory.\n\
1656 See also the function `substitute-in-file-name'.")
1658 Lisp_Object name
, defalt
;
1662 register unsigned char *newdir
, *p
, *o
;
1664 unsigned char *target
;
1668 unsigned char * colon
= 0;
1669 unsigned char * close
= 0;
1670 unsigned char * slash
= 0;
1671 unsigned char * brack
= 0;
1672 int lbrack
= 0, rbrack
= 0;
1676 CHECK_STRING (name
, 0);
1679 /* Filenames on VMS are always upper case. */
1680 name
= Fupcase (name
);
1683 nm
= XSTRING (name
)->data
;
1685 /* If nm is absolute, flush ...// and detect /./ and /../.
1686 If no /./ or /../ we can return right away. */
1698 if (p
[0] == '/' && p
[1] == '/'
1700 /* // at start of filename is meaningful on Apollo system. */
1705 if (p
[0] == '/' && p
[1] == '~')
1706 nm
= p
+ 1, lose
= 1;
1707 if (p
[0] == '/' && p
[1] == '.'
1708 && (p
[2] == '/' || p
[2] == 0
1709 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1715 /* if dev:[dir]/, move nm to / */
1716 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1717 nm
= (brack
? brack
+ 1 : colon
+ 1);
1718 lbrack
= rbrack
= 0;
1726 /* VMS pre V4.4,convert '-'s in filenames. */
1727 if (lbrack
== rbrack
)
1729 if (dots
< 2) /* this is to allow negative version numbers */
1734 if (lbrack
> rbrack
&&
1735 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1736 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1742 /* count open brackets, reset close bracket pointer */
1743 if (p
[0] == '[' || p
[0] == '<')
1744 lbrack
++, brack
= 0;
1745 /* count close brackets, set close bracket pointer */
1746 if (p
[0] == ']' || p
[0] == '>')
1747 rbrack
++, brack
= p
;
1748 /* detect ][ or >< */
1749 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1751 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1752 nm
= p
+ 1, lose
= 1;
1753 if (p
[0] == ':' && (colon
|| slash
))
1754 /* if dev1:[dir]dev2:, move nm to dev2: */
1760 /* If /name/dev:, move nm to dev: */
1763 /* If node::dev:, move colon following dev */
1764 else if (colon
&& colon
[-1] == ':')
1766 /* If dev1:dev2:, move nm to dev2: */
1767 else if (colon
&& colon
[-1] != ':')
1772 if (p
[0] == ':' && !colon
)
1778 if (lbrack
== rbrack
)
1781 else if (p
[0] == '.')
1789 if (index (nm
, '/'))
1790 return build_string (sys_translate_unix (nm
));
1792 if (nm
== XSTRING (name
)->data
)
1794 return build_string (nm
);
1798 /* Now determine directory to start with and put it in NEWDIR */
1802 if (nm
[0] == '~') /* prefix ~ */
1807 || nm
[1] == 0)/* ~/filename */
1809 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1810 newdir
= (unsigned char *) "";
1813 nm
++; /* Don't leave the slash in nm. */
1816 else /* ~user/filename */
1818 /* Get past ~ to user */
1819 unsigned char *user
= nm
+ 1;
1820 /* Find end of name. */
1821 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1822 int len
= ptr
? ptr
- user
: strlen (user
);
1824 unsigned char *ptr1
= index (user
, ':');
1825 if (ptr1
!= 0 && ptr1
- user
< len
)
1828 /* Copy the user name into temp storage. */
1829 o
= (unsigned char *) alloca (len
+ 1);
1830 bcopy ((char *) user
, o
, len
);
1833 /* Look up the user name. */
1834 pw
= (struct passwd
*) getpwnam (o
+ 1);
1836 error ("\"%s\" isn't a registered user", o
+ 1);
1838 newdir
= (unsigned char *) pw
->pw_dir
;
1840 /* Discard the user name from NM. */
1847 #endif /* not VMS */
1851 defalt
= current_buffer
->directory
;
1852 CHECK_STRING (defalt
, 1);
1853 newdir
= XSTRING (defalt
)->data
;
1856 /* Now concatenate the directory and name to new space in the stack frame */
1858 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1859 target
= (unsigned char *) alloca (tlen
);
1865 if (nm
[0] == 0 || nm
[0] == '/')
1866 strcpy (target
, newdir
);
1869 file_name_as_directory (target
, newdir
);
1872 strcat (target
, nm
);
1874 if (index (target
, '/'))
1875 strcpy (target
, sys_translate_unix (target
));
1878 /* Now canonicalize by removing /. and /foo/.. if they appear */
1886 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1892 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1893 /* brackets are offset from each other by 2 */
1896 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1897 /* convert [foo][bar] to [bar] */
1898 while (o
[-1] != '[' && o
[-1] != '<')
1900 else if (*p
== '-' && *o
!= '.')
1903 else if (p
[0] == '-' && o
[-1] == '.' &&
1904 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1905 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1909 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1910 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1912 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1914 /* else [foo.-] ==> [-] */
1920 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1921 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1931 else if (!strncmp (p
, "//", 2)
1933 /* // at start of filename is meaningful in Apollo system. */
1941 else if (p
[0] == '/' && p
[1] == '.' &&
1942 (p
[2] == '/' || p
[2] == 0))
1944 else if (!strncmp (p
, "/..", 3)
1945 /* `/../' is the "superroot" on certain file systems. */
1947 && (p
[3] == '/' || p
[3] == 0))
1949 while (o
!= target
&& *--o
!= '/')
1952 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1956 if (o
== target
&& *o
== '/')
1964 #endif /* not VMS */
1967 return make_string (target
, o
- target
);
1971 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1972 Ssubstitute_in_file_name
, 1, 1, 0,
1973 "Substitute environment variables referred to in FILENAME.\n\
1974 `$FOO' where FOO is an environment variable name means to substitute\n\
1975 the value of that variable. The variable name should be terminated\n\
1976 with a character not a letter, digit or underscore; otherwise, enclose\n\
1977 the entire variable name in braces.\n\
1978 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1979 On VMS, `$' substitution is not done; this function does little and only\n\
1980 duplicates what `expand-file-name' does.")
1982 Lisp_Object filename
;
1986 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1987 unsigned char *target
= NULL
;
1989 int substituted
= 0;
1991 Lisp_Object handler
;
1993 CHECK_STRING (filename
, 0);
1995 /* If the file name has special constructs in it,
1996 call the corresponding file handler. */
1997 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1998 if (!NILP (handler
))
1999 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2001 nm
= XSTRING (filename
)->data
;
2003 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2004 CORRECT_DIR_SEPS (nm
);
2005 substituted
= (strcmp (nm
, XSTRING (filename
)->data
) != 0);
2007 endp
= nm
+ STRING_BYTES (XSTRING (filename
));
2009 /* If /~ or // appears, discard everything through first slash. */
2011 for (p
= nm
; p
!= endp
; p
++)
2014 #if defined (APOLLO) || defined (WINDOWSNT)
2015 /* // at start of file name is meaningful in Apollo and
2016 WindowsNT systems. */
2017 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
2018 #else /* not (APOLLO || WINDOWSNT) */
2019 || IS_DIRECTORY_SEP (p
[0])
2020 #endif /* not (APOLLO || WINDOWSNT) */
2025 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2027 || IS_DIRECTORY_SEP (p
[-1])))
2033 /* see comment in expand-file-name about drive specifiers */
2034 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2035 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
2044 return build_string (nm
);
2047 /* See if any variables are substituted into the string
2048 and find the total length of their values in `total' */
2050 for (p
= nm
; p
!= endp
;)
2060 /* "$$" means a single "$" */
2069 while (p
!= endp
&& *p
!= '}') p
++;
2070 if (*p
!= '}') goto missingclose
;
2076 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2080 /* Copy out the variable name */
2081 target
= (unsigned char *) alloca (s
- o
+ 1);
2082 strncpy (target
, o
, s
- o
);
2085 strupr (target
); /* $home == $HOME etc. */
2088 /* Get variable value */
2089 o
= (unsigned char *) egetenv (target
);
2090 if (!o
) goto badvar
;
2091 total
+= strlen (o
);
2098 /* If substitution required, recopy the string and do it */
2099 /* Make space in stack frame for the new copy */
2100 xnm
= (unsigned char *) alloca (STRING_BYTES (XSTRING (filename
)) + total
+ 1);
2103 /* Copy the rest of the name through, replacing $ constructs with values */
2120 while (p
!= endp
&& *p
!= '}') p
++;
2121 if (*p
!= '}') goto missingclose
;
2127 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2131 /* Copy out the variable name */
2132 target
= (unsigned char *) alloca (s
- o
+ 1);
2133 strncpy (target
, o
, s
- o
);
2136 strupr (target
); /* $home == $HOME etc. */
2139 /* Get variable value */
2140 o
= (unsigned char *) egetenv (target
);
2144 if (STRING_MULTIBYTE (filename
))
2146 /* If the original string is multibyte,
2147 convert what we substitute into multibyte. */
2150 int c
= unibyte_char_to_multibyte (*o
++);
2151 x
+= CHAR_STRING (c
, x
);
2163 /* If /~ or // appears, discard everything through first slash. */
2165 for (p
= xnm
; p
!= x
; p
++)
2167 #if defined (APOLLO) || defined (WINDOWSNT)
2168 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2169 #else /* not (APOLLO || WINDOWSNT) */
2170 || IS_DIRECTORY_SEP (p
[0])
2171 #endif /* not (APOLLO || WINDOWSNT) */
2173 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2176 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2177 && p
> xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2181 if (STRING_MULTIBYTE (filename
))
2182 return make_string (xnm
, x
- xnm
);
2183 return make_unibyte_string (xnm
, x
- xnm
);
2186 error ("Bad format environment-variable substitution");
2188 error ("Missing \"}\" in environment-variable substitution");
2190 error ("Substituting nonexistent environment variable \"%s\"", target
);
2193 #endif /* not VMS */
2197 /* A slightly faster and more convenient way to get
2198 (directory-file-name (expand-file-name FOO)). */
2201 expand_and_dir_to_file (filename
, defdir
)
2202 Lisp_Object filename
, defdir
;
2204 register Lisp_Object absname
;
2206 absname
= Fexpand_file_name (filename
, defdir
);
2209 register int c
= XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
)) - 1];
2210 if (c
== ':' || c
== ']' || c
== '>')
2211 absname
= Fdirectory_file_name (absname
);
2214 /* Remove final slash, if any (unless this is the root dir).
2215 stat behaves differently depending! */
2216 if (XSTRING (absname
)->size
> 1
2217 && IS_DIRECTORY_SEP (XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
)) - 1])
2218 && !IS_DEVICE_SEP (XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
))-2]))
2219 /* We cannot take shortcuts; they might be wrong for magic file names. */
2220 absname
= Fdirectory_file_name (absname
);
2225 /* Signal an error if the file ABSNAME already exists.
2226 If INTERACTIVE is nonzero, ask the user whether to proceed,
2227 and bypass the error if the user says to go ahead.
2228 QUERYSTRING is a name for the action that is being considered
2231 *STATPTR is used to store the stat information if the file exists.
2232 If the file does not exist, STATPTR->st_mode is set to 0.
2233 If STATPTR is null, we don't store into it.
2235 If QUICK is nonzero, we ask for y or n, not yes or no. */
2238 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2239 Lisp_Object absname
;
2240 unsigned char *querystring
;
2242 struct stat
*statptr
;
2245 register Lisp_Object tem
, encoded_filename
;
2246 struct stat statbuf
;
2247 struct gcpro gcpro1
;
2249 encoded_filename
= ENCODE_FILE (absname
);
2251 /* stat is a good way to tell whether the file exists,
2252 regardless of what access permissions it has. */
2253 if (stat (XSTRING (encoded_filename
)->data
, &statbuf
) >= 0)
2256 Fsignal (Qfile_already_exists
,
2257 Fcons (build_string ("File already exists"),
2258 Fcons (absname
, Qnil
)));
2260 tem
= format1 ("File %s already exists; %s anyway? ",
2261 XSTRING (absname
)->data
, querystring
);
2263 tem
= Fy_or_n_p (tem
);
2265 tem
= do_yes_or_no_p (tem
);
2268 Fsignal (Qfile_already_exists
,
2269 Fcons (build_string ("File already exists"),
2270 Fcons (absname
, Qnil
)));
2277 statptr
->st_mode
= 0;
2282 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2283 "fCopy file: \nFCopy %s to file: \np\nP",
2284 "Copy FILE to NEWNAME. Both args must be strings.\n\
2285 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
2286 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
2287 A number as third arg means request confirmation if NEWNAME already exists.\n\
2288 This is what happens in interactive use with M-x.\n\
2289 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
2290 last-modified time as the old one. (This works on only some systems.)\n\
2291 A prefix arg makes KEEP-TIME non-nil.")
2292 (file
, newname
, ok_if_already_exists
, keep_time
)
2293 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2296 char buf
[16 * 1024];
2297 struct stat st
, out_st
;
2298 Lisp_Object handler
;
2299 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2300 int count
= specpdl_ptr
- specpdl
;
2301 int input_file_statable_p
;
2302 Lisp_Object encoded_file
, encoded_newname
;
2304 encoded_file
= encoded_newname
= Qnil
;
2305 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2306 CHECK_STRING (file
, 0);
2307 CHECK_STRING (newname
, 1);
2309 file
= Fexpand_file_name (file
, Qnil
);
2310 newname
= Fexpand_file_name (newname
, Qnil
);
2312 /* If the input file name has special constructs in it,
2313 call the corresponding file handler. */
2314 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2315 /* Likewise for output file name. */
2317 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2318 if (!NILP (handler
))
2319 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2320 ok_if_already_exists
, keep_time
));
2322 encoded_file
= ENCODE_FILE (file
);
2323 encoded_newname
= ENCODE_FILE (newname
);
2325 if (NILP (ok_if_already_exists
)
2326 || INTEGERP (ok_if_already_exists
))
2327 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2328 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2329 else if (stat (XSTRING (encoded_newname
)->data
, &out_st
) < 0)
2333 if (!CopyFile (XSTRING (encoded_file
)->data
,
2334 XSTRING (encoded_newname
)->data
,
2336 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2337 else if (NILP (keep_time
))
2343 EMACS_GET_TIME (now
);
2344 filename
= XSTRING (encoded_newname
)->data
;
2346 /* Ensure file is writable while its modified time is set. */
2347 attributes
= GetFileAttributes (filename
);
2348 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2349 if (set_file_times (filename
, now
, now
))
2351 /* Restore original attributes. */
2352 SetFileAttributes (filename
, attributes
);
2353 Fsignal (Qfile_date_error
,
2354 Fcons (build_string ("Cannot set file date"),
2355 Fcons (newname
, Qnil
)));
2357 /* Restore original attributes. */
2358 SetFileAttributes (filename
, attributes
);
2360 #else /* not WINDOWSNT */
2361 ifd
= emacs_open (XSTRING (encoded_file
)->data
, O_RDONLY
, 0);
2363 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2365 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2367 /* We can only copy regular files and symbolic links. Other files are not
2369 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2371 #if !defined (DOS_NT) || __DJGPP__ > 1
2372 if (out_st
.st_mode
!= 0
2373 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2376 report_file_error ("Input and output files are the same",
2377 Fcons (file
, Fcons (newname
, Qnil
)));
2381 #if defined (S_ISREG) && defined (S_ISLNK)
2382 if (input_file_statable_p
)
2384 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2386 #if defined (EISDIR)
2387 /* Get a better looking error message. */
2390 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2393 #endif /* S_ISREG && S_ISLNK */
2396 /* Create the copy file with the same record format as the input file */
2397 ofd
= sys_creat (XSTRING (encoded_newname
)->data
, 0666, ifd
);
2400 /* System's default file type was set to binary by _fmode in emacs.c. */
2401 ofd
= creat (XSTRING (encoded_newname
)->data
, S_IREAD
| S_IWRITE
);
2402 #else /* not MSDOS */
2403 ofd
= creat (XSTRING (encoded_newname
)->data
, 0666);
2404 #endif /* not MSDOS */
2407 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2409 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2413 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2414 if (emacs_write (ofd
, buf
, n
) != n
)
2415 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2418 /* Closing the output clobbers the file times on some systems. */
2419 if (emacs_close (ofd
) < 0)
2420 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2422 if (input_file_statable_p
)
2424 if (!NILP (keep_time
))
2426 EMACS_TIME atime
, mtime
;
2427 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2428 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2429 if (set_file_times (XSTRING (encoded_newname
)->data
,
2431 Fsignal (Qfile_date_error
,
2432 Fcons (build_string ("Cannot set file date"),
2433 Fcons (newname
, Qnil
)));
2436 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2438 #if defined (__DJGPP__) && __DJGPP__ > 1
2439 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2440 and if it can't, it tells so. Otherwise, under MSDOS we usually
2441 get only the READ bit, which will make the copied file read-only,
2442 so it's better not to chmod at all. */
2443 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2444 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2445 #endif /* DJGPP version 2 or newer */
2450 #endif /* WINDOWSNT */
2452 /* Discard the unwind protects. */
2453 specpdl_ptr
= specpdl
+ count
;
2459 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2460 Smake_directory_internal
, 1, 1, 0,
2461 "Create a new directory named DIRECTORY.")
2463 Lisp_Object directory
;
2466 Lisp_Object handler
;
2467 Lisp_Object encoded_dir
;
2469 CHECK_STRING (directory
, 0);
2470 directory
= Fexpand_file_name (directory
, Qnil
);
2472 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2473 if (!NILP (handler
))
2474 return call2 (handler
, Qmake_directory_internal
, directory
);
2476 encoded_dir
= ENCODE_FILE (directory
);
2478 dir
= XSTRING (encoded_dir
)->data
;
2481 if (mkdir (dir
) != 0)
2483 if (mkdir (dir
, 0777) != 0)
2485 report_file_error ("Creating directory", Flist (1, &directory
));
2490 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2491 "Delete the directory named DIRECTORY.")
2493 Lisp_Object directory
;
2496 Lisp_Object handler
;
2497 Lisp_Object encoded_dir
;
2499 CHECK_STRING (directory
, 0);
2500 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2502 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2503 if (!NILP (handler
))
2504 return call2 (handler
, Qdelete_directory
, directory
);
2506 encoded_dir
= ENCODE_FILE (directory
);
2508 dir
= XSTRING (encoded_dir
)->data
;
2510 if (rmdir (dir
) != 0)
2511 report_file_error ("Removing directory", Flist (1, &directory
));
2516 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2517 "Delete file named FILENAME.\n\
2518 If file has multiple names, it continues to exist with the other names.")
2520 Lisp_Object filename
;
2522 Lisp_Object handler
;
2523 Lisp_Object encoded_file
;
2525 CHECK_STRING (filename
, 0);
2526 filename
= Fexpand_file_name (filename
, Qnil
);
2528 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2529 if (!NILP (handler
))
2530 return call2 (handler
, Qdelete_file
, filename
);
2532 encoded_file
= ENCODE_FILE (filename
);
2534 if (0 > unlink (XSTRING (encoded_file
)->data
))
2535 report_file_error ("Removing old name", Flist (1, &filename
));
2540 internal_delete_file_1 (ignore
)
2546 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2549 internal_delete_file (filename
)
2550 Lisp_Object filename
;
2552 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2553 Qt
, internal_delete_file_1
));
2556 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2557 "fRename file: \nFRename %s to file: \np",
2558 "Rename FILE as NEWNAME. Both args strings.\n\
2559 If file has names other than FILE, it continues to have those names.\n\
2560 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2561 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2562 A number as third arg means request confirmation if NEWNAME already exists.\n\
2563 This is what happens in interactive use with M-x.")
2564 (file
, newname
, ok_if_already_exists
)
2565 Lisp_Object file
, newname
, ok_if_already_exists
;
2568 Lisp_Object args
[2];
2570 Lisp_Object handler
;
2571 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2572 Lisp_Object encoded_file
, encoded_newname
;
2574 encoded_file
= encoded_newname
= Qnil
;
2575 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2576 CHECK_STRING (file
, 0);
2577 CHECK_STRING (newname
, 1);
2578 file
= Fexpand_file_name (file
, Qnil
);
2579 newname
= Fexpand_file_name (newname
, Qnil
);
2581 /* If the file name has special constructs in it,
2582 call the corresponding file handler. */
2583 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2585 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2586 if (!NILP (handler
))
2587 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2588 file
, newname
, ok_if_already_exists
));
2590 encoded_file
= ENCODE_FILE (file
);
2591 encoded_newname
= ENCODE_FILE (newname
);
2594 /* If the file names are identical but for the case, don't ask for
2595 confirmation: they simply want to change the letter-case of the
2597 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2599 if (NILP (ok_if_already_exists
)
2600 || INTEGERP (ok_if_already_exists
))
2601 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2602 INTEGERP (ok_if_already_exists
), 0, 0);
2604 if (0 > rename (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2606 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
)
2607 || 0 > unlink (XSTRING (encoded_file
)->data
))
2612 Fcopy_file (file
, newname
,
2613 /* We have already prompted if it was an integer,
2614 so don't have copy-file prompt again. */
2615 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2616 Fdelete_file (file
);
2623 report_file_error ("Renaming", Flist (2, args
));
2626 report_file_error ("Renaming", Flist (2, &file
));
2633 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2634 "fAdd name to file: \nFName to add to %s: \np",
2635 "Give FILE additional name NEWNAME. Both args strings.\n\
2636 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2637 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2638 A number as third arg means request confirmation if NEWNAME already exists.\n\
2639 This is what happens in interactive use with M-x.")
2640 (file
, newname
, ok_if_already_exists
)
2641 Lisp_Object file
, newname
, ok_if_already_exists
;
2644 Lisp_Object args
[2];
2646 Lisp_Object handler
;
2647 Lisp_Object encoded_file
, encoded_newname
;
2648 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2650 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2651 encoded_file
= encoded_newname
= Qnil
;
2652 CHECK_STRING (file
, 0);
2653 CHECK_STRING (newname
, 1);
2654 file
= Fexpand_file_name (file
, Qnil
);
2655 newname
= Fexpand_file_name (newname
, Qnil
);
2657 /* If the file name has special constructs in it,
2658 call the corresponding file handler. */
2659 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2660 if (!NILP (handler
))
2661 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2662 newname
, ok_if_already_exists
));
2664 /* If the new name has special constructs in it,
2665 call the corresponding file handler. */
2666 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2667 if (!NILP (handler
))
2668 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2669 newname
, ok_if_already_exists
));
2671 encoded_file
= ENCODE_FILE (file
);
2672 encoded_newname
= ENCODE_FILE (newname
);
2674 if (NILP (ok_if_already_exists
)
2675 || INTEGERP (ok_if_already_exists
))
2676 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2677 INTEGERP (ok_if_already_exists
), 0, 0);
2679 unlink (XSTRING (newname
)->data
);
2680 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2685 report_file_error ("Adding new name", Flist (2, args
));
2687 report_file_error ("Adding new name", Flist (2, &file
));
2696 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2697 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2698 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2699 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2700 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2701 A number as third arg means request confirmation if LINKNAME already exists.\n\
2702 This happens for interactive use with M-x.")
2703 (filename
, linkname
, ok_if_already_exists
)
2704 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2707 Lisp_Object args
[2];
2709 Lisp_Object handler
;
2710 Lisp_Object encoded_filename
, encoded_linkname
;
2711 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2713 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2714 encoded_filename
= encoded_linkname
= Qnil
;
2715 CHECK_STRING (filename
, 0);
2716 CHECK_STRING (linkname
, 1);
2717 /* If the link target has a ~, we must expand it to get
2718 a truly valid file name. Otherwise, do not expand;
2719 we want to permit links to relative file names. */
2720 if (XSTRING (filename
)->data
[0] == '~')
2721 filename
= Fexpand_file_name (filename
, Qnil
);
2722 linkname
= Fexpand_file_name (linkname
, Qnil
);
2724 /* If the file name has special constructs in it,
2725 call the corresponding file handler. */
2726 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2727 if (!NILP (handler
))
2728 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2729 linkname
, ok_if_already_exists
));
2731 /* If the new link name has special constructs in it,
2732 call the corresponding file handler. */
2733 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2734 if (!NILP (handler
))
2735 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2736 linkname
, ok_if_already_exists
));
2738 encoded_filename
= ENCODE_FILE (filename
);
2739 encoded_linkname
= ENCODE_FILE (linkname
);
2741 if (NILP (ok_if_already_exists
)
2742 || INTEGERP (ok_if_already_exists
))
2743 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2744 INTEGERP (ok_if_already_exists
), 0, 0);
2745 if (0 > symlink (XSTRING (encoded_filename
)->data
,
2746 XSTRING (encoded_linkname
)->data
))
2748 /* If we didn't complain already, silently delete existing file. */
2749 if (errno
== EEXIST
)
2751 unlink (XSTRING (encoded_linkname
)->data
);
2752 if (0 <= symlink (XSTRING (encoded_filename
)->data
,
2753 XSTRING (encoded_linkname
)->data
))
2763 report_file_error ("Making symbolic link", Flist (2, args
));
2765 report_file_error ("Making symbolic link", Flist (2, &filename
));
2771 #endif /* S_IFLNK */
2775 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2776 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2777 "Define the job-wide logical name NAME to have the value STRING.\n\
2778 If STRING is nil or a null string, the logical name NAME is deleted.")
2783 CHECK_STRING (name
, 0);
2785 delete_logical_name (XSTRING (name
)->data
);
2788 CHECK_STRING (string
, 1);
2790 if (XSTRING (string
)->size
== 0)
2791 delete_logical_name (XSTRING (name
)->data
);
2793 define_logical_name (XSTRING (name
)->data
, XSTRING (string
)->data
);
2802 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2803 "Open a network connection to PATH using LOGIN as the login string.")
2805 Lisp_Object path
, login
;
2809 CHECK_STRING (path
, 0);
2810 CHECK_STRING (login
, 0);
2812 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2814 if (netresult
== -1)
2819 #endif /* HPUX_NET */
2821 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2823 "Return t if file FILENAME specifies an absolute file name.\n\
2824 On Unix, this is a name starting with a `/' or a `~'.")
2826 Lisp_Object filename
;
2830 CHECK_STRING (filename
, 0);
2831 ptr
= XSTRING (filename
)->data
;
2832 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2834 /* ??? This criterion is probably wrong for '<'. */
2835 || index (ptr
, ':') || index (ptr
, '<')
2836 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2840 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2848 /* Return nonzero if file FILENAME exists and can be executed. */
2851 check_executable (filename
)
2855 int len
= strlen (filename
);
2858 if (stat (filename
, &st
) < 0)
2860 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2861 return ((st
.st_mode
& S_IEXEC
) != 0);
2863 return (S_ISREG (st
.st_mode
)
2865 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2866 || stricmp (suffix
, ".exe") == 0
2867 || stricmp (suffix
, ".bat") == 0)
2868 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2869 #endif /* not WINDOWSNT */
2870 #else /* not DOS_NT */
2871 #ifdef HAVE_EUIDACCESS
2872 return (euidaccess (filename
, 1) >= 0);
2874 /* Access isn't quite right because it uses the real uid
2875 and we really want to test with the effective uid.
2876 But Unix doesn't give us a right way to do it. */
2877 return (access (filename
, 1) >= 0);
2879 #endif /* not DOS_NT */
2882 /* Return nonzero if file FILENAME exists and can be written. */
2885 check_writable (filename
)
2890 if (stat (filename
, &st
) < 0)
2892 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2893 #else /* not MSDOS */
2894 #ifdef HAVE_EUIDACCESS
2895 return (euidaccess (filename
, 2) >= 0);
2897 /* Access isn't quite right because it uses the real uid
2898 and we really want to test with the effective uid.
2899 But Unix doesn't give us a right way to do it.
2900 Opening with O_WRONLY could work for an ordinary file,
2901 but would lose for directories. */
2902 return (access (filename
, 2) >= 0);
2904 #endif /* not MSDOS */
2907 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2908 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2909 See also `file-readable-p' and `file-attributes'.")
2911 Lisp_Object filename
;
2913 Lisp_Object absname
;
2914 Lisp_Object handler
;
2915 struct stat statbuf
;
2917 CHECK_STRING (filename
, 0);
2918 absname
= Fexpand_file_name (filename
, Qnil
);
2920 /* If the file name has special constructs in it,
2921 call the corresponding file handler. */
2922 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2923 if (!NILP (handler
))
2924 return call2 (handler
, Qfile_exists_p
, absname
);
2926 absname
= ENCODE_FILE (absname
);
2928 return (stat (XSTRING (absname
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2931 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2932 "Return t if FILENAME can be executed by you.\n\
2933 For a directory, this means you can access files in that directory.")
2935 Lisp_Object filename
;
2938 Lisp_Object absname
;
2939 Lisp_Object handler
;
2941 CHECK_STRING (filename
, 0);
2942 absname
= Fexpand_file_name (filename
, Qnil
);
2944 /* If the file name has special constructs in it,
2945 call the corresponding file handler. */
2946 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2947 if (!NILP (handler
))
2948 return call2 (handler
, Qfile_executable_p
, absname
);
2950 absname
= ENCODE_FILE (absname
);
2952 return (check_executable (XSTRING (absname
)->data
) ? Qt
: Qnil
);
2955 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2956 "Return t if file FILENAME exists and you can read it.\n\
2957 See also `file-exists-p' and `file-attributes'.")
2959 Lisp_Object filename
;
2961 Lisp_Object absname
;
2962 Lisp_Object handler
;
2965 struct stat statbuf
;
2967 CHECK_STRING (filename
, 0);
2968 absname
= Fexpand_file_name (filename
, Qnil
);
2970 /* If the file name has special constructs in it,
2971 call the corresponding file handler. */
2972 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2973 if (!NILP (handler
))
2974 return call2 (handler
, Qfile_readable_p
, absname
);
2976 absname
= ENCODE_FILE (absname
);
2978 #if defined(DOS_NT) || defined(macintosh)
2979 /* Under MS-DOS, Windows, and Macintosh, open does not work for
2981 if (access (XSTRING (absname
)->data
, 0) == 0)
2984 #else /* not DOS_NT and not macintosh */
2986 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2987 /* Opening a fifo without O_NONBLOCK can wait.
2988 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2989 except in the case of a fifo, on a system which handles it. */
2990 desc
= stat (XSTRING (absname
)->data
, &statbuf
);
2993 if (S_ISFIFO (statbuf
.st_mode
))
2994 flags
|= O_NONBLOCK
;
2996 desc
= emacs_open (XSTRING (absname
)->data
, flags
, 0);
3001 #endif /* not DOS_NT and not macintosh */
3004 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3006 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3007 "Return t if file FILENAME can be written or created by you.")
3009 Lisp_Object filename
;
3011 Lisp_Object absname
, dir
, encoded
;
3012 Lisp_Object handler
;
3013 struct stat statbuf
;
3015 CHECK_STRING (filename
, 0);
3016 absname
= Fexpand_file_name (filename
, Qnil
);
3018 /* If the file name has special constructs in it,
3019 call the corresponding file handler. */
3020 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3021 if (!NILP (handler
))
3022 return call2 (handler
, Qfile_writable_p
, absname
);
3024 encoded
= ENCODE_FILE (absname
);
3025 if (stat (XSTRING (encoded
)->data
, &statbuf
) >= 0)
3026 return (check_writable (XSTRING (encoded
)->data
)
3029 dir
= Ffile_name_directory (absname
);
3032 dir
= Fdirectory_file_name (dir
);
3036 dir
= Fdirectory_file_name (dir
);
3039 dir
= ENCODE_FILE (dir
);
3041 /* The read-only attribute of the parent directory doesn't affect
3042 whether a file or directory can be created within it. Some day we
3043 should check ACLs though, which do affect this. */
3044 if (stat (XSTRING (dir
)->data
, &statbuf
) < 0)
3046 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3048 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
3053 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3054 "Access file FILENAME, and get an error if that does not work.\n\
3055 The second argument STRING is used in the error message.\n\
3056 If there is no error, we return nil.")
3058 Lisp_Object filename
, string
;
3060 Lisp_Object handler
, encoded_filename
;
3063 CHECK_STRING (filename
, 0);
3064 CHECK_STRING (string
, 1);
3066 /* If the file name has special constructs in it,
3067 call the corresponding file handler. */
3068 handler
= Ffind_file_name_handler (filename
, Qaccess_file
);
3069 if (!NILP (handler
))
3070 return call3 (handler
, Qaccess_file
, filename
, string
);
3072 encoded_filename
= ENCODE_FILE (filename
);
3074 fd
= emacs_open (XSTRING (encoded_filename
)->data
, O_RDONLY
, 0);
3076 report_file_error (XSTRING (string
)->data
, Fcons (filename
, Qnil
));
3082 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3083 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
3084 The value is the name of the file to which it is linked.\n\
3085 Otherwise returns nil.")
3087 Lisp_Object filename
;
3094 Lisp_Object handler
;
3096 CHECK_STRING (filename
, 0);
3097 filename
= Fexpand_file_name (filename
, Qnil
);
3099 /* If the file name has special constructs in it,
3100 call the corresponding file handler. */
3101 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3102 if (!NILP (handler
))
3103 return call2 (handler
, Qfile_symlink_p
, filename
);
3105 filename
= ENCODE_FILE (filename
);
3112 buf
= (char *) xrealloc (buf
, bufsize
);
3113 bzero (buf
, bufsize
);
3116 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
3120 /* HP-UX reports ERANGE if buffer is too small. */
3121 if (errno
== ERANGE
)
3131 while (valsize
>= bufsize
);
3133 val
= make_string (buf
, valsize
);
3134 if (buf
[0] == '/' && index (buf
, ':'))
3135 val
= concat2 (build_string ("/:"), val
);
3137 val
= DECODE_FILE (val
);
3139 #else /* not S_IFLNK */
3141 #endif /* not S_IFLNK */
3144 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3145 "Return t if FILENAME names an existing directory.\n\
3146 Symbolic links to directories count as directories.\n\
3147 See `file-symlink-p' to distinguish symlinks.")
3149 Lisp_Object filename
;
3151 register Lisp_Object absname
;
3153 Lisp_Object handler
;
3155 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3157 /* If the file name has special constructs in it,
3158 call the corresponding file handler. */
3159 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3160 if (!NILP (handler
))
3161 return call2 (handler
, Qfile_directory_p
, absname
);
3163 absname
= ENCODE_FILE (absname
);
3165 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3167 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3170 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3171 "Return t if file FILENAME is the name of a directory as a file,\n\
3172 and files in that directory can be opened by you. In order to use a\n\
3173 directory as a buffer's current directory, this predicate must return true.\n\
3174 A directory name spec may be given instead; then the value is t\n\
3175 if the directory so specified exists and really is a readable and\n\
3176 searchable directory.")
3178 Lisp_Object filename
;
3180 Lisp_Object handler
;
3182 struct gcpro gcpro1
;
3184 /* If the file name has special constructs in it,
3185 call the corresponding file handler. */
3186 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3187 if (!NILP (handler
))
3188 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3190 /* It's an unlikely combination, but yes we really do need to gcpro:
3191 Suppose that file-accessible-directory-p has no handler, but
3192 file-directory-p does have a handler; this handler causes a GC which
3193 relocates the string in `filename'; and finally file-directory-p
3194 returns non-nil. Then we would end up passing a garbaged string
3195 to file-executable-p. */
3197 tem
= (NILP (Ffile_directory_p (filename
))
3198 || NILP (Ffile_executable_p (filename
)));
3200 return tem
? Qnil
: Qt
;
3203 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3204 "Return t if file FILENAME is the name of a regular file.\n\
3205 This is the sort of file that holds an ordinary stream of data bytes.")
3207 Lisp_Object filename
;
3209 register Lisp_Object absname
;
3211 Lisp_Object handler
;
3213 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3215 /* If the file name has special constructs in it,
3216 call the corresponding file handler. */
3217 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3218 if (!NILP (handler
))
3219 return call2 (handler
, Qfile_regular_p
, absname
);
3221 absname
= ENCODE_FILE (absname
);
3226 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3228 /* Tell stat to use expensive method to get accurate info. */
3229 Vw32_get_true_file_attributes
= Qt
;
3230 result
= stat (XSTRING (absname
)->data
, &st
);
3231 Vw32_get_true_file_attributes
= tem
;
3235 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3238 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3240 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3244 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3245 "Return mode bits of file named FILENAME, as an integer.")
3247 Lisp_Object filename
;
3249 Lisp_Object absname
;
3251 Lisp_Object handler
;
3253 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3255 /* If the file name has special constructs in it,
3256 call the corresponding file handler. */
3257 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3258 if (!NILP (handler
))
3259 return call2 (handler
, Qfile_modes
, absname
);
3261 absname
= ENCODE_FILE (absname
);
3263 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3265 #if defined (MSDOS) && __DJGPP__ < 2
3266 if (check_executable (XSTRING (absname
)->data
))
3267 st
.st_mode
|= S_IEXEC
;
3268 #endif /* MSDOS && __DJGPP__ < 2 */
3270 return make_number (st
.st_mode
& 07777);
3273 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3274 "Set mode bits of file named FILENAME to MODE (an integer).\n\
3275 Only the 12 low bits of MODE are used.")
3277 Lisp_Object filename
, mode
;
3279 Lisp_Object absname
, encoded_absname
;
3280 Lisp_Object handler
;
3282 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3283 CHECK_NUMBER (mode
, 1);
3285 /* If the file name has special constructs in it,
3286 call the corresponding file handler. */
3287 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3288 if (!NILP (handler
))
3289 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3291 encoded_absname
= ENCODE_FILE (absname
);
3293 if (chmod (XSTRING (encoded_absname
)->data
, XINT (mode
)) < 0)
3294 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3299 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3300 "Set the file permission bits for newly created files.\n\
3301 The argument MODE should be an integer; only the low 9 bits are used.\n\
3302 This setting is inherited by subprocesses.")
3306 CHECK_NUMBER (mode
, 0);
3308 umask ((~ XINT (mode
)) & 0777);
3313 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3314 "Return the default file protection for created files.\n\
3315 The value is an integer.")
3321 realmask
= umask (0);
3324 XSETINT (value
, (~ realmask
) & 0777);
3334 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3335 "Tell Unix to finish all pending disk updates.")
3344 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3345 "Return t if file FILE1 is newer than file FILE2.\n\
3346 If FILE1 does not exist, the answer is nil;\n\
3347 otherwise, if FILE2 does not exist, the answer is t.")
3349 Lisp_Object file1
, file2
;
3351 Lisp_Object absname1
, absname2
;
3354 Lisp_Object handler
;
3355 struct gcpro gcpro1
, gcpro2
;
3357 CHECK_STRING (file1
, 0);
3358 CHECK_STRING (file2
, 0);
3361 GCPRO2 (absname1
, file2
);
3362 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3363 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3366 /* If the file name has special constructs in it,
3367 call the corresponding file handler. */
3368 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3370 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3371 if (!NILP (handler
))
3372 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3374 GCPRO2 (absname1
, absname2
);
3375 absname1
= ENCODE_FILE (absname1
);
3376 absname2
= ENCODE_FILE (absname2
);
3379 if (stat (XSTRING (absname1
)->data
, &st
) < 0)
3382 mtime1
= st
.st_mtime
;
3384 if (stat (XSTRING (absname2
)->data
, &st
) < 0)
3387 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3391 Lisp_Object Qfind_buffer_file_type
;
3394 #ifndef READ_BUF_SIZE
3395 #define READ_BUF_SIZE (64 << 10)
3398 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3400 /* This function is called after Lisp functions to decide a coding
3401 system are called, or when they cause an error. Before they are
3402 called, the current buffer is set unibyte and it contains only a
3403 newly inserted text (thus the buffer was empty before the
3406 The functions may set markers, overlays, text properties, or even
3407 alter the buffer contents, change the current buffer.
3409 Here, we reset all those changes by:
3410 o set back the current buffer.
3411 o move all markers and overlays to BEG.
3412 o remove all text properties.
3413 o set back the buffer multibyteness. */
3416 decide_coding_unwind (unwind_data
)
3417 Lisp_Object unwind_data
;
3419 Lisp_Object multibyte
, undo_list
, buffer
;
3421 multibyte
= XCAR (unwind_data
);
3422 unwind_data
= XCDR (unwind_data
);
3423 undo_list
= XCAR (unwind_data
);
3424 buffer
= XCDR (unwind_data
);
3426 if (current_buffer
!= XBUFFER (buffer
))
3427 set_buffer_internal (XBUFFER (buffer
));
3428 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3429 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3430 BUF_INTERVALS (current_buffer
) = 0;
3431 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3433 /* Now we are safe to change the buffer's multibyteness directly. */
3434 current_buffer
->enable_multibyte_characters
= multibyte
;
3435 current_buffer
->undo_list
= undo_list
;
3441 /* Used to pass values from insert-file-contents to read_non_regular. */
3443 static int non_regular_fd
;
3444 static int non_regular_inserted
;
3445 static int non_regular_nbytes
;
3448 /* Read from a non-regular file.
3449 Read non_regular_trytry bytes max from non_regular_fd.
3450 Non_regular_inserted specifies where to put the read bytes.
3451 Value is the number of bytes read. */
3460 nbytes
= emacs_read (non_regular_fd
,
3461 BEG_ADDR
+ PT_BYTE
- 1 + non_regular_inserted
,
3462 non_regular_nbytes
);
3463 Fsignal (Qquit
, Qnil
);
3465 return make_number (nbytes
);
3469 /* Condition-case handler used when reading from non-regular files
3470 in insert-file-contents. */
3473 read_non_regular_quit ()
3479 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3481 "Insert contents of file FILENAME after point.\n\
3482 Returns list of absolute file name and number of bytes inserted.\n\
3483 If second argument VISIT is non-nil, the buffer's visited filename\n\
3484 and last save file modtime are set, and it is marked unmodified.\n\
3485 If visiting and the file does not exist, visiting is completed\n\
3486 before the error is signaled.\n\
3487 The optional third and fourth arguments BEG and END\n\
3488 specify what portion of the file to insert.\n\
3489 These arguments count bytes in the file, not characters in the buffer.\n\
3490 If VISIT is non-nil, BEG and END must be nil.\n\
3492 If optional fifth argument REPLACE is non-nil,\n\
3493 it means replace the current buffer contents (in the accessible portion)\n\
3494 with the file contents. This is better than simply deleting and inserting\n\
3495 the whole thing because (1) it preserves some marker positions\n\
3496 and (2) it puts less data in the undo list.\n\
3497 When REPLACE is non-nil, the value is the number of characters actually read,\n\
3498 which is often less than the number of characters to be read.\n\
3500 This does code conversion according to the value of\n\
3501 `coding-system-for-read' or `file-coding-system-alist',\n\
3502 and sets the variable `last-coding-system-used' to the coding system\n\
3504 (filename
, visit
, beg
, end
, replace
)
3505 Lisp_Object filename
, visit
, beg
, end
, replace
;
3510 register int how_much
;
3511 register int unprocessed
;
3512 int count
= BINDING_STACK_SIZE ();
3513 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3514 Lisp_Object handler
, val
, insval
, orig_filename
;
3517 int not_regular
= 0;
3518 unsigned char read_buf
[READ_BUF_SIZE
];
3519 struct coding_system coding
;
3520 unsigned char buffer
[1 << 14];
3521 int replace_handled
= 0;
3522 int set_coding_system
= 0;
3523 int coding_system_decided
= 0;
3527 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3528 error ("Cannot do file visiting in an indirect buffer");
3530 if (!NILP (current_buffer
->read_only
))
3531 Fbarf_if_buffer_read_only ();
3535 orig_filename
= Qnil
;
3537 GCPRO4 (filename
, val
, p
, orig_filename
);
3539 CHECK_STRING (filename
, 0);
3540 filename
= Fexpand_file_name (filename
, Qnil
);
3542 /* If the file name has special constructs in it,
3543 call the corresponding file handler. */
3544 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3545 if (!NILP (handler
))
3547 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3548 visit
, beg
, end
, replace
);
3549 if (CONSP (val
) && CONSP (XCDR (val
)))
3550 inserted
= XINT (XCAR (XCDR (val
)));
3554 orig_filename
= filename
;
3555 filename
= ENCODE_FILE (filename
);
3561 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3563 /* Tell stat to use expensive method to get accurate info. */
3564 Vw32_get_true_file_attributes
= Qt
;
3565 total
= stat (XSTRING (filename
)->data
, &st
);
3566 Vw32_get_true_file_attributes
= tem
;
3571 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3573 if ((fd
= emacs_open (XSTRING (filename
)->data
, O_RDONLY
, 0)) < 0
3574 || fstat (fd
, &st
) < 0)
3575 #endif /* not APOLLO */
3576 #endif /* WINDOWSNT */
3578 if (fd
>= 0) emacs_close (fd
);
3581 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3584 if (!NILP (Vcoding_system_for_read
))
3585 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3590 /* This code will need to be changed in order to work on named
3591 pipes, and it's probably just not worth it. So we should at
3592 least signal an error. */
3593 if (!S_ISREG (st
.st_mode
))
3600 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3601 Fsignal (Qfile_error
,
3602 Fcons (build_string ("not a regular file"),
3603 Fcons (orig_filename
, Qnil
)));
3608 if ((fd
= emacs_open (XSTRING (filename
)->data
, O_RDONLY
, 0)) < 0)
3611 /* Replacement should preserve point as it preserves markers. */
3612 if (!NILP (replace
))
3613 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3615 record_unwind_protect (close_file_unwind
, make_number (fd
));
3617 /* Supposedly happens on VMS. */
3618 if (! not_regular
&& st
.st_size
< 0)
3619 error ("File size is negative");
3621 /* Prevent redisplay optimizations. */
3622 current_buffer
->clip_changed
= 1;
3626 if (!NILP (beg
) || !NILP (end
))
3627 error ("Attempt to visit less than an entire file");
3628 if (BEG
< Z
&& NILP (replace
))
3629 error ("Cannot do file visiting in a non-empty buffer");
3633 CHECK_NUMBER (beg
, 0);
3635 XSETFASTINT (beg
, 0);
3638 CHECK_NUMBER (end
, 0);
3643 XSETINT (end
, st
.st_size
);
3645 /* Arithmetic overflow can occur if an Emacs integer cannot
3646 represent the file size, or if the calculations below
3647 overflow. The calculations below double the file size
3648 twice, so check that it can be multiplied by 4 safely. */
3649 if (XINT (end
) != st
.st_size
3650 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3651 error ("Maximum buffer size exceeded");
3653 /* The file size returned from stat may be zero, but data
3654 may be readable nonetheless, for example when this is a
3655 file in the /proc filesystem. */
3656 if (st
.st_size
== 0)
3657 XSETINT (end
, READ_BUF_SIZE
);
3663 /* Decide the coding system to use for reading the file now
3664 because we can't use an optimized method for handling
3665 `coding:' tag if the current buffer is not empty. */
3669 if (!NILP (Vcoding_system_for_read
))
3670 val
= Vcoding_system_for_read
;
3671 else if (! NILP (replace
))
3672 /* In REPLACE mode, we can use the same coding system
3673 that was used to visit the file. */
3674 val
= current_buffer
->buffer_file_coding_system
;
3677 /* Don't try looking inside a file for a coding system
3678 specification if it is not seekable. */
3679 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3681 /* Find a coding system specified in the heading two
3682 lines or in the tailing several lines of the file.
3683 We assume that the 1K-byte and 3K-byte for heading
3684 and tailing respectively are sufficient for this
3688 if (st
.st_size
<= (1024 * 4))
3689 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3692 nread
= emacs_read (fd
, read_buf
, 1024);
3695 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3696 report_file_error ("Setting file position",
3697 Fcons (orig_filename
, Qnil
));
3698 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3703 error ("IO error reading %s: %s",
3704 XSTRING (orig_filename
)->data
, emacs_strerror (errno
));
3707 struct buffer
*prev
= current_buffer
;
3710 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3712 /* The call to temp_output_buffer_setup binds
3714 count1
= specpdl_ptr
- specpdl
;
3715 temp_output_buffer_setup (" *code-converting-work*");
3717 set_buffer_internal (XBUFFER (Vstandard_output
));
3718 current_buffer
->enable_multibyte_characters
= Qnil
;
3719 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3720 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3721 val
= call2 (Vset_auto_coding_function
,
3722 filename
, make_number (nread
));
3723 set_buffer_internal (prev
);
3725 /* Remove the binding for standard-output. */
3726 unbind_to (count1
, Qnil
);
3728 /* Discard the unwind protect for recovering the
3732 /* Rewind the file for the actual read done later. */
3733 if (lseek (fd
, 0, 0) < 0)
3734 report_file_error ("Setting file position",
3735 Fcons (orig_filename
, Qnil
));
3741 /* If we have not yet decided a coding system, check
3742 file-coding-system-alist. */
3743 Lisp_Object args
[6], coding_systems
;
3745 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3746 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3747 coding_systems
= Ffind_operation_coding_system (6, args
);
3748 if (CONSP (coding_systems
))
3749 val
= XCAR (coding_systems
);
3753 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3754 /* Ensure we set Vlast_coding_system_used. */
3755 set_coding_system
= 1;
3757 if (NILP (current_buffer
->enable_multibyte_characters
)
3759 /* We must suppress all character code conversion except for
3760 end-of-line conversion. */
3761 setup_raw_text_coding_system (&coding
);
3763 coding
.src_multibyte
= 0;
3764 coding
.dst_multibyte
3765 = !NILP (current_buffer
->enable_multibyte_characters
);
3766 coding_system_decided
= 1;
3769 /* If requested, replace the accessible part of the buffer
3770 with the file contents. Avoid replacing text at the
3771 beginning or end of the buffer that matches the file contents;
3772 that preserves markers pointing to the unchanged parts.
3774 Here we implement this feature in an optimized way
3775 for the case where code conversion is NOT needed.
3776 The following if-statement handles the case of conversion
3777 in a less optimal way.
3779 If the code conversion is "automatic" then we try using this
3780 method and hope for the best.
3781 But if we discover the need for conversion, we give up on this method
3782 and let the following if-statement handle the replace job. */
3785 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
3787 /* same_at_start and same_at_end count bytes,
3788 because file access counts bytes
3789 and BEG and END count bytes. */
3790 int same_at_start
= BEGV_BYTE
;
3791 int same_at_end
= ZV_BYTE
;
3793 /* There is still a possibility we will find the need to do code
3794 conversion. If that happens, we set this variable to 1 to
3795 give up on handling REPLACE in the optimized way. */
3796 int giveup_match_end
= 0;
3798 if (XINT (beg
) != 0)
3800 if (lseek (fd
, XINT (beg
), 0) < 0)
3801 report_file_error ("Setting file position",
3802 Fcons (orig_filename
, Qnil
));
3807 /* Count how many chars at the start of the file
3808 match the text at the beginning of the buffer. */
3813 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
3815 error ("IO error reading %s: %s",
3816 XSTRING (orig_filename
)->data
, emacs_strerror (errno
));
3817 else if (nread
== 0)
3820 if (coding
.type
== coding_type_undecided
)
3821 detect_coding (&coding
, buffer
, nread
);
3822 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
3823 /* We found that the file should be decoded somehow.
3824 Let's give up here. */
3826 giveup_match_end
= 1;
3830 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3831 detect_eol (&coding
, buffer
, nread
);
3832 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3833 && coding
.eol_type
!= CODING_EOL_LF
)
3834 /* We found that the format of eol should be decoded.
3835 Let's give up here. */
3837 giveup_match_end
= 1;
3842 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3843 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3844 same_at_start
++, bufpos
++;
3845 /* If we found a discrepancy, stop the scan.
3846 Otherwise loop around and scan the next bufferful. */
3847 if (bufpos
!= nread
)
3851 /* If the file matches the buffer completely,
3852 there's no need to replace anything. */
3853 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3857 /* Truncate the buffer to the size of the file. */
3858 del_range_1 (same_at_start
, same_at_end
, 0, 0);
3863 /* Count how many chars at the end of the file
3864 match the text at the end of the buffer. But, if we have
3865 already found that decoding is necessary, don't waste time. */
3866 while (!giveup_match_end
)
3868 int total_read
, nread
, bufpos
, curpos
, trial
;
3870 /* At what file position are we now scanning? */
3871 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3872 /* If the entire file matches the buffer tail, stop the scan. */
3875 /* How much can we scan in the next step? */
3876 trial
= min (curpos
, sizeof buffer
);
3877 if (lseek (fd
, curpos
- trial
, 0) < 0)
3878 report_file_error ("Setting file position",
3879 Fcons (orig_filename
, Qnil
));
3881 total_read
= nread
= 0;
3882 while (total_read
< trial
)
3884 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
3886 error ("IO error reading %s: %s",
3887 XSTRING (orig_filename
)->data
, emacs_strerror (errno
));
3888 else if (nread
== 0)
3890 total_read
+= nread
;
3893 /* Scan this bufferful from the end, comparing with
3894 the Emacs buffer. */
3895 bufpos
= total_read
;
3897 /* Compare with same_at_start to avoid counting some buffer text
3898 as matching both at the file's beginning and at the end. */
3899 while (bufpos
> 0 && same_at_end
> same_at_start
3900 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3901 same_at_end
--, bufpos
--;
3903 /* If we found a discrepancy, stop the scan.
3904 Otherwise loop around and scan the preceding bufferful. */
3907 /* If this discrepancy is because of code conversion,
3908 we cannot use this method; giveup and try the other. */
3909 if (same_at_end
> same_at_start
3910 && FETCH_BYTE (same_at_end
- 1) >= 0200
3911 && ! NILP (current_buffer
->enable_multibyte_characters
)
3912 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3913 giveup_match_end
= 1;
3922 if (! giveup_match_end
)
3926 /* We win! We can handle REPLACE the optimized way. */
3928 /* Extend the start of non-matching text area to multibyte
3929 character boundary. */
3930 if (! NILP (current_buffer
->enable_multibyte_characters
))
3931 while (same_at_start
> BEGV_BYTE
3932 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
3935 /* Extend the end of non-matching text area to multibyte
3936 character boundary. */
3937 if (! NILP (current_buffer
->enable_multibyte_characters
))
3938 while (same_at_end
< ZV_BYTE
3939 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3942 /* Don't try to reuse the same piece of text twice. */
3943 overlap
= (same_at_start
- BEGV_BYTE
3944 - (same_at_end
+ st
.st_size
- ZV
));
3946 same_at_end
+= overlap
;
3948 /* Arrange to read only the nonmatching middle part of the file. */
3949 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
3950 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
3952 del_range_byte (same_at_start
, same_at_end
, 0);
3953 /* Insert from the file at the proper position. */
3954 temp
= BYTE_TO_CHAR (same_at_start
);
3955 SET_PT_BOTH (temp
, same_at_start
);
3957 /* If display currently starts at beginning of line,
3958 keep it that way. */
3959 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3960 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3962 replace_handled
= 1;
3966 /* If requested, replace the accessible part of the buffer
3967 with the file contents. Avoid replacing text at the
3968 beginning or end of the buffer that matches the file contents;
3969 that preserves markers pointing to the unchanged parts.
3971 Here we implement this feature for the case where code conversion
3972 is needed, in a simple way that needs a lot of memory.
3973 The preceding if-statement handles the case of no conversion
3974 in a more optimized way. */
3975 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
3977 int same_at_start
= BEGV_BYTE
;
3978 int same_at_end
= ZV_BYTE
;
3981 /* Make sure that the gap is large enough. */
3982 int bufsize
= 2 * st
.st_size
;
3983 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
3986 /* First read the whole file, performing code conversion into
3987 CONVERSION_BUFFER. */
3989 if (lseek (fd
, XINT (beg
), 0) < 0)
3991 xfree (conversion_buffer
);
3992 report_file_error ("Setting file position",
3993 Fcons (orig_filename
, Qnil
));
3996 total
= st
.st_size
; /* Total bytes in the file. */
3997 how_much
= 0; /* Bytes read from file so far. */
3998 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3999 unprocessed
= 0; /* Bytes not processed in previous loop. */
4001 while (how_much
< total
)
4003 /* try is reserved in some compilers (Microsoft C) */
4004 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4005 unsigned char *destination
= read_buf
+ unprocessed
;
4008 /* Allow quitting out of the actual I/O. */
4011 this = emacs_read (fd
, destination
, trytry
);
4014 if (this < 0 || this + unprocessed
== 0)
4022 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4024 int require
, result
;
4026 this += unprocessed
;
4028 /* If we are using more space than estimated,
4029 make CONVERSION_BUFFER bigger. */
4030 require
= decoding_buffer_size (&coding
, this);
4031 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4033 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4034 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4037 /* Convert this batch with results in CONVERSION_BUFFER. */
4038 if (how_much
>= total
) /* This is the last block. */
4039 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4040 if (coding
.composing
!= COMPOSITION_DISABLED
)
4041 coding_allocate_composition_data (&coding
, BEGV
);
4042 result
= decode_coding (&coding
, read_buf
,
4043 conversion_buffer
+ inserted
,
4044 this, bufsize
- inserted
);
4046 /* Save for next iteration whatever we didn't convert. */
4047 unprocessed
= this - coding
.consumed
;
4048 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4049 if (!NILP (current_buffer
->enable_multibyte_characters
))
4050 this = coding
.produced
;
4052 this = str_as_unibyte (conversion_buffer
+ inserted
,
4059 /* At this point, INSERTED is how many characters (i.e. bytes)
4060 are present in CONVERSION_BUFFER.
4061 HOW_MUCH should equal TOTAL,
4062 or should be <= 0 if we couldn't read the file. */
4066 xfree (conversion_buffer
);
4069 error ("IO error reading %s: %s",
4070 XSTRING (orig_filename
)->data
, emacs_strerror (errno
));
4071 else if (how_much
== -2)
4072 error ("maximum buffer size exceeded");
4075 /* Compare the beginning of the converted file
4076 with the buffer text. */
4079 while (bufpos
< inserted
&& same_at_start
< same_at_end
4080 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4081 same_at_start
++, bufpos
++;
4083 /* If the file matches the buffer completely,
4084 there's no need to replace anything. */
4086 if (bufpos
== inserted
)
4088 xfree (conversion_buffer
);
4091 /* Truncate the buffer to the size of the file. */
4092 del_range_byte (same_at_start
, same_at_end
, 0);
4097 /* Extend the start of non-matching text area to multibyte
4098 character boundary. */
4099 if (! NILP (current_buffer
->enable_multibyte_characters
))
4100 while (same_at_start
> BEGV_BYTE
4101 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4104 /* Scan this bufferful from the end, comparing with
4105 the Emacs buffer. */
4108 /* Compare with same_at_start to avoid counting some buffer text
4109 as matching both at the file's beginning and at the end. */
4110 while (bufpos
> 0 && same_at_end
> same_at_start
4111 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4112 same_at_end
--, bufpos
--;
4114 /* Extend the end of non-matching text area to multibyte
4115 character boundary. */
4116 if (! NILP (current_buffer
->enable_multibyte_characters
))
4117 while (same_at_end
< ZV_BYTE
4118 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4121 /* Don't try to reuse the same piece of text twice. */
4122 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4124 same_at_end
+= overlap
;
4126 /* If display currently starts at beginning of line,
4127 keep it that way. */
4128 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4129 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4131 /* Replace the chars that we need to replace,
4132 and update INSERTED to equal the number of bytes
4133 we are taking from the file. */
4134 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
4136 if (same_at_end
!= same_at_start
)
4138 del_range_byte (same_at_start
, same_at_end
, 0);
4140 same_at_start
= GPT_BYTE
;
4144 temp
= BYTE_TO_CHAR (same_at_start
);
4146 /* Insert from the file at the proper position. */
4147 SET_PT_BOTH (temp
, same_at_start
);
4148 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
4150 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4151 coding_restore_composition (&coding
, Fcurrent_buffer ());
4152 coding_free_composition_data (&coding
);
4154 /* Set `inserted' to the number of inserted characters. */
4155 inserted
= PT
- temp
;
4157 xfree (conversion_buffer
);
4166 register Lisp_Object temp
;
4168 total
= XINT (end
) - XINT (beg
);
4170 /* Make sure point-max won't overflow after this insertion. */
4171 XSETINT (temp
, total
);
4172 if (total
!= XINT (temp
))
4173 error ("Maximum buffer size exceeded");
4176 /* For a special file, all we can do is guess. */
4177 total
= READ_BUF_SIZE
;
4179 if (NILP (visit
) && total
> 0)
4180 prepare_to_modify_buffer (PT
, PT
, NULL
);
4183 if (GAP_SIZE
< total
)
4184 make_gap (total
- GAP_SIZE
);
4186 if (XINT (beg
) != 0 || !NILP (replace
))
4188 if (lseek (fd
, XINT (beg
), 0) < 0)
4189 report_file_error ("Setting file position",
4190 Fcons (orig_filename
, Qnil
));
4193 /* In the following loop, HOW_MUCH contains the total bytes read so
4194 far for a regular file, and not changed for a special file. But,
4195 before exiting the loop, it is set to a negative value if I/O
4199 /* Total bytes inserted. */
4202 /* Here, we don't do code conversion in the loop. It is done by
4203 code_convert_region after all data are read into the buffer. */
4205 int gap_size
= GAP_SIZE
;
4207 while (how_much
< total
)
4209 /* try is reserved in some compilers (Microsoft C) */
4210 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4217 /* Maybe make more room. */
4218 if (gap_size
< trytry
)
4220 make_gap (total
- gap_size
);
4221 gap_size
= GAP_SIZE
;
4224 /* Read from the file, capturing `quit'. When an
4225 error occurs, end the loop, and arrange for a quit
4226 to be signaled after decoding the text we read. */
4227 non_regular_fd
= fd
;
4228 non_regular_inserted
= inserted
;
4229 non_regular_nbytes
= trytry
;
4230 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4231 read_non_regular_quit
);
4242 /* Allow quitting out of the actual I/O. We don't make text
4243 part of the buffer until all the reading is done, so a C-g
4244 here doesn't do any harm. */
4247 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- 1 + inserted
, trytry
);
4259 /* For a regular file, where TOTAL is the real size,
4260 count HOW_MUCH to compare with it.
4261 For a special file, where TOTAL is just a buffer size,
4262 so don't bother counting in HOW_MUCH.
4263 (INSERTED is where we count the number of characters inserted.) */
4270 /* Make the text read part of the buffer. */
4271 GAP_SIZE
-= inserted
;
4273 GPT_BYTE
+= inserted
;
4275 ZV_BYTE
+= inserted
;
4280 /* Put an anchor to ensure multi-byte form ends at gap. */
4285 /* Discard the unwind protect for closing the file. */
4289 error ("IO error reading %s: %s",
4290 XSTRING (orig_filename
)->data
, emacs_strerror (errno
));
4294 if (! coding_system_decided
)
4296 /* The coding system is not yet decided. Decide it by an
4297 optimized method for handling `coding:' tag.
4299 Note that we can get here only if the buffer was empty
4300 before the insertion. */
4304 if (!NILP (Vcoding_system_for_read
))
4305 val
= Vcoding_system_for_read
;
4308 /* Since we are sure that the current buffer was empty
4309 before the insertion, we can toggle
4310 enable-multibyte-characters directly here without taking
4311 care of marker adjustment and byte combining problem. By
4312 this way, we can run Lisp program safely before decoding
4313 the inserted text. */
4314 Lisp_Object unwind_data
;
4315 int count
= specpdl_ptr
- specpdl
;
4317 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4318 Fcons (current_buffer
->undo_list
,
4319 Fcurrent_buffer ()));
4320 current_buffer
->enable_multibyte_characters
= Qnil
;
4321 current_buffer
->undo_list
= Qt
;
4322 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4324 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4326 val
= call2 (Vset_auto_coding_function
,
4327 filename
, make_number (inserted
));
4332 /* If the coding system is not yet decided, check
4333 file-coding-system-alist. */
4334 Lisp_Object args
[6], coding_systems
;
4336 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4337 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4338 coding_systems
= Ffind_operation_coding_system (6, args
);
4339 if (CONSP (coding_systems
))
4340 val
= XCAR (coding_systems
);
4343 unbind_to (count
, Qnil
);
4344 inserted
= Z_BYTE
- BEG_BYTE
;
4347 /* The following kludgy code is to avoid some compiler bug.
4349 setup_coding_system (val, &coding);
4352 struct coding_system temp_coding
;
4353 setup_coding_system (val
, &temp_coding
);
4354 bcopy (&temp_coding
, &coding
, sizeof coding
);
4356 /* Ensure we set Vlast_coding_system_used. */
4357 set_coding_system
= 1;
4359 if (NILP (current_buffer
->enable_multibyte_characters
)
4361 /* We must suppress all character code conversion except for
4362 end-of-line conversion. */
4363 setup_raw_text_coding_system (&coding
);
4364 coding
.src_multibyte
= 0;
4365 coding
.dst_multibyte
4366 = !NILP (current_buffer
->enable_multibyte_characters
);
4370 /* Can't do this if part of the buffer might be preserved. */
4372 && (coding
.type
== coding_type_no_conversion
4373 || coding
.type
== coding_type_raw_text
))
4375 /* Visiting a file with these coding system makes the buffer
4377 current_buffer
->enable_multibyte_characters
= Qnil
;
4378 coding
.dst_multibyte
= 0;
4381 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4383 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4385 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4387 inserted
= coding
.produced_char
;
4390 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4395 /* Use the conversion type to determine buffer-file-type
4396 (find-buffer-file-type is now used to help determine the
4398 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4399 || coding
.eol_type
== CODING_EOL_LF
)
4400 && ! CODING_REQUIRE_DECODING (&coding
))
4401 current_buffer
->buffer_file_type
= Qt
;
4403 current_buffer
->buffer_file_type
= Qnil
;
4410 if (!EQ (current_buffer
->undo_list
, Qt
))
4411 current_buffer
->undo_list
= Qnil
;
4413 stat (XSTRING (filename
)->data
, &st
);
4418 current_buffer
->modtime
= st
.st_mtime
;
4419 current_buffer
->filename
= orig_filename
;
4422 SAVE_MODIFF
= MODIFF
;
4423 current_buffer
->auto_save_modified
= MODIFF
;
4424 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4425 #ifdef CLASH_DETECTION
4428 if (!NILP (current_buffer
->file_truename
))
4429 unlock_file (current_buffer
->file_truename
);
4430 unlock_file (filename
);
4432 #endif /* CLASH_DETECTION */
4434 Fsignal (Qfile_error
,
4435 Fcons (build_string ("not a regular file"),
4436 Fcons (orig_filename
, Qnil
)));
4439 /* Decode file format */
4442 int empty_undo_list_p
= 0;
4444 /* If we're anyway going to discard undo information, don't
4445 record it in the first place. The buffer's undo list at this
4446 point is either nil or t when visiting a file. */
4449 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4450 current_buffer
->undo_list
= Qt
;
4453 insval
= call3 (Qformat_decode
,
4454 Qnil
, make_number (inserted
), visit
);
4455 CHECK_NUMBER (insval
, 0);
4456 inserted
= XFASTINT (insval
);
4459 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4462 if (set_coding_system
)
4463 Vlast_coding_system_used
= coding
.symbol
;
4465 /* Call after-change hooks for the inserted text, aside from the case
4466 of normal visiting (not with REPLACE), which is done in a new buffer
4467 "before" the buffer is changed. */
4468 if (inserted
> 0 && total
> 0
4469 && (NILP (visit
) || !NILP (replace
)))
4471 signal_after_change (PT
, 0, inserted
);
4472 update_compositions (PT
, PT
, CHECK_BORDER
);
4475 p
= Vafter_insert_file_functions
;
4478 insval
= call1 (Fcar (p
), make_number (inserted
));
4481 CHECK_NUMBER (insval
, 0);
4482 inserted
= XFASTINT (insval
);
4489 && current_buffer
->modtime
== -1)
4491 /* If visiting nonexistent file, return nil. */
4492 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4496 Fsignal (Qquit
, Qnil
);
4498 /* ??? Retval needs to be dealt with in all cases consistently. */
4500 val
= Fcons (orig_filename
,
4501 Fcons (make_number (inserted
),
4504 RETURN_UNGCPRO (unbind_to (count
, val
));
4507 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
,
4510 /* If build_annotations switched buffers, switch back to BUF.
4511 Kill the temporary buffer that was selected in the meantime.
4513 Since this kill only the last temporary buffer, some buffers remain
4514 not killed if build_annotations switched buffers more than once.
4518 build_annotations_unwind (buf
)
4523 if (XBUFFER (buf
) == current_buffer
)
4525 tembuf
= Fcurrent_buffer ();
4527 Fkill_buffer (tembuf
);
4531 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4532 "r\nFWrite region to file: \ni\ni\ni\np",
4533 "Write current region into specified file.\n\
4534 When called from a program, takes three arguments:\n\
4535 START, END and FILENAME. START and END are buffer positions.\n\
4536 Optional fourth argument APPEND if non-nil means\n\
4537 append to existing file contents (if any). If it is an integer,\n\
4538 seek to that offset in the file before writing.\n\
4539 Optional fifth argument VISIT if t means\n\
4540 set the last-save-file-modtime of buffer to this file's modtime\n\
4541 and mark buffer not modified.\n\
4542 If VISIT is a string, it is a second file name;\n\
4543 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
4544 VISIT is also the file name to lock and unlock for clash detection.\n\
4545 If VISIT is neither t nor nil nor a string,\n\
4546 that means do not print the \"Wrote file\" message.\n\
4547 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
4548 use for locking and unlocking, overriding FILENAME and VISIT.\n\
4549 The optional seventh arg MUSTBENEW, if non-nil, insists on a check\n\
4550 for an existing file with the same name. If MUSTBENEW is `excl',\n\
4551 that means to get an error if the file already exists; never overwrite.\n\
4552 If MUSTBENEW is neither nil nor `excl', that means ask for\n\
4553 confirmation before overwriting, but do go ahead and overwrite the file\n\
4554 if the user confirms.\n\
4555 Kludgy feature: if START is a string, then that string is written\n\
4556 to the file, instead of any buffer contents, and END is ignored.\n\
4558 This does code conversion according to the value of\n\
4559 `coding-system-for-write', `buffer-file-coding-system', or\n\
4560 `file-coding-system-alist', and sets the variable\n\
4561 `last-coding-system-used' to the coding system actually used.")
4563 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4564 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4572 int count
= specpdl_ptr
- specpdl
;
4575 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4577 Lisp_Object handler
;
4578 Lisp_Object visit_file
;
4579 Lisp_Object annotations
;
4580 Lisp_Object encoded_filename
;
4581 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4582 int quietly
= !NILP (visit
);
4583 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4584 struct buffer
*given_buffer
;
4586 int buffer_file_type
= O_BINARY
;
4588 struct coding_system coding
;
4590 if (current_buffer
->base_buffer
&& visiting
)
4591 error ("Cannot do file visiting in an indirect buffer");
4593 if (!NILP (start
) && !STRINGP (start
))
4594 validate_region (&start
, &end
);
4596 GCPRO4 (start
, filename
, visit
, lockname
);
4598 /* Decide the coding-system to encode the data with. */
4604 else if (!NILP (Vcoding_system_for_write
))
4605 val
= Vcoding_system_for_write
;
4608 /* If the variable `buffer-file-coding-system' is set locally,
4609 it means that the file was read with some kind of code
4610 conversion or the variable is explicitly set by users. We
4611 had better write it out with the same coding system even if
4612 `enable-multibyte-characters' is nil.
4614 If it is not set locally, we anyway have to convert EOL
4615 format if the default value of `buffer-file-coding-system'
4616 tells that it is not Unix-like (LF only) format. */
4617 int using_default_coding
= 0;
4618 int force_raw_text
= 0;
4620 val
= current_buffer
->buffer_file_coding_system
;
4622 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4625 if (NILP (current_buffer
->enable_multibyte_characters
))
4631 /* Check file-coding-system-alist. */
4632 Lisp_Object args
[7], coding_systems
;
4634 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4635 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4637 coding_systems
= Ffind_operation_coding_system (7, args
);
4638 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4639 val
= XCDR (coding_systems
);
4643 && !NILP (current_buffer
->buffer_file_coding_system
))
4645 /* If we still have not decided a coding system, use the
4646 default value of buffer-file-coding-system. */
4647 val
= current_buffer
->buffer_file_coding_system
;
4648 using_default_coding
= 1;
4652 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4653 /* Confirm that VAL can surely encode the current region. */
4654 val
= call3 (Vselect_safe_coding_system_function
, start
, end
, val
);
4656 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4657 if (coding
.eol_type
== CODING_EOL_UNDECIDED
4658 && !using_default_coding
)
4660 if (! EQ (default_buffer_file_coding
.symbol
,
4661 buffer_defaults
.buffer_file_coding_system
))
4662 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4663 &default_buffer_file_coding
);
4664 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4666 Lisp_Object subsidiaries
;
4668 coding
.eol_type
= default_buffer_file_coding
.eol_type
;
4669 subsidiaries
= Fget (coding
.symbol
, Qeol_type
);
4670 if (VECTORP (subsidiaries
)
4671 && XVECTOR (subsidiaries
)->size
== 3)
4673 = XVECTOR (subsidiaries
)->contents
[coding
.eol_type
];
4678 setup_raw_text_coding_system (&coding
);
4679 goto done_setup_coding
;
4682 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4685 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4686 coding
.mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4689 Vlast_coding_system_used
= coding
.symbol
;
4691 filename
= Fexpand_file_name (filename
, Qnil
);
4693 if (! NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4694 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4696 if (STRINGP (visit
))
4697 visit_file
= Fexpand_file_name (visit
, Qnil
);
4699 visit_file
= filename
;
4704 if (NILP (lockname
))
4705 lockname
= visit_file
;
4707 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4709 /* If the file name has special constructs in it,
4710 call the corresponding file handler. */
4711 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4712 /* If FILENAME has no handler, see if VISIT has one. */
4713 if (NILP (handler
) && STRINGP (visit
))
4714 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4716 if (!NILP (handler
))
4719 val
= call6 (handler
, Qwrite_region
, start
, end
,
4720 filename
, append
, visit
);
4724 SAVE_MODIFF
= MODIFF
;
4725 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4726 current_buffer
->filename
= visit_file
;
4732 /* Special kludge to simplify auto-saving. */
4735 XSETFASTINT (start
, BEG
);
4736 XSETFASTINT (end
, Z
);
4739 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4740 count1
= specpdl_ptr
- specpdl
;
4742 given_buffer
= current_buffer
;
4743 annotations
= build_annotations (start
, end
, coding
.pre_write_conversion
);
4744 if (current_buffer
!= given_buffer
)
4746 XSETFASTINT (start
, BEGV
);
4747 XSETFASTINT (end
, ZV
);
4750 #ifdef CLASH_DETECTION
4753 #if 0 /* This causes trouble for GNUS. */
4754 /* If we've locked this file for some other buffer,
4755 query before proceeding. */
4756 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4757 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4760 lock_file (lockname
);
4762 #endif /* CLASH_DETECTION */
4764 encoded_filename
= ENCODE_FILE (filename
);
4766 fn
= XSTRING (encoded_filename
)->data
;
4770 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
4771 #else /* not DOS_NT */
4772 desc
= emacs_open (fn
, O_WRONLY
, 0);
4773 #endif /* not DOS_NT */
4775 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4777 if (auto_saving
) /* Overwrite any previous version of autosave file */
4779 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4780 desc
= emacs_open (fn
, O_RDWR
, 0);
4782 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4783 ? XSTRING (current_buffer
->filename
)->data
: 0,
4786 else /* Write to temporary name and rename if no errors */
4788 Lisp_Object temp_name
;
4789 temp_name
= Ffile_name_directory (filename
);
4791 if (!NILP (temp_name
))
4793 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4794 build_string ("$$SAVE$$")));
4795 fname
= XSTRING (filename
)->data
;
4796 fn
= XSTRING (temp_name
)->data
;
4797 desc
= creat_copy_attrs (fname
, fn
);
4800 /* If we can't open the temporary file, try creating a new
4801 version of the original file. VMS "creat" creates a
4802 new version rather than truncating an existing file. */
4805 desc
= creat (fn
, 0666);
4806 #if 0 /* This can clobber an existing file and fail to replace it,
4807 if the user runs out of space. */
4810 /* We can't make a new version;
4811 try to truncate and rewrite existing version if any. */
4813 desc
= emacs_open (fn
, O_RDWR
, 0);
4819 desc
= creat (fn
, 0666);
4823 desc
= emacs_open (fn
,
4824 O_WRONLY
| O_CREAT
| buffer_file_type
4825 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
4826 S_IREAD
| S_IWRITE
);
4827 #else /* not DOS_NT */
4828 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
4829 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
4830 auto_saving
? auto_save_mode_bits
: 0666);
4831 #endif /* not DOS_NT */
4832 #endif /* not VMS */
4836 #ifdef CLASH_DETECTION
4838 if (!auto_saving
) unlock_file (lockname
);
4840 #endif /* CLASH_DETECTION */
4842 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4845 record_unwind_protect (close_file_unwind
, make_number (desc
));
4847 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
4851 if (NUMBERP (append
))
4852 ret
= lseek (desc
, XINT (append
), 1);
4854 ret
= lseek (desc
, 0, 2);
4857 #ifdef CLASH_DETECTION
4858 if (!auto_saving
) unlock_file (lockname
);
4859 #endif /* CLASH_DETECTION */
4861 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4869 * Kludge Warning: The VMS C RTL likes to insert carriage returns
4870 * if we do writes that don't end with a carriage return. Furthermore
4871 * it cannot handle writes of more then 16K. The modified
4872 * version of "sys_write" in SYSDEP.C (see comment there) copes with
4873 * this EXCEPT for the last record (iff it doesn't end with a carriage
4874 * return). This implies that if your buffer doesn't end with a carriage
4875 * return, you get one free... tough. However it also means that if
4876 * we make two calls to sys_write (a la the following code) you can
4877 * get one at the gap as well. The easiest way to fix this (honest)
4878 * is to move the gap to the next newline (or the end of the buffer).
4883 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4884 move_gap (find_next_newline (GPT
, 1));
4886 /* Whether VMS or not, we must move the gap to the next of newline
4887 when we must put designation sequences at beginning of line. */
4888 if (INTEGERP (start
)
4889 && coding
.type
== coding_type_iso2022
4890 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
4891 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4893 int opoint
= PT
, opoint_byte
= PT_BYTE
;
4894 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
4895 move_gap_both (PT
, PT_BYTE
);
4896 SET_PT_BOTH (opoint
, opoint_byte
);
4903 if (STRINGP (start
))
4905 failure
= 0 > a_write (desc
, start
, 0, XSTRING (start
)->size
,
4906 &annotations
, &coding
);
4909 else if (XINT (start
) != XINT (end
))
4911 tem
= CHAR_TO_BYTE (XINT (start
));
4913 if (XINT (start
) < GPT
)
4915 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
4916 min (GPT
, XINT (end
)) - XINT (start
),
4917 &annotations
, &coding
);
4921 if (XINT (end
) > GPT
&& !failure
)
4923 tem
= max (XINT (start
), GPT
);
4924 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
4925 &annotations
, &coding
);
4931 /* If file was empty, still need to write the annotations */
4932 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4933 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
4937 if (CODING_REQUIRE_FLUSHING (&coding
)
4938 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
4941 /* We have to flush out a data. */
4942 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4943 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
4950 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4951 Disk full in NFS may be reported here. */
4952 /* mib says that closing the file will try to write as fast as NFS can do
4953 it, and that means the fsync here is not crucial for autosave files. */
4954 if (!auto_saving
&& fsync (desc
) < 0)
4956 /* If fsync fails with EINTR, don't treat that as serious. */
4958 failure
= 1, save_errno
= errno
;
4962 /* Spurious "file has changed on disk" warnings have been
4963 observed on Suns as well.
4964 It seems that `close' can change the modtime, under nfs.
4966 (This has supposedly been fixed in Sunos 4,
4967 but who knows about all the other machines with NFS?) */
4970 /* On VMS and APOLLO, must do the stat after the close
4971 since closing changes the modtime. */
4974 /* Recall that #if defined does not work on VMS. */
4981 /* NFS can report a write failure now. */
4982 if (emacs_close (desc
) < 0)
4983 failure
= 1, save_errno
= errno
;
4986 /* If we wrote to a temporary name and had no errors, rename to real name. */
4990 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
4998 /* Discard the unwind protect for close_file_unwind. */
4999 specpdl_ptr
= specpdl
+ count1
;
5000 /* Restore the original current buffer. */
5001 visit_file
= unbind_to (count
, visit_file
);
5003 #ifdef CLASH_DETECTION
5005 unlock_file (lockname
);
5006 #endif /* CLASH_DETECTION */
5008 /* Do this before reporting IO error
5009 to avoid a "file has changed on disk" warning on
5010 next attempt to save. */
5012 current_buffer
->modtime
= st
.st_mtime
;
5015 error ("IO error writing %s: %s", XSTRING (filename
)->data
,
5016 emacs_strerror (save_errno
));
5020 SAVE_MODIFF
= MODIFF
;
5021 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5022 current_buffer
->filename
= visit_file
;
5023 update_mode_lines
++;
5029 message_with_string ("Wrote %s", visit_file
, 1);
5034 Lisp_Object
merge ();
5036 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5037 "Return t if (car A) is numerically less than (car B).")
5041 return Flss (Fcar (a
), Fcar (b
));
5044 /* Build the complete list of annotations appropriate for writing out
5045 the text between START and END, by calling all the functions in
5046 write-region-annotate-functions and merging the lists they return.
5047 If one of these functions switches to a different buffer, we assume
5048 that buffer contains altered text. Therefore, the caller must
5049 make sure to restore the current buffer in all cases,
5050 as save-excursion would do. */
5053 build_annotations (start
, end
, pre_write_conversion
)
5054 Lisp_Object start
, end
, pre_write_conversion
;
5056 Lisp_Object annotations
;
5058 struct gcpro gcpro1
, gcpro2
;
5059 Lisp_Object original_buffer
;
5062 XSETBUFFER (original_buffer
, current_buffer
);
5065 p
= Vwrite_region_annotate_functions
;
5066 GCPRO2 (annotations
, p
);
5069 struct buffer
*given_buffer
= current_buffer
;
5070 Vwrite_region_annotations_so_far
= annotations
;
5071 res
= call2 (Fcar (p
), start
, end
);
5072 /* If the function makes a different buffer current,
5073 assume that means this buffer contains altered text to be output.
5074 Reset START and END from the buffer bounds
5075 and discard all previous annotations because they should have
5076 been dealt with by this function. */
5077 if (current_buffer
!= given_buffer
)
5079 XSETFASTINT (start
, BEGV
);
5080 XSETFASTINT (end
, ZV
);
5083 Flength (res
); /* Check basic validity of return value */
5084 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5088 /* Now do the same for annotation functions implied by the file-format */
5089 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
5090 p
= Vauto_save_file_format
;
5092 p
= current_buffer
->file_format
;
5093 for (i
= 0; !NILP (p
); p
= Fcdr (p
), ++i
)
5095 struct buffer
*given_buffer
= current_buffer
;
5097 Vwrite_region_annotations_so_far
= annotations
;
5099 /* Value is either a list of annotations or nil if the function
5100 has written annotations to a temporary buffer, which is now
5102 res
= call5 (Qformat_annotate_function
, Fcar (p
), start
, end
,
5103 original_buffer
, make_number (i
));
5104 if (current_buffer
!= given_buffer
)
5106 XSETFASTINT (start
, BEGV
);
5107 XSETFASTINT (end
, ZV
);
5112 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5115 /* At last, do the same for the function PRE_WRITE_CONVERSION
5116 implied by the current coding-system. */
5117 if (!NILP (pre_write_conversion
))
5119 struct buffer
*given_buffer
= current_buffer
;
5120 Vwrite_region_annotations_so_far
= annotations
;
5121 res
= call2 (pre_write_conversion
, start
, end
);
5123 annotations
= (current_buffer
!= given_buffer
5125 : merge (annotations
, res
, Qcar_less_than_car
));
5132 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5133 If STRING is nil, POS is the character position in the current buffer.
5134 Intersperse with them the annotations from *ANNOT
5135 which fall within the range of POS to POS + NCHARS,
5136 each at its appropriate position.
5138 We modify *ANNOT by discarding elements as we use them up.
5140 The return value is negative in case of system call failure. */
5143 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5146 register int nchars
;
5149 struct coding_system
*coding
;
5153 int lastpos
= pos
+ nchars
;
5155 while (NILP (*annot
) || CONSP (*annot
))
5157 tem
= Fcar_safe (Fcar (*annot
));
5160 nextpos
= XFASTINT (tem
);
5162 /* If there are no more annotations in this range,
5163 output the rest of the range all at once. */
5164 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5165 return e_write (desc
, string
, pos
, lastpos
, coding
);
5167 /* Output buffer text up to the next annotation's position. */
5170 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5174 /* Output the annotation. */
5175 tem
= Fcdr (Fcar (*annot
));
5178 if (0 > e_write (desc
, tem
, 0, XSTRING (tem
)->size
, coding
))
5181 *annot
= Fcdr (*annot
);
5186 #ifndef WRITE_BUF_SIZE
5187 #define WRITE_BUF_SIZE (16 * 1024)
5190 /* Write text in the range START and END into descriptor DESC,
5191 encoding them with coding system CODING. If STRING is nil, START
5192 and END are character positions of the current buffer, else they
5193 are indexes to the string STRING. */
5196 e_write (desc
, string
, start
, end
, coding
)
5200 struct coding_system
*coding
;
5202 register char *addr
;
5203 register int nbytes
;
5204 char buf
[WRITE_BUF_SIZE
];
5208 coding
->composing
= COMPOSITION_DISABLED
;
5209 if (coding
->composing
!= COMPOSITION_DISABLED
)
5210 coding_save_composition (coding
, start
, end
, string
);
5212 if (STRINGP (string
))
5214 addr
= XSTRING (string
)->data
;
5215 nbytes
= STRING_BYTES (XSTRING (string
));
5216 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5218 else if (start
< end
)
5220 /* It is assured that the gap is not in the range START and END-1. */
5221 addr
= CHAR_POS_ADDR (start
);
5222 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5223 coding
->src_multibyte
5224 = !NILP (current_buffer
->enable_multibyte_characters
);
5230 coding
->src_multibyte
= 1;
5233 /* We used to have a code for handling selective display here. But,
5234 now it is handled within encode_coding. */
5239 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5240 if (coding
->produced
> 0)
5242 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5243 if (coding
->produced
)
5249 nbytes
-= coding
->consumed
;
5250 addr
+= coding
->consumed
;
5251 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5254 /* The source text ends by an incomplete multibyte form.
5255 There's no way other than write it out as is. */
5256 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5265 start
+= coding
->consumed_char
;
5266 if (coding
->cmp_data
)
5267 coding_adjust_composition_offset (coding
, start
);
5270 if (coding
->cmp_data
)
5271 coding_free_composition_data (coding
);
5276 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5277 Sverify_visited_file_modtime
, 1, 1, 0,
5278 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
5279 This means that the file has not been changed since it was visited or saved.")
5285 Lisp_Object handler
;
5286 Lisp_Object filename
;
5288 CHECK_BUFFER (buf
, 0);
5291 if (!STRINGP (b
->filename
)) return Qt
;
5292 if (b
->modtime
== 0) return Qt
;
5294 /* If the file name has special constructs in it,
5295 call the corresponding file handler. */
5296 handler
= Ffind_file_name_handler (b
->filename
,
5297 Qverify_visited_file_modtime
);
5298 if (!NILP (handler
))
5299 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5301 filename
= ENCODE_FILE (b
->filename
);
5303 if (stat (XSTRING (filename
)->data
, &st
) < 0)
5305 /* If the file doesn't exist now and didn't exist before,
5306 we say that it isn't modified, provided the error is a tame one. */
5307 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5312 if (st
.st_mtime
== b
->modtime
5313 /* If both are positive, accept them if they are off by one second. */
5314 || (st
.st_mtime
> 0 && b
->modtime
> 0
5315 && (st
.st_mtime
== b
->modtime
+ 1
5316 || st
.st_mtime
== b
->modtime
- 1)))
5321 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5322 Sclear_visited_file_modtime
, 0, 0, 0,
5323 "Clear out records of last mod time of visited file.\n\
5324 Next attempt to save will certainly not complain of a discrepancy.")
5327 current_buffer
->modtime
= 0;
5331 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5332 Svisited_file_modtime
, 0, 0, 0,
5333 "Return the current buffer's recorded visited file modification time.\n\
5334 The value is a list of the form (HIGH . LOW), like the time values\n\
5335 that `file-attributes' returns.")
5338 return long_to_cons ((unsigned long) current_buffer
->modtime
);
5341 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5342 Sset_visited_file_modtime
, 0, 1, 0,
5343 "Update buffer's recorded modification time from the visited file's time.\n\
5344 Useful if the buffer was not read from the file normally\n\
5345 or if the file itself has been changed for some known benign reason.\n\
5346 An argument specifies the modification time value to use\n\
5347 \(instead of that of the visited file), in the form of a list\n\
5348 \(HIGH . LOW) or (HIGH LOW).")
5350 Lisp_Object time_list
;
5352 if (!NILP (time_list
))
5353 current_buffer
->modtime
= cons_to_long (time_list
);
5356 register Lisp_Object filename
;
5358 Lisp_Object handler
;
5360 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5362 /* If the file name has special constructs in it,
5363 call the corresponding file handler. */
5364 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5365 if (!NILP (handler
))
5366 /* The handler can find the file name the same way we did. */
5367 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5369 filename
= ENCODE_FILE (filename
);
5371 if (stat (XSTRING (filename
)->data
, &st
) >= 0)
5372 current_buffer
->modtime
= st
.st_mtime
;
5379 auto_save_error (error
)
5382 Lisp_Object args
[3], msg
;
5384 struct gcpro gcpro1
;
5388 args
[0] = build_string ("Auto-saving %s: %s");
5389 args
[1] = current_buffer
->name
;
5390 args
[2] = Ferror_message_string (error
);
5391 msg
= Fformat (3, args
);
5393 nbytes
= STRING_BYTES (XSTRING (msg
));
5395 for (i
= 0; i
< 3; ++i
)
5398 message2 (XSTRING (msg
)->data
, nbytes
, STRING_MULTIBYTE (msg
));
5400 message2_nolog (XSTRING (msg
)->data
, nbytes
, STRING_MULTIBYTE (msg
));
5401 Fsleep_for (make_number (1), Qnil
);
5413 /* Get visited file's mode to become the auto save file's mode. */
5414 if (! NILP (current_buffer
->filename
)
5415 && stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
5416 /* But make sure we can overwrite it later! */
5417 auto_save_mode_bits
= st
.st_mode
| 0600;
5419 auto_save_mode_bits
= 0666;
5422 Fwrite_region (Qnil
, Qnil
,
5423 current_buffer
->auto_save_file_name
,
5424 Qnil
, Qlambda
, Qnil
, Qnil
);
5428 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5433 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5434 | XFASTINT (XCDR (stream
))));
5440 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5443 minibuffer_auto_raise
= XINT (value
);
5447 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5448 "Auto-save all buffers that need it.\n\
5449 This is all buffers that have auto-saving enabled\n\
5450 and are changed since last auto-saved.\n\
5451 Auto-saving writes the buffer into a file\n\
5452 so that your editing is not lost if the system crashes.\n\
5453 This file is not the file you visited; that changes only when you save.\n\
5454 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
5455 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
5456 A non-nil CURRENT-ONLY argument means save only current buffer.")
5457 (no_message
, current_only
)
5458 Lisp_Object no_message
, current_only
;
5460 struct buffer
*old
= current_buffer
, *b
;
5461 Lisp_Object tail
, buf
;
5463 int do_handled_files
;
5466 Lisp_Object lispstream
;
5467 int count
= specpdl_ptr
- specpdl
;
5468 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5469 int message_p
= push_message ();
5471 /* Ordinarily don't quit within this function,
5472 but don't make it impossible to quit (in case we get hung in I/O). */
5476 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5477 point to non-strings reached from Vbuffer_alist. */
5482 if (!NILP (Vrun_hooks
))
5483 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5485 if (STRINGP (Vauto_save_list_file_name
))
5487 Lisp_Object listfile
;
5489 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5491 /* Don't try to create the directory when shutting down Emacs,
5492 because creating the directory might signal an error, and
5493 that would leave Emacs in a strange state. */
5494 if (!NILP (Vrun_hooks
))
5497 dir
= Ffile_name_directory (listfile
);
5498 if (NILP (Ffile_directory_p (dir
)))
5499 call2 (Qmake_directory
, dir
, Qt
);
5502 stream
= fopen (XSTRING (listfile
)->data
, "w");
5505 /* Arrange to close that file whether or not we get an error.
5506 Also reset auto_saving to 0. */
5507 lispstream
= Fcons (Qnil
, Qnil
);
5508 XSETFASTINT (XCAR (lispstream
), (EMACS_UINT
)stream
>> 16);
5509 XSETFASTINT (XCDR (lispstream
), (EMACS_UINT
)stream
& 0xffff);
5520 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5521 record_unwind_protect (do_auto_save_unwind_1
,
5522 make_number (minibuffer_auto_raise
));
5523 minibuffer_auto_raise
= 0;
5526 /* First, save all files which don't have handlers. If Emacs is
5527 crashing, the handlers may tweak what is causing Emacs to crash
5528 in the first place, and it would be a shame if Emacs failed to
5529 autosave perfectly ordinary files because it couldn't handle some
5531 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5532 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5534 buf
= XCDR (XCAR (tail
));
5537 /* Record all the buffers that have auto save mode
5538 in the special file that lists them. For each of these buffers,
5539 Record visited name (if any) and auto save name. */
5540 if (STRINGP (b
->auto_save_file_name
)
5541 && stream
!= NULL
&& do_handled_files
== 0)
5543 if (!NILP (b
->filename
))
5545 fwrite (XSTRING (b
->filename
)->data
, 1,
5546 STRING_BYTES (XSTRING (b
->filename
)), stream
);
5548 putc ('\n', stream
);
5549 fwrite (XSTRING (b
->auto_save_file_name
)->data
, 1,
5550 STRING_BYTES (XSTRING (b
->auto_save_file_name
)), stream
);
5551 putc ('\n', stream
);
5554 if (!NILP (current_only
)
5555 && b
!= current_buffer
)
5558 /* Don't auto-save indirect buffers.
5559 The base buffer takes care of it. */
5563 /* Check for auto save enabled
5564 and file changed since last auto save
5565 and file changed since last real save. */
5566 if (STRINGP (b
->auto_save_file_name
)
5567 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5568 && b
->auto_save_modified
< BUF_MODIFF (b
)
5569 /* -1 means we've turned off autosaving for a while--see below. */
5570 && XINT (b
->save_length
) >= 0
5571 && (do_handled_files
5572 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5575 EMACS_TIME before_time
, after_time
;
5577 EMACS_GET_TIME (before_time
);
5579 /* If we had a failure, don't try again for 20 minutes. */
5580 if (b
->auto_save_failure_time
>= 0
5581 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5584 if ((XFASTINT (b
->save_length
) * 10
5585 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5586 /* A short file is likely to change a large fraction;
5587 spare the user annoying messages. */
5588 && XFASTINT (b
->save_length
) > 5000
5589 /* These messages are frequent and annoying for `*mail*'. */
5590 && !EQ (b
->filename
, Qnil
)
5591 && NILP (no_message
))
5593 /* It has shrunk too much; turn off auto-saving here. */
5594 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5595 message_with_string ("Buffer %s has shrunk a lot; auto save turned off there",
5597 minibuffer_auto_raise
= 0;
5598 /* Turn off auto-saving until there's a real save,
5599 and prevent any more warnings. */
5600 XSETINT (b
->save_length
, -1);
5601 Fsleep_for (make_number (1), Qnil
);
5604 set_buffer_internal (b
);
5605 if (!auto_saved
&& NILP (no_message
))
5606 message1 ("Auto-saving...");
5607 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5609 b
->auto_save_modified
= BUF_MODIFF (b
);
5610 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5611 set_buffer_internal (old
);
5613 EMACS_GET_TIME (after_time
);
5615 /* If auto-save took more than 60 seconds,
5616 assume it was an NFS failure that got a timeout. */
5617 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5618 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5622 /* Prevent another auto save till enough input events come in. */
5623 record_auto_save ();
5625 if (auto_saved
&& NILP (no_message
))
5629 sit_for (1, 0, 0, 0, 0);
5633 message1 ("Auto-saving...done");
5638 unbind_to (count
, Qnil
);
5642 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5643 Sset_buffer_auto_saved
, 0, 0, 0,
5644 "Mark current buffer as auto-saved with its current text.\n\
5645 No auto-save file will be written until the buffer changes again.")
5648 current_buffer
->auto_save_modified
= MODIFF
;
5649 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5650 current_buffer
->auto_save_failure_time
= -1;
5654 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5655 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5656 "Clear any record of a recent auto-save failure in the current buffer.")
5659 current_buffer
->auto_save_failure_time
= -1;
5663 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5665 "Return t if buffer has been auto-saved since last read in or saved.")
5668 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5671 /* Reading and completing file names */
5672 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
5674 /* In the string VAL, change each $ to $$ and return the result. */
5677 double_dollars (val
)
5680 register unsigned char *old
, *new;
5684 osize
= STRING_BYTES (XSTRING (val
));
5686 /* Count the number of $ characters. */
5687 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
5688 if (*old
++ == '$') count
++;
5691 old
= XSTRING (val
)->data
;
5692 val
= make_uninit_multibyte_string (XSTRING (val
)->size
+ count
,
5694 new = XSTRING (val
)->data
;
5695 for (n
= osize
; n
> 0; n
--)
5708 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
5710 "Internal subroutine for read-file-name. Do not call this.")
5711 (string
, dir
, action
)
5712 Lisp_Object string
, dir
, action
;
5713 /* action is nil for complete, t for return list of completions,
5714 lambda for verify final value */
5716 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
5718 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5720 CHECK_STRING (string
, 0);
5727 /* No need to protect ACTION--we only compare it with t and nil. */
5728 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
5730 if (XSTRING (string
)->size
== 0)
5732 if (EQ (action
, Qlambda
))
5740 orig_string
= string
;
5741 string
= Fsubstitute_in_file_name (string
);
5742 changed
= NILP (Fstring_equal (string
, orig_string
));
5743 name
= Ffile_name_nondirectory (string
);
5744 val
= Ffile_name_directory (string
);
5746 realdir
= Fexpand_file_name (val
, realdir
);
5751 specdir
= Ffile_name_directory (string
);
5752 val
= Ffile_name_completion (name
, realdir
);
5757 return double_dollars (string
);
5761 if (!NILP (specdir
))
5762 val
= concat2 (specdir
, val
);
5764 return double_dollars (val
);
5767 #endif /* not VMS */
5771 if (EQ (action
, Qt
))
5772 return Ffile_name_all_completions (name
, realdir
);
5773 /* Only other case actually used is ACTION = lambda */
5775 /* Supposedly this helps commands such as `cd' that read directory names,
5776 but can someone explain how it helps them? -- RMS */
5777 if (XSTRING (name
)->size
== 0)
5780 return Ffile_exists_p (string
);
5783 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
5784 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
5785 Value is not expanded---you must call `expand-file-name' yourself.\n\
5786 Default name to DEFAULT-FILENAME if user enters a null string.\n\
5787 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
5788 except that if INITIAL is specified, that combined with DIR is used.)\n\
5789 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
5790 Non-nil and non-t means also require confirmation after completion.\n\
5791 Fifth arg INITIAL specifies text to start with.\n\
5792 DIR defaults to current buffer's directory default.\n\
5794 If this command was invoked with the mouse, use a file dialog box if\n\
5795 `use-dialog-box' is non-nil, and the window system or X toolkit in use\n\
5796 provides a file dialog box..")
5797 (prompt
, dir
, default_filename
, mustmatch
, initial
)
5798 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
5800 Lisp_Object val
, insdef
, tem
;
5801 struct gcpro gcpro1
, gcpro2
;
5802 register char *homedir
;
5803 int replace_in_history
= 0;
5804 int add_to_history
= 0;
5808 dir
= current_buffer
->directory
;
5809 if (NILP (default_filename
))
5811 if (! NILP (initial
))
5812 default_filename
= Fexpand_file_name (initial
, dir
);
5814 default_filename
= current_buffer
->filename
;
5817 /* If dir starts with user's homedir, change that to ~. */
5818 homedir
= (char *) egetenv ("HOME");
5820 /* homedir can be NULL in temacs, since Vprocess_environment is not
5821 yet set up. We shouldn't crash in that case. */
5824 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
5825 CORRECT_DIR_SEPS (homedir
);
5830 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
5831 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
5833 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
5834 STRING_BYTES (XSTRING (dir
)) - strlen (homedir
) + 1);
5835 XSTRING (dir
)->data
[0] = '~';
5837 /* Likewise for default_filename. */
5839 && STRINGP (default_filename
)
5840 && !strncmp (homedir
, XSTRING (default_filename
)->data
, strlen (homedir
))
5841 && IS_DIRECTORY_SEP (XSTRING (default_filename
)->data
[strlen (homedir
)]))
5844 = make_string (XSTRING (default_filename
)->data
+ strlen (homedir
) - 1,
5845 STRING_BYTES (XSTRING (default_filename
)) - strlen (homedir
) + 1);
5846 XSTRING (default_filename
)->data
[0] = '~';
5848 if (!NILP (default_filename
))
5850 CHECK_STRING (default_filename
, 3);
5851 default_filename
= double_dollars (default_filename
);
5854 if (insert_default_directory
&& STRINGP (dir
))
5857 if (!NILP (initial
))
5859 Lisp_Object args
[2], pos
;
5863 insdef
= Fconcat (2, args
);
5864 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
5865 insdef
= Fcons (double_dollars (insdef
), pos
);
5868 insdef
= double_dollars (insdef
);
5870 else if (STRINGP (initial
))
5871 insdef
= Fcons (double_dollars (initial
), make_number (0));
5875 count
= specpdl_ptr
- specpdl
;
5877 specbind (intern ("completion-ignore-case"), Qt
);
5880 specbind (intern ("minibuffer-completing-file-name"), Qt
);
5882 GCPRO2 (insdef
, default_filename
);
5884 #if defined (USE_MOTIF) || defined (HAVE_NTGUI)
5885 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
5889 /* If DIR contains a file name, split it. */
5891 file
= Ffile_name_nondirectory (dir
);
5892 if (XSTRING (file
)->size
&& NILP (default_filename
))
5894 default_filename
= file
;
5895 dir
= Ffile_name_directory (dir
);
5897 if (!NILP(default_filename
))
5898 default_filename
= Fexpand_file_name (default_filename
, dir
);
5899 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
);
5904 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
5905 dir
, mustmatch
, insdef
,
5906 Qfile_name_history
, default_filename
, Qnil
);
5908 tem
= Fsymbol_value (Qfile_name_history
);
5909 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
5910 replace_in_history
= 1;
5912 /* If Fcompleting_read returned the inserted default string itself
5913 (rather than a new string with the same contents),
5914 it has to mean that the user typed RET with the minibuffer empty.
5915 In that case, we really want to return ""
5916 so that commands such as set-visited-file-name can distinguish. */
5917 if (EQ (val
, default_filename
))
5919 /* In this case, Fcompleting_read has not added an element
5920 to the history. Maybe we should. */
5921 if (! replace_in_history
)
5924 val
= build_string ("");
5927 unbind_to (count
, Qnil
);
5930 error ("No file name specified");
5932 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
5934 if (!NILP (tem
) && !NILP (default_filename
))
5935 val
= default_filename
;
5936 else if (XSTRING (val
)->size
== 0 && NILP (insdef
))
5938 if (!NILP (default_filename
))
5939 val
= default_filename
;
5941 error ("No default file name");
5943 val
= Fsubstitute_in_file_name (val
);
5945 if (replace_in_history
)
5946 /* Replace what Fcompleting_read added to the history
5947 with what we will actually return. */
5948 XCAR (Fsymbol_value (Qfile_name_history
)) = double_dollars (val
);
5949 else if (add_to_history
)
5951 /* Add the value to the history--but not if it matches
5952 the last value already there. */
5953 Lisp_Object val1
= double_dollars (val
);
5954 tem
= Fsymbol_value (Qfile_name_history
);
5955 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
5956 Fset (Qfile_name_history
,
5967 /* Must be set before any path manipulation is performed. */
5968 XSETFASTINT (Vdirectory_sep_char
, '/');
5975 Qexpand_file_name
= intern ("expand-file-name");
5976 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
5977 Qdirectory_file_name
= intern ("directory-file-name");
5978 Qfile_name_directory
= intern ("file-name-directory");
5979 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
5980 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
5981 Qfile_name_as_directory
= intern ("file-name-as-directory");
5982 Qcopy_file
= intern ("copy-file");
5983 Qmake_directory_internal
= intern ("make-directory-internal");
5984 Qmake_directory
= intern ("make-directory");
5985 Qdelete_directory
= intern ("delete-directory");
5986 Qdelete_file
= intern ("delete-file");
5987 Qrename_file
= intern ("rename-file");
5988 Qadd_name_to_file
= intern ("add-name-to-file");
5989 Qmake_symbolic_link
= intern ("make-symbolic-link");
5990 Qfile_exists_p
= intern ("file-exists-p");
5991 Qfile_executable_p
= intern ("file-executable-p");
5992 Qfile_readable_p
= intern ("file-readable-p");
5993 Qfile_writable_p
= intern ("file-writable-p");
5994 Qfile_symlink_p
= intern ("file-symlink-p");
5995 Qaccess_file
= intern ("access-file");
5996 Qfile_directory_p
= intern ("file-directory-p");
5997 Qfile_regular_p
= intern ("file-regular-p");
5998 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
5999 Qfile_modes
= intern ("file-modes");
6000 Qset_file_modes
= intern ("set-file-modes");
6001 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6002 Qinsert_file_contents
= intern ("insert-file-contents");
6003 Qwrite_region
= intern ("write-region");
6004 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6005 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6007 staticpro (&Qexpand_file_name
);
6008 staticpro (&Qsubstitute_in_file_name
);
6009 staticpro (&Qdirectory_file_name
);
6010 staticpro (&Qfile_name_directory
);
6011 staticpro (&Qfile_name_nondirectory
);
6012 staticpro (&Qunhandled_file_name_directory
);
6013 staticpro (&Qfile_name_as_directory
);
6014 staticpro (&Qcopy_file
);
6015 staticpro (&Qmake_directory_internal
);
6016 staticpro (&Qmake_directory
);
6017 staticpro (&Qdelete_directory
);
6018 staticpro (&Qdelete_file
);
6019 staticpro (&Qrename_file
);
6020 staticpro (&Qadd_name_to_file
);
6021 staticpro (&Qmake_symbolic_link
);
6022 staticpro (&Qfile_exists_p
);
6023 staticpro (&Qfile_executable_p
);
6024 staticpro (&Qfile_readable_p
);
6025 staticpro (&Qfile_writable_p
);
6026 staticpro (&Qaccess_file
);
6027 staticpro (&Qfile_symlink_p
);
6028 staticpro (&Qfile_directory_p
);
6029 staticpro (&Qfile_regular_p
);
6030 staticpro (&Qfile_accessible_directory_p
);
6031 staticpro (&Qfile_modes
);
6032 staticpro (&Qset_file_modes
);
6033 staticpro (&Qfile_newer_than_file_p
);
6034 staticpro (&Qinsert_file_contents
);
6035 staticpro (&Qwrite_region
);
6036 staticpro (&Qverify_visited_file_modtime
);
6037 staticpro (&Qset_visited_file_modtime
);
6039 Qfile_name_history
= intern ("file-name-history");
6040 Fset (Qfile_name_history
, Qnil
);
6041 staticpro (&Qfile_name_history
);
6043 Qfile_error
= intern ("file-error");
6044 staticpro (&Qfile_error
);
6045 Qfile_already_exists
= intern ("file-already-exists");
6046 staticpro (&Qfile_already_exists
);
6047 Qfile_date_error
= intern ("file-date-error");
6048 staticpro (&Qfile_date_error
);
6049 Qexcl
= intern ("excl");
6053 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6054 staticpro (&Qfind_buffer_file_type
);
6057 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6058 "*Coding system for encoding file names.\n\
6059 If it is nil, default-file-name-coding-system (which see) is used.");
6060 Vfile_name_coding_system
= Qnil
;
6062 DEFVAR_LISP ("default-file-name-coding-system",
6063 &Vdefault_file_name_coding_system
,
6064 "Default coding system for encoding file names.\n\
6065 This variable is used only when file-name-coding-system is nil.\n\
6067 This variable is set/changed by the command set-language-environment.\n\
6068 User should not set this variable manually,\n\
6069 instead use file-name-coding-system to get a constant encoding\n\
6070 of file names regardless of the current language environment.");
6071 Vdefault_file_name_coding_system
= Qnil
;
6073 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
6074 "*Format in which to write auto-save files.\n\
6075 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
6076 If it is t, which is the default, auto-save files are written in the\n\
6077 same format as a regular save would use.");
6078 Vauto_save_file_format
= Qt
;
6080 Qformat_decode
= intern ("format-decode");
6081 staticpro (&Qformat_decode
);
6082 Qformat_annotate_function
= intern ("format-annotate-function");
6083 staticpro (&Qformat_annotate_function
);
6085 Qcar_less_than_car
= intern ("car-less-than-car");
6086 staticpro (&Qcar_less_than_car
);
6088 Fput (Qfile_error
, Qerror_conditions
,
6089 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6090 Fput (Qfile_error
, Qerror_message
,
6091 build_string ("File error"));
6093 Fput (Qfile_already_exists
, Qerror_conditions
,
6094 Fcons (Qfile_already_exists
,
6095 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6096 Fput (Qfile_already_exists
, Qerror_message
,
6097 build_string ("File already exists"));
6099 Fput (Qfile_date_error
, Qerror_conditions
,
6100 Fcons (Qfile_date_error
,
6101 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6102 Fput (Qfile_date_error
, Qerror_message
,
6103 build_string ("Cannot set file date"));
6105 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6106 "*Non-nil means when reading a filename start with default dir in minibuffer.");
6107 insert_default_directory
= 1;
6109 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6110 "*Non-nil means write new files with record format `stmlf'.\n\
6111 nil means use format `var'. This variable is meaningful only on VMS.");
6112 vms_stmlf_recfm
= 0;
6114 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6115 "Directory separator character for built-in functions that return file names.\n\
6116 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
6117 This variable affects the built-in functions only on Windows,\n\
6118 on other platforms, it is initialized so that Lisp code can find out\n\
6119 what the normal separator is.\n\
6121 WARNING: This variable is deprecated and will be removed in the near\n\
6122 future. DO NOT USE IT.");
6124 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6125 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
6126 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
6129 The first argument given to HANDLER is the name of the I/O primitive\n\
6130 to be handled; the remaining arguments are the arguments that were\n\
6131 passed to that primitive. For example, if you do\n\
6132 (file-exists-p FILENAME)\n\
6133 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
6134 (funcall HANDLER 'file-exists-p FILENAME)\n\
6135 The function `find-file-name-handler' checks this list for a handler\n\
6136 for its argument.");
6137 Vfile_name_handler_alist
= Qnil
;
6139 DEFVAR_LISP ("set-auto-coding-function",
6140 &Vset_auto_coding_function
,
6141 "If non-nil, a function to call to decide a coding system of file.\n\
6142 Two arguments are passed to this function: the file name\n\
6143 and the length of a file contents following the point.\n\
6144 This function should return a coding system to decode the file contents.\n\
6145 It should check the file name against `auto-coding-alist'.\n\
6146 If no coding system is decided, it should check a coding system\n\
6147 specified in the heading lines with the format:\n\
6148 -*- ... coding: CODING-SYSTEM; ... -*-\n\
6149 or local variable spec of the tailing lines with `coding:' tag.");
6150 Vset_auto_coding_function
= Qnil
;
6152 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6153 "A list of functions to be called at the end of `insert-file-contents'.\n\
6154 Each is passed one argument, the number of bytes inserted. It should return\n\
6155 the new byte count, and leave point the same. If `insert-file-contents' is\n\
6156 intercepted by a handler from `file-name-handler-alist', that handler is\n\
6157 responsible for calling the after-insert-file-functions if appropriate.");
6158 Vafter_insert_file_functions
= Qnil
;
6160 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6161 "A list of functions to be called at the start of `write-region'.\n\
6162 Each is passed two arguments, START and END as for `write-region'.\n\
6163 These are usually two numbers but not always; see the documentation\n\
6164 for `write-region'. The function should return a list of pairs\n\
6165 of the form (POSITION . STRING), consisting of strings to be effectively\n\
6166 inserted at the specified positions of the file being written (1 means to\n\
6167 insert before the first byte written). The POSITIONs must be sorted into\n\
6168 increasing order. If there are several functions in the list, the several\n\
6169 lists are merged destructively.");
6170 Vwrite_region_annotate_functions
= Qnil
;
6172 DEFVAR_LISP ("write-region-annotations-so-far",
6173 &Vwrite_region_annotations_so_far
,
6174 "When an annotation function is called, this holds the previous annotations.\n\
6175 These are the annotations made by other annotation functions\n\
6176 that were already called. See also `write-region-annotate-functions'.");
6177 Vwrite_region_annotations_so_far
= Qnil
;
6179 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6180 "A list of file name handlers that temporarily should not be used.\n\
6181 This applies only to the operation `inhibit-file-name-operation'.");
6182 Vinhibit_file_name_handlers
= Qnil
;
6184 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6185 "The operation for which `inhibit-file-name-handlers' is applicable.");
6186 Vinhibit_file_name_operation
= Qnil
;
6188 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6189 "File name in which we write a list of all auto save file names.\n\
6190 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
6191 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
6193 Vauto_save_list_file_name
= Qnil
;
6195 defsubr (&Sfind_file_name_handler
);
6196 defsubr (&Sfile_name_directory
);
6197 defsubr (&Sfile_name_nondirectory
);
6198 defsubr (&Sunhandled_file_name_directory
);
6199 defsubr (&Sfile_name_as_directory
);
6200 defsubr (&Sdirectory_file_name
);
6201 defsubr (&Smake_temp_name
);
6202 defsubr (&Sexpand_file_name
);
6203 defsubr (&Ssubstitute_in_file_name
);
6204 defsubr (&Scopy_file
);
6205 defsubr (&Smake_directory_internal
);
6206 defsubr (&Sdelete_directory
);
6207 defsubr (&Sdelete_file
);
6208 defsubr (&Srename_file
);
6209 defsubr (&Sadd_name_to_file
);
6211 defsubr (&Smake_symbolic_link
);
6212 #endif /* S_IFLNK */
6214 defsubr (&Sdefine_logical_name
);
6217 defsubr (&Ssysnetunam
);
6218 #endif /* HPUX_NET */
6219 defsubr (&Sfile_name_absolute_p
);
6220 defsubr (&Sfile_exists_p
);
6221 defsubr (&Sfile_executable_p
);
6222 defsubr (&Sfile_readable_p
);
6223 defsubr (&Sfile_writable_p
);
6224 defsubr (&Saccess_file
);
6225 defsubr (&Sfile_symlink_p
);
6226 defsubr (&Sfile_directory_p
);
6227 defsubr (&Sfile_accessible_directory_p
);
6228 defsubr (&Sfile_regular_p
);
6229 defsubr (&Sfile_modes
);
6230 defsubr (&Sset_file_modes
);
6231 defsubr (&Sset_default_file_modes
);
6232 defsubr (&Sdefault_file_modes
);
6233 defsubr (&Sfile_newer_than_file_p
);
6234 defsubr (&Sinsert_file_contents
);
6235 defsubr (&Swrite_region
);
6236 defsubr (&Scar_less_than_car
);
6237 defsubr (&Sverify_visited_file_modtime
);
6238 defsubr (&Sclear_visited_file_modtime
);
6239 defsubr (&Svisited_file_modtime
);
6240 defsubr (&Sset_visited_file_modtime
);
6241 defsubr (&Sdo_auto_save
);
6242 defsubr (&Sset_buffer_auto_saved
);
6243 defsubr (&Sclear_buffer_auto_save_failure
);
6244 defsubr (&Srecent_auto_save_p
);
6246 defsubr (&Sread_file_name_internal
);
6247 defsubr (&Sread_file_name
);
6250 defsubr (&Sunix_sync
);