1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996, 1997, 1998,
3 1999, 2000, 2001, 2003, 2004 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
29 #include <sys/types.h>
36 #if !defined (S_ISLNK) && defined (S_IFLNK)
37 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
40 #if !defined (S_ISFIFO) && defined (S_IFIFO)
41 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
44 #if !defined (S_ISREG) && defined (S_IFREG)
45 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
76 #include "intervals.h"
87 #endif /* not WINDOWSNT */
91 #include <sys/param.h>
99 #define CORRECT_DIR_SEPS(s) \
100 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
101 else unixtodos_filename (s); \
103 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
104 redirector allows the six letters between 'Z' and 'a' as well. */
106 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
109 #define IS_DRIVE(x) isalpha (x)
111 /* Need to lower-case the drive letter, or else expanded
112 filenames will sometimes compare inequal, because
113 `expand-file-name' doesn't always down-case the drive letter. */
114 #define DRIVE_LETTER(x) (tolower (x))
135 #include "commands.h"
136 extern int use_dialog_box
;
137 extern int use_file_dialog
;
151 /* Nonzero during writing of auto-save files */
154 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
155 a new file with the same mode as the original */
156 int auto_save_mode_bits
;
158 /* The symbol bound to coding-system-for-read when
159 insert-file-contents is called for recovering a file. This is not
160 an actual coding system name, but just an indicator to tell
161 insert-file-contents to use `emacs-mule' with a special flag for
162 auto saving and recovering a file. */
163 Lisp_Object Qauto_save_coding
;
165 /* Coding system for file names, or nil if none. */
166 Lisp_Object Vfile_name_coding_system
;
168 /* Coding system for file names used only when
169 Vfile_name_coding_system is nil. */
170 Lisp_Object Vdefault_file_name_coding_system
;
172 /* Alist of elements (REGEXP . HANDLER) for file names
173 whose I/O is done with a special handler. */
174 Lisp_Object Vfile_name_handler_alist
;
176 /* Lisp functions for translating file formats */
177 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
179 /* Function to be called to decide a coding system of a reading file. */
180 Lisp_Object Vset_auto_coding_function
;
182 /* Functions to be called to process text properties in inserted file. */
183 Lisp_Object Vafter_insert_file_functions
;
185 /* Lisp function for setting buffer-file-coding-system and the
186 multibyteness of the current buffer after inserting a file. */
187 Lisp_Object Qafter_insert_file_set_coding
;
189 /* Functions to be called to create text property annotations for file. */
190 Lisp_Object Vwrite_region_annotate_functions
;
191 Lisp_Object Qwrite_region_annotate_functions
;
193 /* During build_annotations, each time an annotation function is called,
194 this holds the annotations made by the previous functions. */
195 Lisp_Object Vwrite_region_annotations_so_far
;
197 /* File name in which we write a list of all our auto save files. */
198 Lisp_Object Vauto_save_list_file_name
;
200 /* Function to call to read a file name. */
201 Lisp_Object Vread_file_name_function
;
203 /* Current predicate used by read_file_name_internal. */
204 Lisp_Object Vread_file_name_predicate
;
206 /* Nonzero means completion ignores case when reading file name. */
207 int read_file_name_completion_ignore_case
;
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 (SREF (errstring
, 1) != '/')
274 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 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 Qset_file_times
;
327 Lisp_Object Qfile_newer_than_file_p
;
328 Lisp_Object Qinsert_file_contents
;
329 Lisp_Object Qwrite_region
;
330 Lisp_Object Qverify_visited_file_modtime
;
331 Lisp_Object Qset_visited_file_modtime
;
333 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
334 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
335 Otherwise, return nil.
336 A file name is handled if one of the regular expressions in
337 `file-name-handler-alist' matches it.
339 If OPERATION equals `inhibit-file-name-operation', then we ignore
340 any handlers that are members of `inhibit-file-name-handlers',
341 but we still do run any other handlers. This lets handlers
342 use the standard functions without calling themselves recursively. */)
343 (filename
, operation
)
344 Lisp_Object filename
, operation
;
346 /* This function must not munge the match data. */
347 Lisp_Object chain
, inhibited_handlers
, result
;
351 CHECK_STRING (filename
);
353 if (EQ (operation
, Vinhibit_file_name_operation
))
354 inhibited_handlers
= Vinhibit_file_name_handlers
;
356 inhibited_handlers
= Qnil
;
358 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
359 chain
= XCDR (chain
))
369 && (match_pos
= fast_string_match (string
, filename
)) > pos
)
371 Lisp_Object handler
, tem
;
373 handler
= XCDR (elt
);
374 tem
= Fmemq (handler
, inhibited_handlers
);
388 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
390 doc
: /* Return the directory component in file name FILENAME.
391 Return nil if FILENAME does not include a directory.
392 Otherwise return a directory spec.
393 Given a Unix syntax file name, returns a string ending in slash;
394 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
396 Lisp_Object filename
;
399 register const unsigned char *beg
;
401 register unsigned char *beg
;
403 register const unsigned char *p
;
406 CHECK_STRING (filename
);
408 /* If the file name has special constructs in it,
409 call the corresponding file handler. */
410 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
412 return call2 (handler
, Qfile_name_directory
, filename
);
414 #ifdef FILE_SYSTEM_CASE
415 filename
= FILE_SYSTEM_CASE (filename
);
417 beg
= SDATA (filename
);
419 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
421 p
= beg
+ SBYTES (filename
);
423 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
425 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
428 /* only recognise drive specifier at the beginning */
430 /* handle the "/:d:foo" and "/:foo" cases correctly */
431 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
432 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
439 /* Expansion of "c:" to drive and default directory. */
442 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
443 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
444 unsigned char *r
= res
;
446 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
448 strncpy (res
, beg
, 2);
453 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
455 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
458 p
= beg
+ strlen (beg
);
461 CORRECT_DIR_SEPS (beg
);
464 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
467 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
468 Sfile_name_nondirectory
, 1, 1, 0,
469 doc
: /* Return file name FILENAME sans its directory.
470 For example, in a Unix-syntax file name,
471 this is everything after the last slash,
472 or the entire name if it contains no slash. */)
474 Lisp_Object filename
;
476 register const unsigned char *beg
, *p
, *end
;
479 CHECK_STRING (filename
);
481 /* If the file name has special constructs in it,
482 call the corresponding file handler. */
483 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
485 return call2 (handler
, Qfile_name_nondirectory
, filename
);
487 beg
= SDATA (filename
);
488 end
= p
= beg
+ SBYTES (filename
);
490 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
492 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
495 /* only recognise drive specifier at beginning */
497 /* handle the "/:d:foo" case correctly */
498 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
503 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
506 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
507 Sunhandled_file_name_directory
, 1, 1, 0,
508 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
509 A `directly usable' directory name is one that may be used without the
510 intervention of any file handler.
511 If FILENAME is a directly usable file itself, return
512 \(file-name-directory FILENAME).
513 The `call-process' and `start-process' functions use this function to
514 get a current directory to run processes in. */)
516 Lisp_Object filename
;
520 /* If the file name has special constructs in it,
521 call the corresponding file handler. */
522 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
524 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
526 return Ffile_name_directory (filename
);
531 file_name_as_directory (out
, in
)
534 int size
= strlen (in
) - 1;
547 /* Is it already a directory string? */
548 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
550 /* Is it a VMS directory file name? If so, hack VMS syntax. */
551 else if (! index (in
, '/')
552 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
553 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
554 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
555 || ! strncmp (&in
[size
- 5], ".dir", 4))
556 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
557 && in
[size
] == '1')))
559 register char *p
, *dot
;
563 dir:x.dir --> dir:[x]
564 dir:[x]y.dir --> dir:[x.y] */
566 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
569 strncpy (out
, in
, p
- in
);
588 dot
= index (p
, '.');
591 /* blindly remove any extension */
592 size
= strlen (out
) + (dot
- p
);
593 strncat (out
, p
, dot
- p
);
604 /* For Unix syntax, Append a slash if necessary */
605 if (!IS_DIRECTORY_SEP (out
[size
]))
607 /* Cannot use DIRECTORY_SEP, which could have any value */
609 out
[size
+ 2] = '\0';
612 CORRECT_DIR_SEPS (out
);
618 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
619 Sfile_name_as_directory
, 1, 1, 0,
620 doc
: /* Return a string representing the file name FILE interpreted as a directory.
621 This operation exists because a directory is also a file, but its name as
622 a directory is different from its name as a file.
623 The result can be used as the value of `default-directory'
624 or passed as second argument to `expand-file-name'.
625 For a Unix-syntax file name, just appends a slash.
626 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
637 /* If the file name has special constructs in it,
638 call the corresponding file handler. */
639 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
641 return call2 (handler
, Qfile_name_as_directory
, file
);
643 buf
= (char *) alloca (SBYTES (file
) + 10);
644 file_name_as_directory (buf
, SDATA (file
));
645 return make_specified_string (buf
, -1, strlen (buf
),
646 STRING_MULTIBYTE (file
));
650 * Convert from directory name to filename.
652 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
653 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
654 * On UNIX, it's simple: just make sure there isn't a terminating /
656 * Value is nonzero if the string output is different from the input.
660 directory_file_name (src
, dst
)
668 struct FAB fab
= cc$rms_fab
;
669 struct NAM nam
= cc$rms_nam
;
670 char esa
[NAM$C_MAXRSS
];
675 if (! index (src
, '/')
676 && (src
[slen
- 1] == ']'
677 || src
[slen
- 1] == ':'
678 || src
[slen
- 1] == '>'))
680 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
682 fab
.fab$b_fns
= slen
;
683 fab
.fab$l_nam
= &nam
;
684 fab
.fab$l_fop
= FAB$M_NAM
;
687 nam
.nam$b_ess
= sizeof esa
;
688 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
690 /* We call SYS$PARSE to handle such things as [--] for us. */
691 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
693 slen
= nam
.nam$b_esl
;
694 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
699 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
701 /* what about when we have logical_name:???? */
702 if (src
[slen
- 1] == ':')
703 { /* Xlate logical name and see what we get */
704 ptr
= strcpy (dst
, src
); /* upper case for getenv */
707 if ('a' <= *ptr
&& *ptr
<= 'z')
711 dst
[slen
- 1] = 0; /* remove colon */
712 if (!(src
= egetenv (dst
)))
714 /* should we jump to the beginning of this procedure?
715 Good points: allows us to use logical names that xlate
717 Bad points: can be a problem if we just translated to a device
719 For now, I'll punt and always expect VMS names, and hope for
722 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
723 { /* no recursion here! */
729 { /* not a directory spec */
734 bracket
= src
[slen
- 1];
736 /* If bracket is ']' or '>', bracket - 2 is the corresponding
738 ptr
= index (src
, bracket
- 2);
740 { /* no opening bracket */
744 if (!(rptr
= rindex (src
, '.')))
747 strncpy (dst
, src
, slen
);
751 dst
[slen
++] = bracket
;
756 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
757 then translate the device and recurse. */
758 if (dst
[slen
- 1] == ':'
759 && dst
[slen
- 2] != ':' /* skip decnet nodes */
760 && strcmp (src
+ slen
, "[000000]") == 0)
762 dst
[slen
- 1] = '\0';
763 if ((ptr
= egetenv (dst
))
764 && (rlen
= strlen (ptr
) - 1) > 0
765 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
766 && ptr
[rlen
- 1] == '.')
768 char * buf
= (char *) alloca (strlen (ptr
) + 1);
772 return directory_file_name (buf
, dst
);
777 strcat (dst
, "[000000]");
781 rlen
= strlen (rptr
) - 1;
782 strncat (dst
, rptr
, rlen
);
783 dst
[slen
+ rlen
] = '\0';
784 strcat (dst
, ".DIR.1");
788 /* Process as Unix format: just remove any final slash.
789 But leave "/" unchanged; do not change it to "". */
792 /* Handle // as root for apollo's. */
793 if ((slen
> 2 && dst
[slen
- 1] == '/')
794 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
798 && IS_DIRECTORY_SEP (dst
[slen
- 1])
800 && !IS_ANY_SEP (dst
[slen
- 2])
806 CORRECT_DIR_SEPS (dst
);
811 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
813 doc
: /* Returns the file name of the directory named DIRECTORY.
814 This is the name of the file that holds the data for the directory DIRECTORY.
815 This operation exists because a directory is also a file, but its name as
816 a directory is different from its name as a file.
817 In Unix-syntax, this function just removes the final slash.
818 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
819 it returns a file name such as \"[X]Y.DIR.1\". */)
821 Lisp_Object directory
;
826 CHECK_STRING (directory
);
828 if (NILP (directory
))
831 /* If the file name has special constructs in it,
832 call the corresponding file handler. */
833 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
835 return call2 (handler
, Qdirectory_file_name
, directory
);
838 /* 20 extra chars is insufficient for VMS, since we might perform a
839 logical name translation. an equivalence string can be up to 255
840 chars long, so grab that much extra space... - sss */
841 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
843 buf
= (char *) alloca (SBYTES (directory
) + 20);
845 directory_file_name (SDATA (directory
), buf
);
846 return make_specified_string (buf
, -1, strlen (buf
),
847 STRING_MULTIBYTE (directory
));
850 static char make_temp_name_tbl
[64] =
852 'A','B','C','D','E','F','G','H',
853 'I','J','K','L','M','N','O','P',
854 'Q','R','S','T','U','V','W','X',
855 'Y','Z','a','b','c','d','e','f',
856 'g','h','i','j','k','l','m','n',
857 'o','p','q','r','s','t','u','v',
858 'w','x','y','z','0','1','2','3',
859 '4','5','6','7','8','9','-','_'
862 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
864 /* Value is a temporary file name starting with PREFIX, a string.
866 The Emacs process number forms part of the result, so there is
867 no danger of generating a name being used by another process.
868 In addition, this function makes an attempt to choose a name
869 which has no existing file. To make this work, PREFIX should be
870 an absolute file name.
872 BASE64_P non-zero means add the pid as 3 characters in base64
873 encoding. In this case, 6 characters will be added to PREFIX to
874 form the file name. Otherwise, if Emacs is running on a system
875 with long file names, add the pid as a decimal number.
877 This function signals an error if no unique file name could be
881 make_temp_name (prefix
, base64_p
)
888 unsigned char *p
, *data
;
892 CHECK_STRING (prefix
);
894 /* VAL is created by adding 6 characters to PREFIX. The first
895 three are the PID of this process, in base 64, and the second
896 three are incremented if the file already exists. This ensures
897 262144 unique file names per PID per PREFIX. */
899 pid
= (int) getpid ();
903 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
904 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
905 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
910 #ifdef HAVE_LONG_FILE_NAMES
911 sprintf (pidbuf
, "%d", pid
);
912 pidlen
= strlen (pidbuf
);
914 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
915 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
916 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
921 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
922 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
923 if (!STRING_MULTIBYTE (prefix
))
924 STRING_SET_UNIBYTE (val
);
926 bcopy(SDATA (prefix
), data
, len
);
929 bcopy (pidbuf
, p
, pidlen
);
932 /* Here we try to minimize useless stat'ing when this function is
933 invoked many times successively with the same PREFIX. We achieve
934 this by initializing count to a random value, and incrementing it
937 We don't want make-temp-name to be called while dumping,
938 because then make_temp_name_count_initialized_p would get set
939 and then make_temp_name_count would not be set when Emacs starts. */
941 if (!make_temp_name_count_initialized_p
)
943 make_temp_name_count
= (unsigned) time (NULL
);
944 make_temp_name_count_initialized_p
= 1;
950 unsigned num
= make_temp_name_count
;
952 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
953 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
954 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
956 /* Poor man's congruential RN generator. Replace with
957 ++make_temp_name_count for debugging. */
958 make_temp_name_count
+= 25229;
959 make_temp_name_count
%= 225307;
961 if (stat (data
, &ignored
) < 0)
963 /* We want to return only if errno is ENOENT. */
967 /* The error here is dubious, but there is little else we
968 can do. The alternatives are to return nil, which is
969 as bad as (and in many cases worse than) throwing the
970 error, or to ignore the error, which will likely result
971 in looping through 225307 stat's, which is not only
972 dog-slow, but also useless since it will fallback to
973 the errow below, anyway. */
974 report_file_error ("Cannot create temporary name for prefix",
975 Fcons (prefix
, Qnil
));
980 error ("Cannot create temporary name for prefix `%s'",
986 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
987 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
988 The Emacs process number forms part of the result,
989 so there is no danger of generating a name being used by another process.
991 In addition, this function makes an attempt to choose a name
992 which has no existing file. To make this work,
993 PREFIX should be an absolute file name.
995 There is a race condition between calling `make-temp-name' and creating the
996 file which opens all kinds of security holes. For that reason, you should
997 probably use `make-temp-file' instead, except in three circumstances:
999 * If you are creating the file in the user's home directory.
1000 * If you are creating a directory rather than an ordinary file.
1001 * If you are taking special precautions as `make-temp-file' does. */)
1005 return make_temp_name (prefix
, 0);
1010 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1011 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1012 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1013 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
1014 the current buffer's value of default-directory is used.
1015 File name components that are `.' are removed, and
1016 so are file name components followed by `..', along with the `..' itself;
1017 note that these simplifications are done without checking the resulting
1018 file names in the file system.
1019 An initial `~/' expands to your home directory.
1020 An initial `~USER/' expands to USER's home directory.
1021 See also the function `substitute-in-file-name'. */)
1022 (name
, default_directory
)
1023 Lisp_Object name
, default_directory
;
1027 register unsigned char *newdir
, *p
, *o
;
1029 unsigned char *target
;
1032 unsigned char * colon
= 0;
1033 unsigned char * close
= 0;
1034 unsigned char * slash
= 0;
1035 unsigned char * brack
= 0;
1036 int lbrack
= 0, rbrack
= 0;
1041 int collapse_newdir
= 1;
1045 Lisp_Object handler
, result
;
1047 CHECK_STRING (name
);
1049 /* If the file name has special constructs in it,
1050 call the corresponding file handler. */
1051 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1052 if (!NILP (handler
))
1053 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1055 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1056 if (NILP (default_directory
))
1057 default_directory
= current_buffer
->directory
;
1058 if (! STRINGP (default_directory
))
1061 /* "/" is not considered a root directory on DOS_NT, so using "/"
1062 here causes an infinite recursion in, e.g., the following:
1064 (let (default-directory)
1065 (expand-file-name "a"))
1067 To avoid this, we set default_directory to the root of the
1069 extern char *emacs_root_dir (void);
1071 default_directory
= build_string (emacs_root_dir ());
1073 default_directory
= build_string ("/");
1077 if (!NILP (default_directory
))
1079 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1080 if (!NILP (handler
))
1081 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1084 o
= SDATA (default_directory
);
1086 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1087 It would be better to do this down below where we actually use
1088 default_directory. Unfortunately, calling Fexpand_file_name recursively
1089 could invoke GC, and the strings might be relocated. This would
1090 be annoying because we have pointers into strings lying around
1091 that would need adjusting, and people would add new pointers to
1092 the code and forget to adjust them, resulting in intermittent bugs.
1093 Putting this call here avoids all that crud.
1095 The EQ test avoids infinite recursion. */
1096 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1097 /* Save time in some common cases - as long as default_directory
1098 is not relative, it can be canonicalized with name below (if it
1099 is needed at all) without requiring it to be expanded now. */
1101 /* Detect MSDOS file names with drive specifiers. */
1102 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1104 /* Detect Windows file names in UNC format. */
1105 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1107 #else /* not DOS_NT */
1108 /* Detect Unix absolute file names (/... alone is not absolute on
1110 && ! (IS_DIRECTORY_SEP (o
[0]))
1111 #endif /* not DOS_NT */
1114 struct gcpro gcpro1
;
1117 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1122 /* Filenames on VMS are always upper case. */
1123 name
= Fupcase (name
);
1125 #ifdef FILE_SYSTEM_CASE
1126 name
= FILE_SYSTEM_CASE (name
);
1132 /* We will force directory separators to be either all \ or /, so make
1133 a local copy to modify, even if there ends up being no change. */
1134 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1136 /* Note if special escape prefix is present, but remove for now. */
1137 if (nm
[0] == '/' && nm
[1] == ':')
1143 /* Find and remove drive specifier if present; this makes nm absolute
1144 even if the rest of the name appears to be relative. Only look for
1145 drive specifier at the beginning. */
1146 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1153 /* If we see "c://somedir", we want to strip the first slash after the
1154 colon when stripping the drive letter. Otherwise, this expands to
1156 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1158 #endif /* WINDOWSNT */
1162 /* Discard any previous drive specifier if nm is now in UNC format. */
1163 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1169 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1170 none are found, we can probably return right away. We will avoid
1171 allocating a new string if name is already fully expanded. */
1173 IS_DIRECTORY_SEP (nm
[0])
1175 && drive
&& !is_escaped
1178 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1185 /* If it turns out that the filename we want to return is just a
1186 suffix of FILENAME, we don't need to go through and edit
1187 things; we just need to construct a new string using data
1188 starting at the middle of FILENAME. If we set lose to a
1189 non-zero value, that means we've discovered that we can't do
1196 /* Since we know the name is absolute, we can assume that each
1197 element starts with a "/". */
1199 /* "." and ".." are hairy. */
1200 if (IS_DIRECTORY_SEP (p
[0])
1202 && (IS_DIRECTORY_SEP (p
[2])
1204 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1207 /* We want to replace multiple `/' in a row with a single
1210 && IS_DIRECTORY_SEP (p
[0])
1211 && IS_DIRECTORY_SEP (p
[1]))
1218 /* if dev:[dir]/, move nm to / */
1219 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1220 nm
= (brack
? brack
+ 1 : colon
+ 1);
1221 lbrack
= rbrack
= 0;
1229 /* VMS pre V4.4,convert '-'s in filenames. */
1230 if (lbrack
== rbrack
)
1232 if (dots
< 2) /* this is to allow negative version numbers */
1237 if (lbrack
> rbrack
&&
1238 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1239 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1245 /* count open brackets, reset close bracket pointer */
1246 if (p
[0] == '[' || p
[0] == '<')
1247 lbrack
++, brack
= 0;
1248 /* count close brackets, set close bracket pointer */
1249 if (p
[0] == ']' || p
[0] == '>')
1250 rbrack
++, brack
= p
;
1251 /* detect ][ or >< */
1252 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1254 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1255 nm
= p
+ 1, lose
= 1;
1256 if (p
[0] == ':' && (colon
|| slash
))
1257 /* if dev1:[dir]dev2:, move nm to dev2: */
1263 /* if /name/dev:, move nm to dev: */
1266 /* if node::dev:, move colon following dev */
1267 else if (colon
&& colon
[-1] == ':')
1269 /* if dev1:dev2:, move nm to dev2: */
1270 else if (colon
&& colon
[-1] != ':')
1275 if (p
[0] == ':' && !colon
)
1281 if (lbrack
== rbrack
)
1284 else if (p
[0] == '.')
1292 if (index (nm
, '/'))
1294 nm
= sys_translate_unix (nm
);
1295 return make_specified_string (nm
, -1, strlen (nm
),
1296 STRING_MULTIBYTE (name
));
1300 /* Make sure directories are all separated with / or \ as
1301 desired, but avoid allocation of a new string when not
1303 CORRECT_DIR_SEPS (nm
);
1305 if (IS_DIRECTORY_SEP (nm
[1]))
1307 if (strcmp (nm
, SDATA (name
)) != 0)
1308 name
= make_specified_string (nm
, -1, strlen (nm
),
1309 STRING_MULTIBYTE (name
));
1313 /* drive must be set, so this is okay */
1314 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1318 name
= make_specified_string (nm
, -1, p
- nm
,
1319 STRING_MULTIBYTE (name
));
1320 temp
[0] = DRIVE_LETTER (drive
);
1321 name
= concat2 (build_string (temp
), name
);
1324 #else /* not DOS_NT */
1325 if (nm
== SDATA (name
))
1327 return make_specified_string (nm
, -1, strlen (nm
),
1328 STRING_MULTIBYTE (name
));
1329 #endif /* not DOS_NT */
1333 /* At this point, nm might or might not be an absolute file name. We
1334 need to expand ~ or ~user if present, otherwise prefix nm with
1335 default_directory if nm is not absolute, and finally collapse /./
1336 and /foo/../ sequences.
1338 We set newdir to be the appropriate prefix if one is needed:
1339 - the relevant user directory if nm starts with ~ or ~user
1340 - the specified drive's working dir (DOS/NT only) if nm does not
1342 - the value of default_directory.
1344 Note that these prefixes are not guaranteed to be absolute (except
1345 for the working dir of a drive). Therefore, to ensure we always
1346 return an absolute name, if the final prefix is not absolute we
1347 append it to the current working directory. */
1351 if (nm
[0] == '~') /* prefix ~ */
1353 if (IS_DIRECTORY_SEP (nm
[1])
1357 || nm
[1] == 0) /* ~ by itself */
1359 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1360 newdir
= (unsigned char *) "";
1363 collapse_newdir
= 0;
1366 nm
++; /* Don't leave the slash in nm. */
1369 else /* ~user/filename */
1371 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1376 o
= (unsigned char *) alloca (p
- nm
+ 1);
1377 bcopy ((char *) nm
, o
, p
- nm
);
1380 pw
= (struct passwd
*) getpwnam (o
+ 1);
1383 newdir
= (unsigned char *) pw
-> pw_dir
;
1385 nm
= p
+ 1; /* skip the terminator */
1389 collapse_newdir
= 0;
1394 /* If we don't find a user of that name, leave the name
1395 unchanged; don't move nm forward to p. */
1400 /* On DOS and Windows, nm is absolute if a drive name was specified;
1401 use the drive's current directory as the prefix if needed. */
1402 if (!newdir
&& drive
)
1404 /* Get default directory if needed to make nm absolute. */
1405 if (!IS_DIRECTORY_SEP (nm
[0]))
1407 newdir
= alloca (MAXPATHLEN
+ 1);
1408 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1413 /* Either nm starts with /, or drive isn't mounted. */
1414 newdir
= alloca (4);
1415 newdir
[0] = DRIVE_LETTER (drive
);
1423 /* Finally, if no prefix has been specified and nm is not absolute,
1424 then it must be expanded relative to default_directory. */
1428 /* /... alone is not absolute on DOS and Windows. */
1429 && !IS_DIRECTORY_SEP (nm
[0])
1432 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1439 newdir
= SDATA (default_directory
);
1441 /* Note if special escape prefix is present, but remove for now. */
1442 if (newdir
[0] == '/' && newdir
[1] == ':')
1453 /* First ensure newdir is an absolute name. */
1455 /* Detect MSDOS file names with drive specifiers. */
1456 ! (IS_DRIVE (newdir
[0])
1457 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1459 /* Detect Windows file names in UNC format. */
1460 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1464 /* Effectively, let newdir be (expand-file-name newdir cwd).
1465 Because of the admonition against calling expand-file-name
1466 when we have pointers into lisp strings, we accomplish this
1467 indirectly by prepending newdir to nm if necessary, and using
1468 cwd (or the wd of newdir's drive) as the new newdir. */
1470 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1475 if (!IS_DIRECTORY_SEP (nm
[0]))
1477 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1478 file_name_as_directory (tmp
, newdir
);
1482 newdir
= alloca (MAXPATHLEN
+ 1);
1485 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1492 /* Strip off drive name from prefix, if present. */
1493 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1499 /* Keep only a prefix from newdir if nm starts with slash
1500 (//server/share for UNC, nothing otherwise). */
1501 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1504 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1506 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1508 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1510 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1522 /* Get rid of any slash at the end of newdir, unless newdir is
1523 just / or // (an incomplete UNC name). */
1524 length
= strlen (newdir
);
1525 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1527 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1531 unsigned char *temp
= (unsigned char *) alloca (length
);
1532 bcopy (newdir
, temp
, length
- 1);
1533 temp
[length
- 1] = 0;
1541 /* Now concatenate the directory and name to new space in the stack frame */
1542 tlen
+= strlen (nm
) + 1;
1544 /* Reserve space for drive specifier and escape prefix, since either
1545 or both may need to be inserted. (The Microsoft x86 compiler
1546 produces incorrect code if the following two lines are combined.) */
1547 target
= (unsigned char *) alloca (tlen
+ 4);
1549 #else /* not DOS_NT */
1550 target
= (unsigned char *) alloca (tlen
);
1551 #endif /* not DOS_NT */
1557 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1560 /* If newdir is effectively "C:/", then the drive letter will have
1561 been stripped and newdir will be "/". Concatenating with an
1562 absolute directory in nm produces "//", which will then be
1563 incorrectly treated as a network share. Ignore newdir in
1564 this case (keeping the drive letter). */
1565 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1566 && newdir
[1] == '\0'))
1568 strcpy (target
, newdir
);
1572 file_name_as_directory (target
, newdir
);
1575 strcat (target
, nm
);
1577 if (index (target
, '/'))
1578 strcpy (target
, sys_translate_unix (target
));
1581 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1583 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1592 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1598 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1599 /* brackets are offset from each other by 2 */
1602 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1603 /* convert [foo][bar] to [bar] */
1604 while (o
[-1] != '[' && o
[-1] != '<')
1606 else if (*p
== '-' && *o
!= '.')
1609 else if (p
[0] == '-' && o
[-1] == '.' &&
1610 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1611 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1615 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1616 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1618 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1620 /* else [foo.-] ==> [-] */
1626 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1627 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1633 if (!IS_DIRECTORY_SEP (*p
))
1637 else if (IS_DIRECTORY_SEP (p
[0])
1639 && (IS_DIRECTORY_SEP (p
[2])
1642 /* If "/." is the entire filename, keep the "/". Otherwise,
1643 just delete the whole "/.". */
1644 if (o
== target
&& p
[2] == '\0')
1648 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1649 /* `/../' is the "superroot" on certain file systems. */
1651 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1653 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1655 /* Keep initial / only if this is the whole name. */
1656 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1661 && IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1]))
1663 /* Collapse multiple `/' in a row. */
1665 while (IS_DIRECTORY_SEP (*p
))
1672 #endif /* not VMS */
1676 /* At last, set drive name. */
1678 /* Except for network file name. */
1679 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1680 #endif /* WINDOWSNT */
1682 if (!drive
) abort ();
1684 target
[0] = DRIVE_LETTER (drive
);
1687 /* Reinsert the escape prefix if required. */
1694 CORRECT_DIR_SEPS (target
);
1697 result
= make_specified_string (target
, -1, o
- target
,
1698 STRING_MULTIBYTE (name
));
1700 /* Again look to see if the file name has special constructs in it
1701 and perhaps call the corresponding file handler. This is needed
1702 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1703 the ".." component gives us "/user@host:/bar/../baz" which needs
1704 to be expanded again. */
1705 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1706 if (!NILP (handler
))
1707 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1713 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1714 This is the old version of expand-file-name, before it was thoroughly
1715 rewritten for Emacs 10.31. We leave this version here commented-out,
1716 because the code is very complex and likely to have subtle bugs. If
1717 bugs _are_ found, it might be of interest to look at the old code and
1718 see what did it do in the relevant situation.
1720 Don't remove this code: it's true that it will be accessible via CVS,
1721 but a few years from deletion, people will forget it is there. */
1723 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1724 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1725 "Convert FILENAME to absolute, and canonicalize it.\n\
1726 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1727 (does not start with slash); if DEFAULT is nil or missing,\n\
1728 the current buffer's value of default-directory is used.\n\
1729 Filenames containing `.' or `..' as components are simplified;\n\
1730 initial `~/' expands to your home directory.\n\
1731 See also the function `substitute-in-file-name'.")
1733 Lisp_Object name
, defalt
;
1737 register unsigned char *newdir
, *p
, *o
;
1739 unsigned char *target
;
1743 unsigned char * colon
= 0;
1744 unsigned char * close
= 0;
1745 unsigned char * slash
= 0;
1746 unsigned char * brack
= 0;
1747 int lbrack
= 0, rbrack
= 0;
1751 CHECK_STRING (name
);
1754 /* Filenames on VMS are always upper case. */
1755 name
= Fupcase (name
);
1760 /* If nm is absolute, flush ...// and detect /./ and /../.
1761 If no /./ or /../ we can return right away. */
1773 if (p
[0] == '/' && p
[1] == '/'
1775 /* // at start of filename is meaningful on Apollo system. */
1780 if (p
[0] == '/' && p
[1] == '~')
1781 nm
= p
+ 1, lose
= 1;
1782 if (p
[0] == '/' && p
[1] == '.'
1783 && (p
[2] == '/' || p
[2] == 0
1784 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1790 /* if dev:[dir]/, move nm to / */
1791 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1792 nm
= (brack
? brack
+ 1 : colon
+ 1);
1793 lbrack
= rbrack
= 0;
1801 /* VMS pre V4.4,convert '-'s in filenames. */
1802 if (lbrack
== rbrack
)
1804 if (dots
< 2) /* this is to allow negative version numbers */
1809 if (lbrack
> rbrack
&&
1810 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1811 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1817 /* count open brackets, reset close bracket pointer */
1818 if (p
[0] == '[' || p
[0] == '<')
1819 lbrack
++, brack
= 0;
1820 /* count close brackets, set close bracket pointer */
1821 if (p
[0] == ']' || p
[0] == '>')
1822 rbrack
++, brack
= p
;
1823 /* detect ][ or >< */
1824 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1826 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1827 nm
= p
+ 1, lose
= 1;
1828 if (p
[0] == ':' && (colon
|| slash
))
1829 /* if dev1:[dir]dev2:, move nm to dev2: */
1835 /* If /name/dev:, move nm to dev: */
1838 /* If node::dev:, move colon following dev */
1839 else if (colon
&& colon
[-1] == ':')
1841 /* If dev1:dev2:, move nm to dev2: */
1842 else if (colon
&& colon
[-1] != ':')
1847 if (p
[0] == ':' && !colon
)
1853 if (lbrack
== rbrack
)
1856 else if (p
[0] == '.')
1864 if (index (nm
, '/'))
1865 return build_string (sys_translate_unix (nm
));
1867 if (nm
== SDATA (name
))
1869 return build_string (nm
);
1873 /* Now determine directory to start with and put it in NEWDIR */
1877 if (nm
[0] == '~') /* prefix ~ */
1882 || nm
[1] == 0)/* ~/filename */
1884 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1885 newdir
= (unsigned char *) "";
1888 nm
++; /* Don't leave the slash in nm. */
1891 else /* ~user/filename */
1893 /* Get past ~ to user */
1894 unsigned char *user
= nm
+ 1;
1895 /* Find end of name. */
1896 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1897 int len
= ptr
? ptr
- user
: strlen (user
);
1899 unsigned char *ptr1
= index (user
, ':');
1900 if (ptr1
!= 0 && ptr1
- user
< len
)
1903 /* Copy the user name into temp storage. */
1904 o
= (unsigned char *) alloca (len
+ 1);
1905 bcopy ((char *) user
, o
, len
);
1908 /* Look up the user name. */
1909 pw
= (struct passwd
*) getpwnam (o
+ 1);
1911 error ("\"%s\" isn't a registered user", o
+ 1);
1913 newdir
= (unsigned char *) pw
->pw_dir
;
1915 /* Discard the user name from NM. */
1922 #endif /* not VMS */
1926 defalt
= current_buffer
->directory
;
1927 CHECK_STRING (defalt
);
1928 newdir
= SDATA (defalt
);
1931 /* Now concatenate the directory and name to new space in the stack frame */
1933 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1934 target
= (unsigned char *) alloca (tlen
);
1940 if (nm
[0] == 0 || nm
[0] == '/')
1941 strcpy (target
, newdir
);
1944 file_name_as_directory (target
, newdir
);
1947 strcat (target
, nm
);
1949 if (index (target
, '/'))
1950 strcpy (target
, sys_translate_unix (target
));
1953 /* Now canonicalize by removing /. and /foo/.. if they appear */
1961 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1967 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1968 /* brackets are offset from each other by 2 */
1971 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1972 /* convert [foo][bar] to [bar] */
1973 while (o
[-1] != '[' && o
[-1] != '<')
1975 else if (*p
== '-' && *o
!= '.')
1978 else if (p
[0] == '-' && o
[-1] == '.' &&
1979 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1980 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1984 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1985 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1987 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1989 /* else [foo.-] ==> [-] */
1995 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1996 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2006 else if (!strncmp (p
, "//", 2)
2008 /* // at start of filename is meaningful in Apollo system. */
2016 else if (p
[0] == '/' && p
[1] == '.' &&
2017 (p
[2] == '/' || p
[2] == 0))
2019 else if (!strncmp (p
, "/..", 3)
2020 /* `/../' is the "superroot" on certain file systems. */
2022 && (p
[3] == '/' || p
[3] == 0))
2024 while (o
!= target
&& *--o
!= '/')
2027 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2031 if (o
== target
&& *o
== '/')
2039 #endif /* not VMS */
2042 return make_string (target
, o
- target
);
2046 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2047 Ssubstitute_in_file_name
, 1, 1, 0,
2048 doc
: /* Substitute environment variables referred to in FILENAME.
2049 `$FOO' where FOO is an environment variable name means to substitute
2050 the value of that variable. The variable name should be terminated
2051 with a character not a letter, digit or underscore; otherwise, enclose
2052 the entire variable name in braces.
2053 If `/~' appears, all of FILENAME through that `/' is discarded.
2055 On VMS, `$' substitution is not done; this function does little and only
2056 duplicates what `expand-file-name' does. */)
2058 Lisp_Object filename
;
2062 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2063 unsigned char *target
= NULL
;
2065 int substituted
= 0;
2068 Lisp_Object handler
;
2070 CHECK_STRING (filename
);
2072 /* If the file name has special constructs in it,
2073 call the corresponding file handler. */
2074 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2075 if (!NILP (handler
))
2076 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2078 nm
= SDATA (filename
);
2080 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2081 CORRECT_DIR_SEPS (nm
);
2082 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2084 endp
= nm
+ SBYTES (filename
);
2086 /* If /~ or // appears, discard everything through first slash. */
2088 for (p
= nm
; p
!= endp
; p
++)
2091 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2092 /* // at start of file name is meaningful in Apollo,
2093 WindowsNT and Cygwin systems. */
2094 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
2095 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2096 || IS_DIRECTORY_SEP (p
[0])
2097 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2102 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2104 || IS_DIRECTORY_SEP (p
[-1])))
2106 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2111 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2113 o
= (unsigned char *) alloca (s
- p
+ 1);
2114 bcopy ((char *) p
, o
, s
- p
);
2117 pw
= (struct passwd
*) getpwnam (o
+ 1);
2119 /* If we have ~/ or ~user and `user' exists, discard
2120 everything up to ~. But if `user' does not exist, leave
2121 ~user alone, it might be a literal file name. */
2122 if (IS_DIRECTORY_SEP (p
[0]) || s
== p
+ 1 || pw
)
2129 /* see comment in expand-file-name about drive specifiers */
2130 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2131 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
2140 return make_specified_string (nm
, -1, strlen (nm
),
2141 STRING_MULTIBYTE (filename
));
2144 /* See if any variables are substituted into the string
2145 and find the total length of their values in `total' */
2147 for (p
= nm
; p
!= endp
;)
2157 /* "$$" means a single "$" */
2166 while (p
!= endp
&& *p
!= '}') p
++;
2167 if (*p
!= '}') goto missingclose
;
2173 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2177 /* Copy out the variable name */
2178 target
= (unsigned char *) alloca (s
- o
+ 1);
2179 strncpy (target
, o
, s
- o
);
2182 strupr (target
); /* $home == $HOME etc. */
2185 /* Get variable value */
2186 o
= (unsigned char *) egetenv (target
);
2189 total
+= strlen (o
);
2199 /* If substitution required, recopy the string and do it */
2200 /* Make space in stack frame for the new copy */
2201 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2204 /* Copy the rest of the name through, replacing $ constructs with values */
2221 while (p
!= endp
&& *p
!= '}') p
++;
2222 if (*p
!= '}') goto missingclose
;
2228 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2232 /* Copy out the variable name */
2233 target
= (unsigned char *) alloca (s
- o
+ 1);
2234 strncpy (target
, o
, s
- o
);
2237 strupr (target
); /* $home == $HOME etc. */
2240 /* Get variable value */
2241 o
= (unsigned char *) egetenv (target
);
2245 strcpy (x
, target
); x
+= strlen (target
);
2247 else if (STRING_MULTIBYTE (filename
))
2249 /* If the original string is multibyte,
2250 convert what we substitute into multibyte. */
2253 int c
= unibyte_char_to_multibyte (*o
++);
2254 x
+= CHAR_STRING (c
, x
);
2266 /* If /~ or // appears, discard everything through first slash. */
2268 for (p
= xnm
; p
!= x
; p
++)
2270 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2271 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2272 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2273 || IS_DIRECTORY_SEP (p
[0])
2274 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2276 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2279 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2280 && p
> xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2284 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2287 error ("Bad format environment-variable substitution");
2289 error ("Missing \"}\" in environment-variable substitution");
2291 error ("Substituting nonexistent environment variable \"%s\"", target
);
2294 #endif /* not VMS */
2298 /* A slightly faster and more convenient way to get
2299 (directory-file-name (expand-file-name FOO)). */
2302 expand_and_dir_to_file (filename
, defdir
)
2303 Lisp_Object filename
, defdir
;
2305 register Lisp_Object absname
;
2307 absname
= Fexpand_file_name (filename
, defdir
);
2310 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2311 if (c
== ':' || c
== ']' || c
== '>')
2312 absname
= Fdirectory_file_name (absname
);
2315 /* Remove final slash, if any (unless this is the root dir).
2316 stat behaves differently depending! */
2317 if (SCHARS (absname
) > 1
2318 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2319 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2320 /* We cannot take shortcuts; they might be wrong for magic file names. */
2321 absname
= Fdirectory_file_name (absname
);
2326 /* Signal an error if the file ABSNAME already exists.
2327 If INTERACTIVE is nonzero, ask the user whether to proceed,
2328 and bypass the error if the user says to go ahead.
2329 QUERYSTRING is a name for the action that is being considered
2332 *STATPTR is used to store the stat information if the file exists.
2333 If the file does not exist, STATPTR->st_mode is set to 0.
2334 If STATPTR is null, we don't store into it.
2336 If QUICK is nonzero, we ask for y or n, not yes or no. */
2339 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2340 Lisp_Object absname
;
2341 unsigned char *querystring
;
2343 struct stat
*statptr
;
2346 register Lisp_Object tem
, encoded_filename
;
2347 struct stat statbuf
;
2348 struct gcpro gcpro1
;
2350 encoded_filename
= ENCODE_FILE (absname
);
2352 /* stat is a good way to tell whether the file exists,
2353 regardless of what access permissions it has. */
2354 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
2357 Fsignal (Qfile_already_exists
,
2358 Fcons (build_string ("File already exists"),
2359 Fcons (absname
, Qnil
)));
2361 tem
= format2 ("File %s already exists; %s anyway? ",
2362 absname
, build_string (querystring
));
2364 tem
= Fy_or_n_p (tem
);
2366 tem
= do_yes_or_no_p (tem
);
2369 Fsignal (Qfile_already_exists
,
2370 Fcons (build_string ("File already exists"),
2371 Fcons (absname
, Qnil
)));
2378 statptr
->st_mode
= 0;
2383 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2384 "fCopy file: \nFCopy %s to file: \np\nP",
2385 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2386 If NEWNAME names a directory, copy FILE there.
2387 Signals a `file-already-exists' error if file NEWNAME already exists,
2388 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
2389 A number as third arg means request confirmation if NEWNAME already exists.
2390 This is what happens in interactive use with M-x.
2391 Fourth arg KEEP-TIME non-nil means give the new file the same
2392 last-modified time as the old one. (This works on only some systems.)
2393 A prefix arg makes KEEP-TIME non-nil.
2394 Also set the file modes of the target file to match the source file. */)
2395 (file
, newname
, ok_if_already_exists
, keep_time
)
2396 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2399 char buf
[16 * 1024];
2400 struct stat st
, out_st
;
2401 Lisp_Object handler
;
2402 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2403 int count
= SPECPDL_INDEX ();
2404 int input_file_statable_p
;
2405 Lisp_Object encoded_file
, encoded_newname
;
2407 encoded_file
= encoded_newname
= Qnil
;
2408 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2409 CHECK_STRING (file
);
2410 CHECK_STRING (newname
);
2412 if (!NILP (Ffile_directory_p (newname
)))
2413 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2415 newname
= Fexpand_file_name (newname
, Qnil
);
2417 file
= Fexpand_file_name (file
, Qnil
);
2419 /* If the input file name has special constructs in it,
2420 call the corresponding file handler. */
2421 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2422 /* Likewise for output file name. */
2424 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2425 if (!NILP (handler
))
2426 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2427 ok_if_already_exists
, keep_time
));
2429 encoded_file
= ENCODE_FILE (file
);
2430 encoded_newname
= ENCODE_FILE (newname
);
2432 if (NILP (ok_if_already_exists
)
2433 || INTEGERP (ok_if_already_exists
))
2434 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2435 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2436 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2440 if (!CopyFile (SDATA (encoded_file
),
2441 SDATA (encoded_newname
),
2443 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2444 /* CopyFile retains the timestamp by default. */
2445 else if (NILP (keep_time
))
2451 EMACS_GET_TIME (now
);
2452 filename
= SDATA (encoded_newname
);
2454 /* Ensure file is writable while its modified time is set. */
2455 attributes
= GetFileAttributes (filename
);
2456 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2457 if (set_file_times (filename
, now
, now
))
2459 /* Restore original attributes. */
2460 SetFileAttributes (filename
, attributes
);
2461 Fsignal (Qfile_date_error
,
2462 Fcons (build_string ("Cannot set file date"),
2463 Fcons (newname
, Qnil
)));
2465 /* Restore original attributes. */
2466 SetFileAttributes (filename
, attributes
);
2468 #else /* not WINDOWSNT */
2470 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2474 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2476 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2478 /* We can only copy regular files and symbolic links. Other files are not
2480 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2482 #if !defined (DOS_NT) || __DJGPP__ > 1
2483 if (out_st
.st_mode
!= 0
2484 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2487 report_file_error ("Input and output files are the same",
2488 Fcons (file
, Fcons (newname
, Qnil
)));
2492 #if defined (S_ISREG) && defined (S_ISLNK)
2493 if (input_file_statable_p
)
2495 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2497 #if defined (EISDIR)
2498 /* Get a better looking error message. */
2501 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2504 #endif /* S_ISREG && S_ISLNK */
2507 /* Create the copy file with the same record format as the input file */
2508 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2511 /* System's default file type was set to binary by _fmode in emacs.c. */
2512 ofd
= creat (SDATA (encoded_newname
), S_IREAD
| S_IWRITE
);
2513 #else /* not MSDOS */
2514 ofd
= creat (SDATA (encoded_newname
), 0666);
2515 #endif /* not MSDOS */
2518 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2520 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2524 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2525 if (emacs_write (ofd
, buf
, n
) != n
)
2526 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2529 /* Closing the output clobbers the file times on some systems. */
2530 if (emacs_close (ofd
) < 0)
2531 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2533 if (input_file_statable_p
)
2535 if (!NILP (keep_time
))
2537 EMACS_TIME atime
, mtime
;
2538 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2539 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2540 if (set_file_times (SDATA (encoded_newname
),
2542 Fsignal (Qfile_date_error
,
2543 Fcons (build_string ("Cannot set file date"),
2544 Fcons (newname
, Qnil
)));
2547 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2549 #if defined (__DJGPP__) && __DJGPP__ > 1
2550 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2551 and if it can't, it tells so. Otherwise, under MSDOS we usually
2552 get only the READ bit, which will make the copied file read-only,
2553 so it's better not to chmod at all. */
2554 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2555 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2556 #endif /* DJGPP version 2 or newer */
2561 #endif /* WINDOWSNT */
2563 /* Discard the unwind protects. */
2564 specpdl_ptr
= specpdl
+ count
;
2570 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2571 Smake_directory_internal
, 1, 1, 0,
2572 doc
: /* Create a new directory named DIRECTORY. */)
2574 Lisp_Object directory
;
2576 const unsigned char *dir
;
2577 Lisp_Object handler
;
2578 Lisp_Object encoded_dir
;
2580 CHECK_STRING (directory
);
2581 directory
= Fexpand_file_name (directory
, Qnil
);
2583 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2584 if (!NILP (handler
))
2585 return call2 (handler
, Qmake_directory_internal
, directory
);
2587 encoded_dir
= ENCODE_FILE (directory
);
2589 dir
= SDATA (encoded_dir
);
2592 if (mkdir (dir
) != 0)
2594 if (mkdir (dir
, 0777) != 0)
2596 report_file_error ("Creating directory", Flist (1, &directory
));
2601 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2602 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2604 Lisp_Object directory
;
2606 const unsigned char *dir
;
2607 Lisp_Object handler
;
2608 Lisp_Object encoded_dir
;
2610 CHECK_STRING (directory
);
2611 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2613 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2614 if (!NILP (handler
))
2615 return call2 (handler
, Qdelete_directory
, directory
);
2617 encoded_dir
= ENCODE_FILE (directory
);
2619 dir
= SDATA (encoded_dir
);
2621 if (rmdir (dir
) != 0)
2622 report_file_error ("Removing directory", Flist (1, &directory
));
2627 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2628 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2629 If file has multiple names, it continues to exist with the other names. */)
2631 Lisp_Object filename
;
2633 Lisp_Object handler
;
2634 Lisp_Object encoded_file
;
2635 struct gcpro gcpro1
;
2638 if (!NILP (Ffile_directory_p (filename
))
2639 && NILP (Ffile_symlink_p (filename
)))
2640 Fsignal (Qfile_error
,
2641 Fcons (build_string ("Removing old name: is a directory"),
2642 Fcons (filename
, Qnil
)));
2644 filename
= Fexpand_file_name (filename
, Qnil
);
2646 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2647 if (!NILP (handler
))
2648 return call2 (handler
, Qdelete_file
, filename
);
2650 encoded_file
= ENCODE_FILE (filename
);
2652 if (0 > unlink (SDATA (encoded_file
)))
2653 report_file_error ("Removing old name", Flist (1, &filename
));
2658 internal_delete_file_1 (ignore
)
2664 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2667 internal_delete_file (filename
)
2668 Lisp_Object filename
;
2670 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2671 Qt
, internal_delete_file_1
));
2674 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2675 "fRename file: \nFRename %s to file: \np",
2676 doc
: /* Rename FILE as NEWNAME. Both args strings.
2677 If file has names other than FILE, it continues to have those names.
2678 Signals a `file-already-exists' error if a file NEWNAME already exists
2679 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2680 A number as third arg means request confirmation if NEWNAME already exists.
2681 This is what happens in interactive use with M-x. */)
2682 (file
, newname
, ok_if_already_exists
)
2683 Lisp_Object file
, newname
, ok_if_already_exists
;
2686 Lisp_Object args
[2];
2688 Lisp_Object handler
;
2689 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2690 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2692 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2693 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2694 CHECK_STRING (file
);
2695 CHECK_STRING (newname
);
2696 file
= Fexpand_file_name (file
, Qnil
);
2697 newname
= Fexpand_file_name (newname
, Qnil
);
2699 /* If the file name has special constructs in it,
2700 call the corresponding file handler. */
2701 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2703 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2704 if (!NILP (handler
))
2705 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2706 file
, newname
, ok_if_already_exists
));
2708 encoded_file
= ENCODE_FILE (file
);
2709 encoded_newname
= ENCODE_FILE (newname
);
2712 /* If the file names are identical but for the case, don't ask for
2713 confirmation: they simply want to change the letter-case of the
2715 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2717 if (NILP (ok_if_already_exists
)
2718 || INTEGERP (ok_if_already_exists
))
2719 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2720 INTEGERP (ok_if_already_exists
), 0, 0);
2722 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2724 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2725 || 0 > unlink (SDATA (encoded_file
)))
2731 symlink_target
= Ffile_symlink_p (file
);
2732 if (! NILP (symlink_target
))
2733 Fmake_symbolic_link (symlink_target
, newname
,
2734 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2737 Fcopy_file (file
, newname
,
2738 /* We have already prompted if it was an integer,
2739 so don't have copy-file prompt again. */
2740 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2741 Fdelete_file (file
);
2748 report_file_error ("Renaming", Flist (2, args
));
2751 report_file_error ("Renaming", Flist (2, &file
));
2758 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2759 "fAdd name to file: \nFName to add to %s: \np",
2760 doc
: /* Give FILE additional name NEWNAME. Both args strings.
2761 Signals a `file-already-exists' error if a file NEWNAME already exists
2762 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2763 A number as third arg means request confirmation if NEWNAME already exists.
2764 This is what happens in interactive use with M-x. */)
2765 (file
, newname
, ok_if_already_exists
)
2766 Lisp_Object file
, newname
, ok_if_already_exists
;
2769 Lisp_Object args
[2];
2771 Lisp_Object handler
;
2772 Lisp_Object encoded_file
, encoded_newname
;
2773 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2775 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2776 encoded_file
= encoded_newname
= Qnil
;
2777 CHECK_STRING (file
);
2778 CHECK_STRING (newname
);
2779 file
= Fexpand_file_name (file
, Qnil
);
2780 newname
= Fexpand_file_name (newname
, Qnil
);
2782 /* If the file name has special constructs in it,
2783 call the corresponding file handler. */
2784 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2785 if (!NILP (handler
))
2786 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2787 newname
, ok_if_already_exists
));
2789 /* If the new name has special constructs in it,
2790 call the corresponding file handler. */
2791 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2792 if (!NILP (handler
))
2793 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2794 newname
, ok_if_already_exists
));
2796 encoded_file
= ENCODE_FILE (file
);
2797 encoded_newname
= ENCODE_FILE (newname
);
2799 if (NILP (ok_if_already_exists
)
2800 || INTEGERP (ok_if_already_exists
))
2801 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2802 INTEGERP (ok_if_already_exists
), 0, 0);
2804 unlink (SDATA (newname
));
2805 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2810 report_file_error ("Adding new name", Flist (2, args
));
2812 report_file_error ("Adding new name", Flist (2, &file
));
2821 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2822 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2823 doc
: /* Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2824 Signals a `file-already-exists' error if a file LINKNAME already exists
2825 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2826 A number as third arg means request confirmation if LINKNAME already exists.
2827 This happens for interactive use with M-x. */)
2828 (filename
, linkname
, ok_if_already_exists
)
2829 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2832 Lisp_Object args
[2];
2834 Lisp_Object handler
;
2835 Lisp_Object encoded_filename
, encoded_linkname
;
2836 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2838 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2839 encoded_filename
= encoded_linkname
= Qnil
;
2840 CHECK_STRING (filename
);
2841 CHECK_STRING (linkname
);
2842 /* If the link target has a ~, we must expand it to get
2843 a truly valid file name. Otherwise, do not expand;
2844 we want to permit links to relative file names. */
2845 if (SREF (filename
, 0) == '~')
2846 filename
= Fexpand_file_name (filename
, Qnil
);
2847 linkname
= Fexpand_file_name (linkname
, Qnil
);
2849 /* If the file name has special constructs in it,
2850 call the corresponding file handler. */
2851 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2852 if (!NILP (handler
))
2853 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2854 linkname
, ok_if_already_exists
));
2856 /* If the new link name has special constructs in it,
2857 call the corresponding file handler. */
2858 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2859 if (!NILP (handler
))
2860 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2861 linkname
, ok_if_already_exists
));
2863 encoded_filename
= ENCODE_FILE (filename
);
2864 encoded_linkname
= ENCODE_FILE (linkname
);
2866 if (NILP (ok_if_already_exists
)
2867 || INTEGERP (ok_if_already_exists
))
2868 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2869 INTEGERP (ok_if_already_exists
), 0, 0);
2870 if (0 > symlink (SDATA (encoded_filename
),
2871 SDATA (encoded_linkname
)))
2873 /* If we didn't complain already, silently delete existing file. */
2874 if (errno
== EEXIST
)
2876 unlink (SDATA (encoded_linkname
));
2877 if (0 <= symlink (SDATA (encoded_filename
),
2878 SDATA (encoded_linkname
)))
2888 report_file_error ("Making symbolic link", Flist (2, args
));
2890 report_file_error ("Making symbolic link", Flist (2, &filename
));
2896 #endif /* S_IFLNK */
2900 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2901 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2902 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2903 If STRING is nil or a null string, the logical name NAME is deleted. */)
2908 CHECK_STRING (name
);
2910 delete_logical_name (SDATA (name
));
2913 CHECK_STRING (string
);
2915 if (SCHARS (string
) == 0)
2916 delete_logical_name (SDATA (name
));
2918 define_logical_name (SDATA (name
), SDATA (string
));
2927 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2928 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2930 Lisp_Object path
, login
;
2934 CHECK_STRING (path
);
2935 CHECK_STRING (login
);
2937 netresult
= netunam (SDATA (path
), SDATA (login
));
2939 if (netresult
== -1)
2944 #endif /* HPUX_NET */
2946 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2948 doc
: /* Return t if file FILENAME specifies an absolute file name.
2949 On Unix, this is a name starting with a `/' or a `~'. */)
2951 Lisp_Object filename
;
2953 const unsigned char *ptr
;
2955 CHECK_STRING (filename
);
2956 ptr
= SDATA (filename
);
2957 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2959 /* ??? This criterion is probably wrong for '<'. */
2960 || index (ptr
, ':') || index (ptr
, '<')
2961 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2965 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2973 /* Return nonzero if file FILENAME exists and can be executed. */
2976 check_executable (filename
)
2980 int len
= strlen (filename
);
2983 if (stat (filename
, &st
) < 0)
2985 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2986 return ((st
.st_mode
& S_IEXEC
) != 0);
2988 return (S_ISREG (st
.st_mode
)
2990 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2991 || stricmp (suffix
, ".exe") == 0
2992 || stricmp (suffix
, ".bat") == 0)
2993 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2994 #endif /* not WINDOWSNT */
2995 #else /* not DOS_NT */
2996 #ifdef HAVE_EUIDACCESS
2997 return (euidaccess (filename
, 1) >= 0);
2999 /* Access isn't quite right because it uses the real uid
3000 and we really want to test with the effective uid.
3001 But Unix doesn't give us a right way to do it. */
3002 return (access (filename
, 1) >= 0);
3004 #endif /* not DOS_NT */
3007 /* Return nonzero if file FILENAME exists and can be written. */
3010 check_writable (filename
)
3015 if (stat (filename
, &st
) < 0)
3017 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3018 #else /* not MSDOS */
3019 #ifdef HAVE_EUIDACCESS
3020 return (euidaccess (filename
, 2) >= 0);
3022 /* Access isn't quite right because it uses the real uid
3023 and we really want to test with the effective uid.
3024 But Unix doesn't give us a right way to do it.
3025 Opening with O_WRONLY could work for an ordinary file,
3026 but would lose for directories. */
3027 return (access (filename
, 2) >= 0);
3029 #endif /* not MSDOS */
3032 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3033 doc
: /* Return t if file FILENAME exists. (This does not mean you can read it.)
3034 See also `file-readable-p' and `file-attributes'. */)
3036 Lisp_Object filename
;
3038 Lisp_Object absname
;
3039 Lisp_Object handler
;
3040 struct stat statbuf
;
3042 CHECK_STRING (filename
);
3043 absname
= Fexpand_file_name (filename
, Qnil
);
3045 /* If the file name has special constructs in it,
3046 call the corresponding file handler. */
3047 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3048 if (!NILP (handler
))
3049 return call2 (handler
, Qfile_exists_p
, absname
);
3051 absname
= ENCODE_FILE (absname
);
3053 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3056 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3057 doc
: /* Return t if FILENAME can be executed by you.
3058 For a directory, this means you can access files in that directory. */)
3060 Lisp_Object filename
;
3062 Lisp_Object absname
;
3063 Lisp_Object handler
;
3065 CHECK_STRING (filename
);
3066 absname
= Fexpand_file_name (filename
, Qnil
);
3068 /* If the file name has special constructs in it,
3069 call the corresponding file handler. */
3070 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3071 if (!NILP (handler
))
3072 return call2 (handler
, Qfile_executable_p
, absname
);
3074 absname
= ENCODE_FILE (absname
);
3076 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3079 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3080 doc
: /* Return t if file FILENAME exists and you can read it.
3081 See also `file-exists-p' and `file-attributes'. */)
3083 Lisp_Object filename
;
3085 Lisp_Object absname
;
3086 Lisp_Object handler
;
3089 struct stat statbuf
;
3091 CHECK_STRING (filename
);
3092 absname
= Fexpand_file_name (filename
, Qnil
);
3094 /* If the file name has special constructs in it,
3095 call the corresponding file handler. */
3096 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3097 if (!NILP (handler
))
3098 return call2 (handler
, Qfile_readable_p
, absname
);
3100 absname
= ENCODE_FILE (absname
);
3102 #if defined(DOS_NT) || defined(macintosh)
3103 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3105 if (access (SDATA (absname
), 0) == 0)
3108 #else /* not DOS_NT and not macintosh */
3110 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3111 /* Opening a fifo without O_NONBLOCK can wait.
3112 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3113 except in the case of a fifo, on a system which handles it. */
3114 desc
= stat (SDATA (absname
), &statbuf
);
3117 if (S_ISFIFO (statbuf
.st_mode
))
3118 flags
|= O_NONBLOCK
;
3120 desc
= emacs_open (SDATA (absname
), flags
, 0);
3125 #endif /* not DOS_NT and not macintosh */
3128 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3130 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3131 doc
: /* Return t if file FILENAME can be written or created by you. */)
3133 Lisp_Object filename
;
3135 Lisp_Object absname
, dir
, encoded
;
3136 Lisp_Object handler
;
3137 struct stat statbuf
;
3139 CHECK_STRING (filename
);
3140 absname
= Fexpand_file_name (filename
, Qnil
);
3142 /* If the file name has special constructs in it,
3143 call the corresponding file handler. */
3144 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3145 if (!NILP (handler
))
3146 return call2 (handler
, Qfile_writable_p
, absname
);
3148 encoded
= ENCODE_FILE (absname
);
3149 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3150 return (check_writable (SDATA (encoded
))
3153 dir
= Ffile_name_directory (absname
);
3156 dir
= Fdirectory_file_name (dir
);
3160 dir
= Fdirectory_file_name (dir
);
3163 dir
= ENCODE_FILE (dir
);
3165 /* The read-only attribute of the parent directory doesn't affect
3166 whether a file or directory can be created within it. Some day we
3167 should check ACLs though, which do affect this. */
3168 if (stat (SDATA (dir
), &statbuf
) < 0)
3170 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3172 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3177 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3178 doc
: /* Access file FILENAME, and get an error if that does not work.
3179 The second argument STRING is used in the error message.
3180 If there is no error, we return nil. */)
3182 Lisp_Object filename
, string
;
3184 Lisp_Object handler
, encoded_filename
, absname
;
3187 CHECK_STRING (filename
);
3188 absname
= Fexpand_file_name (filename
, Qnil
);
3190 CHECK_STRING (string
);
3192 /* If the file name has special constructs in it,
3193 call the corresponding file handler. */
3194 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3195 if (!NILP (handler
))
3196 return call3 (handler
, Qaccess_file
, absname
, string
);
3198 encoded_filename
= ENCODE_FILE (absname
);
3200 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3202 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3208 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3209 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3210 The value is the link target, as a string.
3211 Otherwise returns nil. */)
3213 Lisp_Object filename
;
3215 Lisp_Object handler
;
3217 CHECK_STRING (filename
);
3218 filename
= Fexpand_file_name (filename
, Qnil
);
3220 /* If the file name has special constructs in it,
3221 call the corresponding file handler. */
3222 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3223 if (!NILP (handler
))
3224 return call2 (handler
, Qfile_symlink_p
, filename
);
3233 filename
= ENCODE_FILE (filename
);
3240 buf
= (char *) xrealloc (buf
, bufsize
);
3241 bzero (buf
, bufsize
);
3244 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3248 /* HP-UX reports ERANGE if buffer is too small. */
3249 if (errno
== ERANGE
)
3259 while (valsize
>= bufsize
);
3261 val
= make_string (buf
, valsize
);
3262 if (buf
[0] == '/' && index (buf
, ':'))
3263 val
= concat2 (build_string ("/:"), val
);
3265 val
= DECODE_FILE (val
);
3268 #else /* not S_IFLNK */
3270 #endif /* not S_IFLNK */
3273 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3274 doc
: /* Return t if FILENAME names an existing directory.
3275 Symbolic links to directories count as directories.
3276 See `file-symlink-p' to distinguish symlinks. */)
3278 Lisp_Object filename
;
3280 register Lisp_Object absname
;
3282 Lisp_Object handler
;
3284 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3286 /* If the file name has special constructs in it,
3287 call the corresponding file handler. */
3288 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3289 if (!NILP (handler
))
3290 return call2 (handler
, Qfile_directory_p
, absname
);
3292 absname
= ENCODE_FILE (absname
);
3294 if (stat (SDATA (absname
), &st
) < 0)
3296 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3299 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3300 doc
: /* Return t if file FILENAME names a directory you can open.
3301 For the value to be t, FILENAME must specify the name of a directory as a file,
3302 and the directory must allow you to open files in it. In order to use a
3303 directory as a buffer's current directory, this predicate must return true.
3304 A directory name spec may be given instead; then the value is t
3305 if the directory so specified exists and really is a readable and
3306 searchable directory. */)
3308 Lisp_Object filename
;
3310 Lisp_Object handler
;
3312 struct gcpro gcpro1
;
3314 /* If the file name has special constructs in it,
3315 call the corresponding file handler. */
3316 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3317 if (!NILP (handler
))
3318 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3321 tem
= (NILP (Ffile_directory_p (filename
))
3322 || NILP (Ffile_executable_p (filename
)));
3324 return tem
? Qnil
: Qt
;
3327 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3328 doc
: /* Return t if file FILENAME is the name of a regular file.
3329 This is the sort of file that holds an ordinary stream of data bytes. */)
3331 Lisp_Object filename
;
3333 register Lisp_Object absname
;
3335 Lisp_Object handler
;
3337 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3339 /* If the file name has special constructs in it,
3340 call the corresponding file handler. */
3341 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3342 if (!NILP (handler
))
3343 return call2 (handler
, Qfile_regular_p
, absname
);
3345 absname
= ENCODE_FILE (absname
);
3350 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3352 /* Tell stat to use expensive method to get accurate info. */
3353 Vw32_get_true_file_attributes
= Qt
;
3354 result
= stat (SDATA (absname
), &st
);
3355 Vw32_get_true_file_attributes
= tem
;
3359 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3362 if (stat (SDATA (absname
), &st
) < 0)
3364 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3368 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3369 doc
: /* Return mode bits of file named FILENAME, as an integer. */)
3371 Lisp_Object filename
;
3373 Lisp_Object absname
;
3375 Lisp_Object handler
;
3377 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3379 /* If the file name has special constructs in it,
3380 call the corresponding file handler. */
3381 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3382 if (!NILP (handler
))
3383 return call2 (handler
, Qfile_modes
, absname
);
3385 absname
= ENCODE_FILE (absname
);
3387 if (stat (SDATA (absname
), &st
) < 0)
3389 #if defined (MSDOS) && __DJGPP__ < 2
3390 if (check_executable (SDATA (absname
)))
3391 st
.st_mode
|= S_IEXEC
;
3392 #endif /* MSDOS && __DJGPP__ < 2 */
3394 return make_number (st
.st_mode
& 07777);
3397 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3398 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3399 Only the 12 low bits of MODE are used. */)
3401 Lisp_Object filename
, mode
;
3403 Lisp_Object absname
, encoded_absname
;
3404 Lisp_Object handler
;
3406 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3407 CHECK_NUMBER (mode
);
3409 /* If the file name has special constructs in it,
3410 call the corresponding file handler. */
3411 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3412 if (!NILP (handler
))
3413 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3415 encoded_absname
= ENCODE_FILE (absname
);
3417 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3418 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3423 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3424 doc
: /* Set the file permission bits for newly created files.
3425 The argument MODE should be an integer; only the low 9 bits are used.
3426 This setting is inherited by subprocesses. */)
3430 CHECK_NUMBER (mode
);
3432 umask ((~ XINT (mode
)) & 0777);
3437 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3438 doc
: /* Return the default file protection for created files.
3439 The value is an integer. */)
3445 realmask
= umask (0);
3448 XSETINT (value
, (~ realmask
) & 0777);
3452 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3454 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3455 doc
: /* Set times of file FILENAME to TIME.
3456 Set both access and modification times.
3457 Return t on success, else nil.
3458 Use the current time if TIME is nil. TIME is in the format of
3461 Lisp_Object filename
, time
;
3463 Lisp_Object absname
, encoded_absname
;
3464 Lisp_Object handler
;
3468 if (! lisp_time_argument (time
, &sec
, &usec
))
3469 error ("Invalid time specification");
3471 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3473 /* If the file name has special constructs in it,
3474 call the corresponding file handler. */
3475 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3476 if (!NILP (handler
))
3477 return call3 (handler
, Qset_file_times
, absname
, time
);
3479 encoded_absname
= ENCODE_FILE (absname
);
3484 EMACS_SET_SECS (t
, sec
);
3485 EMACS_SET_USECS (t
, usec
);
3487 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3492 /* Setting times on a directory always fails. */
3493 if (stat (SDATA (encoded_absname
), &st
) == 0
3494 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3497 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3510 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3511 doc
: /* Tell Unix to finish all pending disk updates. */)
3520 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3521 doc
: /* Return t if file FILE1 is newer than file FILE2.
3522 If FILE1 does not exist, the answer is nil;
3523 otherwise, if FILE2 does not exist, the answer is t. */)
3525 Lisp_Object file1
, file2
;
3527 Lisp_Object absname1
, absname2
;
3530 Lisp_Object handler
;
3531 struct gcpro gcpro1
, gcpro2
;
3533 CHECK_STRING (file1
);
3534 CHECK_STRING (file2
);
3537 GCPRO2 (absname1
, file2
);
3538 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3539 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3542 /* If the file name has special constructs in it,
3543 call the corresponding file handler. */
3544 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3546 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3547 if (!NILP (handler
))
3548 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3550 GCPRO2 (absname1
, absname2
);
3551 absname1
= ENCODE_FILE (absname1
);
3552 absname2
= ENCODE_FILE (absname2
);
3555 if (stat (SDATA (absname1
), &st
) < 0)
3558 mtime1
= st
.st_mtime
;
3560 if (stat (SDATA (absname2
), &st
) < 0)
3563 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3567 Lisp_Object Qfind_buffer_file_type
;
3570 #ifndef READ_BUF_SIZE
3571 #define READ_BUF_SIZE (64 << 10)
3574 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3576 /* This function is called after Lisp functions to decide a coding
3577 system are called, or when they cause an error. Before they are
3578 called, the current buffer is set unibyte and it contains only a
3579 newly inserted text (thus the buffer was empty before the
3582 The functions may set markers, overlays, text properties, or even
3583 alter the buffer contents, change the current buffer.
3585 Here, we reset all those changes by:
3586 o set back the current buffer.
3587 o move all markers and overlays to BEG.
3588 o remove all text properties.
3589 o set back the buffer multibyteness. */
3592 decide_coding_unwind (unwind_data
)
3593 Lisp_Object unwind_data
;
3595 Lisp_Object multibyte
, undo_list
, buffer
;
3597 multibyte
= XCAR (unwind_data
);
3598 unwind_data
= XCDR (unwind_data
);
3599 undo_list
= XCAR (unwind_data
);
3600 buffer
= XCDR (unwind_data
);
3602 if (current_buffer
!= XBUFFER (buffer
))
3603 set_buffer_internal (XBUFFER (buffer
));
3604 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3605 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3606 BUF_INTERVALS (current_buffer
) = 0;
3607 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3609 /* Now we are safe to change the buffer's multibyteness directly. */
3610 current_buffer
->enable_multibyte_characters
= multibyte
;
3611 current_buffer
->undo_list
= undo_list
;
3617 /* Used to pass values from insert-file-contents to read_non_regular. */
3619 static int non_regular_fd
;
3620 static int non_regular_inserted
;
3621 static int non_regular_nbytes
;
3624 /* Read from a non-regular file.
3625 Read non_regular_trytry bytes max from non_regular_fd.
3626 Non_regular_inserted specifies where to put the read bytes.
3627 Value is the number of bytes read. */
3636 nbytes
= emacs_read (non_regular_fd
,
3637 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3638 non_regular_nbytes
);
3640 return make_number (nbytes
);
3644 /* Condition-case handler used when reading from non-regular files
3645 in insert-file-contents. */
3648 read_non_regular_quit ()
3654 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3656 doc
: /* Insert contents of file FILENAME after point.
3657 Returns list of absolute file name and number of characters inserted.
3658 If second argument VISIT is non-nil, the buffer's visited filename
3659 and last save file modtime are set, and it is marked unmodified.
3660 If visiting and the file does not exist, visiting is completed
3661 before the error is signaled.
3662 The optional third and fourth arguments BEG and END
3663 specify what portion of the file to insert.
3664 These arguments count bytes in the file, not characters in the buffer.
3665 If VISIT is non-nil, BEG and END must be nil.
3667 If optional fifth argument REPLACE is non-nil,
3668 it means replace the current buffer contents (in the accessible portion)
3669 with the file contents. This is better than simply deleting and inserting
3670 the whole thing because (1) it preserves some marker positions
3671 and (2) it puts less data in the undo list.
3672 When REPLACE is non-nil, the value is the number of characters actually read,
3673 which is often less than the number of characters to be read.
3675 This does code conversion according to the value of
3676 `coding-system-for-read' or `file-coding-system-alist',
3677 and sets the variable `last-coding-system-used' to the coding system
3679 (filename
, visit
, beg
, end
, replace
)
3680 Lisp_Object filename
, visit
, beg
, end
, replace
;
3685 register int how_much
;
3686 register int unprocessed
;
3687 int count
= SPECPDL_INDEX ();
3688 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3689 Lisp_Object handler
, val
, insval
, orig_filename
;
3692 int not_regular
= 0;
3693 unsigned char read_buf
[READ_BUF_SIZE
];
3694 struct coding_system coding
;
3695 unsigned char buffer
[1 << 14];
3696 int replace_handled
= 0;
3697 int set_coding_system
= 0;
3698 int coding_system_decided
= 0;
3701 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3702 error ("Cannot do file visiting in an indirect buffer");
3704 if (!NILP (current_buffer
->read_only
))
3705 Fbarf_if_buffer_read_only ();
3709 orig_filename
= Qnil
;
3711 GCPRO4 (filename
, val
, p
, orig_filename
);
3713 CHECK_STRING (filename
);
3714 filename
= Fexpand_file_name (filename
, Qnil
);
3716 /* If the file name has special constructs in it,
3717 call the corresponding file handler. */
3718 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3719 if (!NILP (handler
))
3721 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3722 visit
, beg
, end
, replace
);
3723 if (CONSP (val
) && CONSP (XCDR (val
)))
3724 inserted
= XINT (XCAR (XCDR (val
)));
3728 orig_filename
= filename
;
3729 filename
= ENCODE_FILE (filename
);
3735 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3737 /* Tell stat to use expensive method to get accurate info. */
3738 Vw32_get_true_file_attributes
= Qt
;
3739 total
= stat (SDATA (filename
), &st
);
3740 Vw32_get_true_file_attributes
= tem
;
3745 if (stat (SDATA (filename
), &st
) < 0)
3747 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3748 || fstat (fd
, &st
) < 0)
3749 #endif /* not APOLLO */
3750 #endif /* WINDOWSNT */
3752 if (fd
>= 0) emacs_close (fd
);
3755 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3758 if (!NILP (Vcoding_system_for_read
))
3759 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3764 /* This code will need to be changed in order to work on named
3765 pipes, and it's probably just not worth it. So we should at
3766 least signal an error. */
3767 if (!S_ISREG (st
.st_mode
))
3774 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3775 Fsignal (Qfile_error
,
3776 Fcons (build_string ("not a regular file"),
3777 Fcons (orig_filename
, Qnil
)));
3782 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3785 /* Replacement should preserve point as it preserves markers. */
3786 if (!NILP (replace
))
3787 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3789 record_unwind_protect (close_file_unwind
, make_number (fd
));
3791 /* Supposedly happens on VMS. */
3792 /* Can happen on any platform that uses long as type of off_t, but allows
3793 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3794 give a message suitable for the latter case. */
3795 if (! not_regular
&& st
.st_size
< 0)
3796 error ("Maximum buffer size exceeded");
3798 /* Prevent redisplay optimizations. */
3799 current_buffer
->clip_changed
= 1;
3803 if (!NILP (beg
) || !NILP (end
))
3804 error ("Attempt to visit less than an entire file");
3805 if (BEG
< Z
&& NILP (replace
))
3806 error ("Cannot do file visiting in a non-empty buffer");
3812 XSETFASTINT (beg
, 0);
3820 XSETINT (end
, st
.st_size
);
3822 /* Arithmetic overflow can occur if an Emacs integer cannot
3823 represent the file size, or if the calculations below
3824 overflow. The calculations below double the file size
3825 twice, so check that it can be multiplied by 4 safely. */
3826 if (XINT (end
) != st
.st_size
3827 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3828 error ("Maximum buffer size exceeded");
3830 /* The file size returned from stat may be zero, but data
3831 may be readable nonetheless, for example when this is a
3832 file in the /proc filesystem. */
3833 if (st
.st_size
== 0)
3834 XSETINT (end
, READ_BUF_SIZE
);
3838 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3840 /* We use emacs-mule for auto saving... */
3841 setup_coding_system (Qemacs_mule
, &coding
);
3842 /* ... but with the special flag to indicate to read in a
3843 multibyte sequence for eight-bit-control char as is. */
3845 coding
.src_multibyte
= 0;
3846 coding
.dst_multibyte
3847 = !NILP (current_buffer
->enable_multibyte_characters
);
3848 coding
.eol_type
= CODING_EOL_LF
;
3849 coding_system_decided
= 1;
3853 /* Decide the coding system to use for reading the file now
3854 because we can't use an optimized method for handling
3855 `coding:' tag if the current buffer is not empty. */
3859 if (!NILP (Vcoding_system_for_read
))
3860 val
= Vcoding_system_for_read
;
3861 else if (! NILP (replace
))
3862 /* In REPLACE mode, we can use the same coding system
3863 that was used to visit the file. */
3864 val
= current_buffer
->buffer_file_coding_system
;
3867 /* Don't try looking inside a file for a coding system
3868 specification if it is not seekable. */
3869 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3871 /* Find a coding system specified in the heading two
3872 lines or in the tailing several lines of the file.
3873 We assume that the 1K-byte and 3K-byte for heading
3874 and tailing respectively are sufficient for this
3878 if (st
.st_size
<= (1024 * 4))
3879 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3882 nread
= emacs_read (fd
, read_buf
, 1024);
3885 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3886 report_file_error ("Setting file position",
3887 Fcons (orig_filename
, Qnil
));
3888 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3893 error ("IO error reading %s: %s",
3894 SDATA (orig_filename
), emacs_strerror (errno
));
3897 struct buffer
*prev
= current_buffer
;
3901 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3903 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3904 buf
= XBUFFER (buffer
);
3906 delete_all_overlays (buf
);
3907 buf
->directory
= current_buffer
->directory
;
3908 buf
->read_only
= Qnil
;
3909 buf
->filename
= Qnil
;
3910 buf
->undo_list
= Qt
;
3911 eassert (buf
->overlays_before
== NULL
);
3912 eassert (buf
->overlays_after
== NULL
);
3914 set_buffer_internal (buf
);
3916 buf
->enable_multibyte_characters
= Qnil
;
3918 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3919 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3920 val
= call2 (Vset_auto_coding_function
,
3921 filename
, make_number (nread
));
3922 set_buffer_internal (prev
);
3924 /* Discard the unwind protect for recovering the
3928 /* Rewind the file for the actual read done later. */
3929 if (lseek (fd
, 0, 0) < 0)
3930 report_file_error ("Setting file position",
3931 Fcons (orig_filename
, Qnil
));
3937 /* If we have not yet decided a coding system, check
3938 file-coding-system-alist. */
3939 Lisp_Object args
[6], coding_systems
;
3941 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3942 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3943 coding_systems
= Ffind_operation_coding_system (6, args
);
3944 if (CONSP (coding_systems
))
3945 val
= XCAR (coding_systems
);
3949 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3950 /* Ensure we set Vlast_coding_system_used. */
3951 set_coding_system
= 1;
3953 if (NILP (current_buffer
->enable_multibyte_characters
)
3955 /* We must suppress all character code conversion except for
3956 end-of-line conversion. */
3957 setup_raw_text_coding_system (&coding
);
3959 coding
.src_multibyte
= 0;
3960 coding
.dst_multibyte
3961 = !NILP (current_buffer
->enable_multibyte_characters
);
3962 coding_system_decided
= 1;
3965 /* If requested, replace the accessible part of the buffer
3966 with the file contents. Avoid replacing text at the
3967 beginning or end of the buffer that matches the file contents;
3968 that preserves markers pointing to the unchanged parts.
3970 Here we implement this feature in an optimized way
3971 for the case where code conversion is NOT needed.
3972 The following if-statement handles the case of conversion
3973 in a less optimal way.
3975 If the code conversion is "automatic" then we try using this
3976 method and hope for the best.
3977 But if we discover the need for conversion, we give up on this method
3978 and let the following if-statement handle the replace job. */
3981 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
3983 /* same_at_start and same_at_end count bytes,
3984 because file access counts bytes
3985 and BEG and END count bytes. */
3986 int same_at_start
= BEGV_BYTE
;
3987 int same_at_end
= ZV_BYTE
;
3989 /* There is still a possibility we will find the need to do code
3990 conversion. If that happens, we set this variable to 1 to
3991 give up on handling REPLACE in the optimized way. */
3992 int giveup_match_end
= 0;
3994 if (XINT (beg
) != 0)
3996 if (lseek (fd
, XINT (beg
), 0) < 0)
3997 report_file_error ("Setting file position",
3998 Fcons (orig_filename
, Qnil
));
4003 /* Count how many chars at the start of the file
4004 match the text at the beginning of the buffer. */
4009 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4011 error ("IO error reading %s: %s",
4012 SDATA (orig_filename
), emacs_strerror (errno
));
4013 else if (nread
== 0)
4016 if (coding
.type
== coding_type_undecided
)
4017 detect_coding (&coding
, buffer
, nread
);
4018 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
4019 /* We found that the file should be decoded somehow.
4020 Let's give up here. */
4022 giveup_match_end
= 1;
4026 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
4027 detect_eol (&coding
, buffer
, nread
);
4028 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
4029 && coding
.eol_type
!= CODING_EOL_LF
)
4030 /* We found that the format of eol should be decoded.
4031 Let's give up here. */
4033 giveup_match_end
= 1;
4038 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4039 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4040 same_at_start
++, bufpos
++;
4041 /* If we found a discrepancy, stop the scan.
4042 Otherwise loop around and scan the next bufferful. */
4043 if (bufpos
!= nread
)
4047 /* If the file matches the buffer completely,
4048 there's no need to replace anything. */
4049 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4053 /* Truncate the buffer to the size of the file. */
4054 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4059 /* Count how many chars at the end of the file
4060 match the text at the end of the buffer. But, if we have
4061 already found that decoding is necessary, don't waste time. */
4062 while (!giveup_match_end
)
4064 int total_read
, nread
, bufpos
, curpos
, trial
;
4066 /* At what file position are we now scanning? */
4067 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4068 /* If the entire file matches the buffer tail, stop the scan. */
4071 /* How much can we scan in the next step? */
4072 trial
= min (curpos
, sizeof buffer
);
4073 if (lseek (fd
, curpos
- trial
, 0) < 0)
4074 report_file_error ("Setting file position",
4075 Fcons (orig_filename
, Qnil
));
4077 total_read
= nread
= 0;
4078 while (total_read
< trial
)
4080 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4082 error ("IO error reading %s: %s",
4083 SDATA (orig_filename
), emacs_strerror (errno
));
4084 else if (nread
== 0)
4086 total_read
+= nread
;
4089 /* Scan this bufferful from the end, comparing with
4090 the Emacs buffer. */
4091 bufpos
= total_read
;
4093 /* Compare with same_at_start to avoid counting some buffer text
4094 as matching both at the file's beginning and at the end. */
4095 while (bufpos
> 0 && same_at_end
> same_at_start
4096 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4097 same_at_end
--, bufpos
--;
4099 /* If we found a discrepancy, stop the scan.
4100 Otherwise loop around and scan the preceding bufferful. */
4103 /* If this discrepancy is because of code conversion,
4104 we cannot use this method; giveup and try the other. */
4105 if (same_at_end
> same_at_start
4106 && FETCH_BYTE (same_at_end
- 1) >= 0200
4107 && ! NILP (current_buffer
->enable_multibyte_characters
)
4108 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4109 giveup_match_end
= 1;
4118 if (! giveup_match_end
)
4122 /* We win! We can handle REPLACE the optimized way. */
4124 /* Extend the start of non-matching text area to multibyte
4125 character boundary. */
4126 if (! NILP (current_buffer
->enable_multibyte_characters
))
4127 while (same_at_start
> BEGV_BYTE
4128 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4131 /* Extend the end of non-matching text area to multibyte
4132 character boundary. */
4133 if (! NILP (current_buffer
->enable_multibyte_characters
))
4134 while (same_at_end
< ZV_BYTE
4135 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4138 /* Don't try to reuse the same piece of text twice. */
4139 overlap
= (same_at_start
- BEGV_BYTE
4140 - (same_at_end
+ st
.st_size
- ZV
));
4142 same_at_end
+= overlap
;
4144 /* Arrange to read only the nonmatching middle part of the file. */
4145 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4146 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4148 del_range_byte (same_at_start
, same_at_end
, 0);
4149 /* Insert from the file at the proper position. */
4150 temp
= BYTE_TO_CHAR (same_at_start
);
4151 SET_PT_BOTH (temp
, same_at_start
);
4153 /* If display currently starts at beginning of line,
4154 keep it that way. */
4155 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4156 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4158 replace_handled
= 1;
4162 /* If requested, replace the accessible part of the buffer
4163 with the file contents. Avoid replacing text at the
4164 beginning or end of the buffer that matches the file contents;
4165 that preserves markers pointing to the unchanged parts.
4167 Here we implement this feature for the case where code conversion
4168 is needed, in a simple way that needs a lot of memory.
4169 The preceding if-statement handles the case of no conversion
4170 in a more optimized way. */
4171 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4173 int same_at_start
= BEGV_BYTE
;
4174 int same_at_end
= ZV_BYTE
;
4177 /* Make sure that the gap is large enough. */
4178 int bufsize
= 2 * st
.st_size
;
4179 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4182 /* First read the whole file, performing code conversion into
4183 CONVERSION_BUFFER. */
4185 if (lseek (fd
, XINT (beg
), 0) < 0)
4187 xfree (conversion_buffer
);
4188 report_file_error ("Setting file position",
4189 Fcons (orig_filename
, Qnil
));
4192 total
= st
.st_size
; /* Total bytes in the file. */
4193 how_much
= 0; /* Bytes read from file so far. */
4194 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4195 unprocessed
= 0; /* Bytes not processed in previous loop. */
4197 while (how_much
< total
)
4199 /* try is reserved in some compilers (Microsoft C) */
4200 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4201 unsigned char *destination
= read_buf
+ unprocessed
;
4204 /* Allow quitting out of the actual I/O. */
4207 this = emacs_read (fd
, destination
, trytry
);
4210 if (this < 0 || this + unprocessed
== 0)
4218 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4220 int require
, result
;
4222 this += unprocessed
;
4224 /* If we are using more space than estimated,
4225 make CONVERSION_BUFFER bigger. */
4226 require
= decoding_buffer_size (&coding
, this);
4227 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4229 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4230 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4233 /* Convert this batch with results in CONVERSION_BUFFER. */
4234 if (how_much
>= total
) /* This is the last block. */
4235 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4236 if (coding
.composing
!= COMPOSITION_DISABLED
)
4237 coding_allocate_composition_data (&coding
, BEGV
);
4238 result
= decode_coding (&coding
, read_buf
,
4239 conversion_buffer
+ inserted
,
4240 this, bufsize
- inserted
);
4242 /* Save for next iteration whatever we didn't convert. */
4243 unprocessed
= this - coding
.consumed
;
4244 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4245 if (!NILP (current_buffer
->enable_multibyte_characters
))
4246 this = coding
.produced
;
4248 this = str_as_unibyte (conversion_buffer
+ inserted
,
4255 /* At this point, INSERTED is how many characters (i.e. bytes)
4256 are present in CONVERSION_BUFFER.
4257 HOW_MUCH should equal TOTAL,
4258 or should be <= 0 if we couldn't read the file. */
4262 xfree (conversion_buffer
);
4265 error ("IO error reading %s: %s",
4266 SDATA (orig_filename
), emacs_strerror (errno
));
4267 else if (how_much
== -2)
4268 error ("maximum buffer size exceeded");
4271 /* Compare the beginning of the converted file
4272 with the buffer text. */
4275 while (bufpos
< inserted
&& same_at_start
< same_at_end
4276 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4277 same_at_start
++, bufpos
++;
4279 /* If the file matches the buffer completely,
4280 there's no need to replace anything. */
4282 if (bufpos
== inserted
)
4284 xfree (conversion_buffer
);
4287 /* Truncate the buffer to the size of the file. */
4288 del_range_byte (same_at_start
, same_at_end
, 0);
4293 /* Extend the start of non-matching text area to multibyte
4294 character boundary. */
4295 if (! NILP (current_buffer
->enable_multibyte_characters
))
4296 while (same_at_start
> BEGV_BYTE
4297 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4300 /* Scan this bufferful from the end, comparing with
4301 the Emacs buffer. */
4304 /* Compare with same_at_start to avoid counting some buffer text
4305 as matching both at the file's beginning and at the end. */
4306 while (bufpos
> 0 && same_at_end
> same_at_start
4307 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4308 same_at_end
--, bufpos
--;
4310 /* Extend the end of non-matching text area to multibyte
4311 character boundary. */
4312 if (! NILP (current_buffer
->enable_multibyte_characters
))
4313 while (same_at_end
< ZV_BYTE
4314 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4317 /* Don't try to reuse the same piece of text twice. */
4318 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4320 same_at_end
+= overlap
;
4322 /* If display currently starts at beginning of line,
4323 keep it that way. */
4324 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4325 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4327 /* Replace the chars that we need to replace,
4328 and update INSERTED to equal the number of bytes
4329 we are taking from the file. */
4330 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4332 if (same_at_end
!= same_at_start
)
4334 del_range_byte (same_at_start
, same_at_end
, 0);
4336 same_at_start
= GPT_BYTE
;
4340 temp
= BYTE_TO_CHAR (same_at_start
);
4342 /* Insert from the file at the proper position. */
4343 SET_PT_BOTH (temp
, same_at_start
);
4344 insert_1 (conversion_buffer
+ same_at_start
- BEGV_BYTE
, inserted
,
4346 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4347 coding_restore_composition (&coding
, Fcurrent_buffer ());
4348 coding_free_composition_data (&coding
);
4350 /* Set `inserted' to the number of inserted characters. */
4351 inserted
= PT
- temp
;
4353 xfree (conversion_buffer
);
4362 register Lisp_Object temp
;
4364 total
= XINT (end
) - XINT (beg
);
4366 /* Make sure point-max won't overflow after this insertion. */
4367 XSETINT (temp
, total
);
4368 if (total
!= XINT (temp
))
4369 error ("Maximum buffer size exceeded");
4372 /* For a special file, all we can do is guess. */
4373 total
= READ_BUF_SIZE
;
4375 if (NILP (visit
) && total
> 0)
4376 prepare_to_modify_buffer (PT
, PT
, NULL
);
4379 if (GAP_SIZE
< total
)
4380 make_gap (total
- GAP_SIZE
);
4382 if (XINT (beg
) != 0 || !NILP (replace
))
4384 if (lseek (fd
, XINT (beg
), 0) < 0)
4385 report_file_error ("Setting file position",
4386 Fcons (orig_filename
, Qnil
));
4389 /* In the following loop, HOW_MUCH contains the total bytes read so
4390 far for a regular file, and not changed for a special file. But,
4391 before exiting the loop, it is set to a negative value if I/O
4395 /* Total bytes inserted. */
4398 /* Here, we don't do code conversion in the loop. It is done by
4399 code_convert_region after all data are read into the buffer. */
4401 int gap_size
= GAP_SIZE
;
4403 while (how_much
< total
)
4405 /* try is reserved in some compilers (Microsoft C) */
4406 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4413 /* Maybe make more room. */
4414 if (gap_size
< trytry
)
4416 make_gap (total
- gap_size
);
4417 gap_size
= GAP_SIZE
;
4420 /* Read from the file, capturing `quit'. When an
4421 error occurs, end the loop, and arrange for a quit
4422 to be signaled after decoding the text we read. */
4423 non_regular_fd
= fd
;
4424 non_regular_inserted
= inserted
;
4425 non_regular_nbytes
= trytry
;
4426 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4427 read_non_regular_quit
);
4438 /* Allow quitting out of the actual I/O. We don't make text
4439 part of the buffer until all the reading is done, so a C-g
4440 here doesn't do any harm. */
4443 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4455 /* For a regular file, where TOTAL is the real size,
4456 count HOW_MUCH to compare with it.
4457 For a special file, where TOTAL is just a buffer size,
4458 so don't bother counting in HOW_MUCH.
4459 (INSERTED is where we count the number of characters inserted.) */
4466 /* Make the text read part of the buffer. */
4467 GAP_SIZE
-= inserted
;
4469 GPT_BYTE
+= inserted
;
4471 ZV_BYTE
+= inserted
;
4476 /* Put an anchor to ensure multi-byte form ends at gap. */
4481 /* Discard the unwind protect for closing the file. */
4485 error ("IO error reading %s: %s",
4486 SDATA (orig_filename
), emacs_strerror (errno
));
4490 if (! coding_system_decided
)
4492 /* The coding system is not yet decided. Decide it by an
4493 optimized method for handling `coding:' tag.
4495 Note that we can get here only if the buffer was empty
4496 before the insertion. */
4500 if (!NILP (Vcoding_system_for_read
))
4501 val
= Vcoding_system_for_read
;
4504 /* Since we are sure that the current buffer was empty
4505 before the insertion, we can toggle
4506 enable-multibyte-characters directly here without taking
4507 care of marker adjustment and byte combining problem. By
4508 this way, we can run Lisp program safely before decoding
4509 the inserted text. */
4510 Lisp_Object unwind_data
;
4511 int count
= SPECPDL_INDEX ();
4513 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4514 Fcons (current_buffer
->undo_list
,
4515 Fcurrent_buffer ()));
4516 current_buffer
->enable_multibyte_characters
= Qnil
;
4517 current_buffer
->undo_list
= Qt
;
4518 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4520 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4522 val
= call2 (Vset_auto_coding_function
,
4523 filename
, make_number (inserted
));
4528 /* If the coding system is not yet decided, check
4529 file-coding-system-alist. */
4530 Lisp_Object args
[6], coding_systems
;
4532 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4533 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4534 coding_systems
= Ffind_operation_coding_system (6, args
);
4535 if (CONSP (coding_systems
))
4536 val
= XCAR (coding_systems
);
4539 unbind_to (count
, Qnil
);
4540 inserted
= Z_BYTE
- BEG_BYTE
;
4543 /* The following kludgy code is to avoid some compiler bug.
4545 setup_coding_system (val, &coding);
4548 struct coding_system temp_coding
;
4549 setup_coding_system (val
, &temp_coding
);
4550 bcopy (&temp_coding
, &coding
, sizeof coding
);
4552 /* Ensure we set Vlast_coding_system_used. */
4553 set_coding_system
= 1;
4555 if (NILP (current_buffer
->enable_multibyte_characters
)
4557 /* We must suppress all character code conversion except for
4558 end-of-line conversion. */
4559 setup_raw_text_coding_system (&coding
);
4560 coding
.src_multibyte
= 0;
4561 coding
.dst_multibyte
4562 = !NILP (current_buffer
->enable_multibyte_characters
);
4566 /* Can't do this if part of the buffer might be preserved. */
4568 && (coding
.type
== coding_type_no_conversion
4569 || coding
.type
== coding_type_raw_text
))
4571 /* Visiting a file with these coding system makes the buffer
4573 current_buffer
->enable_multibyte_characters
= Qnil
;
4574 coding
.dst_multibyte
= 0;
4577 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4579 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4581 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4583 inserted
= coding
.produced_char
;
4586 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4590 /* Now INSERTED is measured in characters. */
4593 /* Use the conversion type to determine buffer-file-type
4594 (find-buffer-file-type is now used to help determine the
4596 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4597 || coding
.eol_type
== CODING_EOL_LF
)
4598 && ! CODING_REQUIRE_DECODING (&coding
))
4599 current_buffer
->buffer_file_type
= Qt
;
4601 current_buffer
->buffer_file_type
= Qnil
;
4608 if (!EQ (current_buffer
->undo_list
, Qt
))
4609 current_buffer
->undo_list
= Qnil
;
4611 stat (SDATA (filename
), &st
);
4616 current_buffer
->modtime
= st
.st_mtime
;
4617 current_buffer
->filename
= orig_filename
;
4620 SAVE_MODIFF
= MODIFF
;
4621 current_buffer
->auto_save_modified
= MODIFF
;
4622 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4623 #ifdef CLASH_DETECTION
4626 if (!NILP (current_buffer
->file_truename
))
4627 unlock_file (current_buffer
->file_truename
);
4628 unlock_file (filename
);
4630 #endif /* CLASH_DETECTION */
4632 Fsignal (Qfile_error
,
4633 Fcons (build_string ("not a regular file"),
4634 Fcons (orig_filename
, Qnil
)));
4637 if (set_coding_system
)
4638 Vlast_coding_system_used
= coding
.symbol
;
4640 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4642 insval
= call1 (Qafter_insert_file_set_coding
, make_number (inserted
));
4643 if (! NILP (insval
))
4645 CHECK_NUMBER (insval
);
4646 inserted
= XFASTINT (insval
);
4650 /* Decode file format */
4653 int empty_undo_list_p
= 0;
4655 /* If we're anyway going to discard undo information, don't
4656 record it in the first place. The buffer's undo list at this
4657 point is either nil or t when visiting a file. */
4660 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4661 current_buffer
->undo_list
= Qt
;
4664 insval
= call3 (Qformat_decode
,
4665 Qnil
, make_number (inserted
), visit
);
4666 CHECK_NUMBER (insval
);
4667 inserted
= XFASTINT (insval
);
4670 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4673 /* Call after-change hooks for the inserted text, aside from the case
4674 of normal visiting (not with REPLACE), which is done in a new buffer
4675 "before" the buffer is changed. */
4676 if (inserted
> 0 && total
> 0
4677 && (NILP (visit
) || !NILP (replace
)))
4679 signal_after_change (PT
, 0, inserted
);
4680 update_compositions (PT
, PT
, CHECK_BORDER
);
4683 p
= Vafter_insert_file_functions
;
4686 insval
= call1 (XCAR (p
), make_number (inserted
));
4689 CHECK_NUMBER (insval
);
4690 inserted
= XFASTINT (insval
);
4697 && current_buffer
->modtime
== -1)
4699 /* If visiting nonexistent file, return nil. */
4700 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4704 Fsignal (Qquit
, Qnil
);
4706 /* ??? Retval needs to be dealt with in all cases consistently. */
4708 val
= Fcons (orig_filename
,
4709 Fcons (make_number (inserted
),
4712 RETURN_UNGCPRO (unbind_to (count
, val
));
4715 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4716 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4717 Lisp_Object
, Lisp_Object
));
4719 /* If build_annotations switched buffers, switch back to BUF.
4720 Kill the temporary buffer that was selected in the meantime.
4722 Since this kill only the last temporary buffer, some buffers remain
4723 not killed if build_annotations switched buffers more than once.
4727 build_annotations_unwind (buf
)
4732 if (XBUFFER (buf
) == current_buffer
)
4734 tembuf
= Fcurrent_buffer ();
4736 Fkill_buffer (tembuf
);
4740 /* Decide the coding-system to encode the data with. */
4743 choose_write_coding_system (start
, end
, filename
,
4744 append
, visit
, lockname
, coding
)
4745 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4746 struct coding_system
*coding
;
4751 && NILP (Fstring_equal (current_buffer
->filename
,
4752 current_buffer
->auto_save_file_name
)))
4754 /* We use emacs-mule for auto saving... */
4755 setup_coding_system (Qemacs_mule
, coding
);
4756 /* ... but with the special flag to indicate not to strip off
4757 leading code of eight-bit-control chars. */
4759 goto done_setup_coding
;
4761 else if (!NILP (Vcoding_system_for_write
))
4763 val
= Vcoding_system_for_write
;
4764 if (coding_system_require_warning
4765 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4766 /* Confirm that VAL can surely encode the current region. */
4767 val
= call5 (Vselect_safe_coding_system_function
,
4768 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4773 /* If the variable `buffer-file-coding-system' is set locally,
4774 it means that the file was read with some kind of code
4775 conversion or the variable is explicitly set by users. We
4776 had better write it out with the same coding system even if
4777 `enable-multibyte-characters' is nil.
4779 If it is not set locally, we anyway have to convert EOL
4780 format if the default value of `buffer-file-coding-system'
4781 tells that it is not Unix-like (LF only) format. */
4782 int using_default_coding
= 0;
4783 int force_raw_text
= 0;
4785 val
= current_buffer
->buffer_file_coding_system
;
4787 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4790 if (NILP (current_buffer
->enable_multibyte_characters
))
4796 /* Check file-coding-system-alist. */
4797 Lisp_Object args
[7], coding_systems
;
4799 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4800 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4802 coding_systems
= Ffind_operation_coding_system (7, args
);
4803 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4804 val
= XCDR (coding_systems
);
4808 && !NILP (current_buffer
->buffer_file_coding_system
))
4810 /* If we still have not decided a coding system, use the
4811 default value of buffer-file-coding-system. */
4812 val
= current_buffer
->buffer_file_coding_system
;
4813 using_default_coding
= 1;
4817 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4818 /* Confirm that VAL can surely encode the current region. */
4819 val
= call5 (Vselect_safe_coding_system_function
,
4820 start
, end
, val
, Qnil
, filename
);
4822 setup_coding_system (Fcheck_coding_system (val
), coding
);
4823 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4824 && !using_default_coding
)
4826 if (! EQ (default_buffer_file_coding
.symbol
,
4827 buffer_defaults
.buffer_file_coding_system
))
4828 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4829 &default_buffer_file_coding
);
4830 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4832 Lisp_Object subsidiaries
;
4834 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4835 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4836 if (VECTORP (subsidiaries
)
4837 && XVECTOR (subsidiaries
)->size
== 3)
4839 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4844 setup_raw_text_coding_system (coding
);
4845 goto done_setup_coding
;
4848 setup_coding_system (Fcheck_coding_system (val
), coding
);
4851 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4852 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4855 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4856 "r\nFWrite region to file: \ni\ni\ni\np",
4857 doc
: /* Write current region into specified file.
4858 When called from a program, requires three arguments:
4859 START, END and FILENAME. START and END are normally buffer positions
4860 specifying the part of the buffer to write.
4861 If START is nil, that means to use the entire buffer contents.
4862 If START is a string, then output that string to the file
4863 instead of any buffer contents; END is ignored.
4865 Optional fourth argument APPEND if non-nil means
4866 append to existing file contents (if any). If it is an integer,
4867 seek to that offset in the file before writing.
4868 Optional fifth argument VISIT, if t or a string, means
4869 set the last-save-file-modtime of buffer to this file's modtime
4870 and mark buffer not modified.
4871 If VISIT is a string, it is a second file name;
4872 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4873 VISIT is also the file name to lock and unlock for clash detection.
4874 If VISIT is neither t nor nil nor a string,
4875 that means do not display the \"Wrote file\" message.
4876 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4877 use for locking and unlocking, overriding FILENAME and VISIT.
4878 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4879 for an existing file with the same name. If MUSTBENEW is `excl',
4880 that means to get an error if the file already exists; never overwrite.
4881 If MUSTBENEW is neither nil nor `excl', that means ask for
4882 confirmation before overwriting, but do go ahead and overwrite the file
4883 if the user confirms.
4885 This does code conversion according to the value of
4886 `coding-system-for-write', `buffer-file-coding-system', or
4887 `file-coding-system-alist', and sets the variable
4888 `last-coding-system-used' to the coding system actually used. */)
4889 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4890 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4895 const unsigned char *fn
;
4898 int count
= SPECPDL_INDEX ();
4901 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4903 Lisp_Object handler
;
4904 Lisp_Object visit_file
;
4905 Lisp_Object annotations
;
4906 Lisp_Object encoded_filename
;
4907 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4908 int quietly
= !NILP (visit
);
4909 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4910 struct buffer
*given_buffer
;
4912 int buffer_file_type
= O_BINARY
;
4914 struct coding_system coding
;
4916 if (current_buffer
->base_buffer
&& visiting
)
4917 error ("Cannot do file visiting in an indirect buffer");
4919 if (!NILP (start
) && !STRINGP (start
))
4920 validate_region (&start
, &end
);
4922 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4924 filename
= Fexpand_file_name (filename
, Qnil
);
4926 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4927 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4929 if (STRINGP (visit
))
4930 visit_file
= Fexpand_file_name (visit
, Qnil
);
4932 visit_file
= filename
;
4934 if (NILP (lockname
))
4935 lockname
= visit_file
;
4939 /* If the file name has special constructs in it,
4940 call the corresponding file handler. */
4941 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4942 /* If FILENAME has no handler, see if VISIT has one. */
4943 if (NILP (handler
) && STRINGP (visit
))
4944 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4946 if (!NILP (handler
))
4949 val
= call6 (handler
, Qwrite_region
, start
, end
,
4950 filename
, append
, visit
);
4954 SAVE_MODIFF
= MODIFF
;
4955 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4956 current_buffer
->filename
= visit_file
;
4962 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4964 /* Special kludge to simplify auto-saving. */
4967 XSETFASTINT (start
, BEG
);
4968 XSETFASTINT (end
, Z
);
4972 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4973 count1
= SPECPDL_INDEX ();
4975 given_buffer
= current_buffer
;
4977 if (!STRINGP (start
))
4979 annotations
= build_annotations (start
, end
);
4981 if (current_buffer
!= given_buffer
)
4983 XSETFASTINT (start
, BEGV
);
4984 XSETFASTINT (end
, ZV
);
4990 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4992 /* Decide the coding-system to encode the data with.
4993 We used to make this choice before calling build_annotations, but that
4994 leads to problems when a write-annotate-function takes care of
4995 unsavable chars (as was the case with X-Symbol). */
4996 choose_write_coding_system (start
, end
, filename
,
4997 append
, visit
, lockname
, &coding
);
4998 Vlast_coding_system_used
= coding
.symbol
;
5000 given_buffer
= current_buffer
;
5001 if (! STRINGP (start
))
5003 annotations
= build_annotations_2 (start
, end
,
5004 coding
.pre_write_conversion
, annotations
);
5005 if (current_buffer
!= given_buffer
)
5007 XSETFASTINT (start
, BEGV
);
5008 XSETFASTINT (end
, ZV
);
5012 #ifdef CLASH_DETECTION
5015 #if 0 /* This causes trouble for GNUS. */
5016 /* If we've locked this file for some other buffer,
5017 query before proceeding. */
5018 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5019 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5022 lock_file (lockname
);
5024 #endif /* CLASH_DETECTION */
5026 encoded_filename
= ENCODE_FILE (filename
);
5028 fn
= SDATA (encoded_filename
);
5032 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5033 #else /* not DOS_NT */
5034 desc
= emacs_open (fn
, O_WRONLY
, 0);
5035 #endif /* not DOS_NT */
5037 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5039 if (auto_saving
) /* Overwrite any previous version of autosave file */
5041 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5042 desc
= emacs_open (fn
, O_RDWR
, 0);
5044 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5045 ? SDATA (current_buffer
->filename
) : 0,
5048 else /* Write to temporary name and rename if no errors */
5050 Lisp_Object temp_name
;
5051 temp_name
= Ffile_name_directory (filename
);
5053 if (!NILP (temp_name
))
5055 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5056 build_string ("$$SAVE$$")));
5057 fname
= SDATA (filename
);
5058 fn
= SDATA (temp_name
);
5059 desc
= creat_copy_attrs (fname
, fn
);
5062 /* If we can't open the temporary file, try creating a new
5063 version of the original file. VMS "creat" creates a
5064 new version rather than truncating an existing file. */
5067 desc
= creat (fn
, 0666);
5068 #if 0 /* This can clobber an existing file and fail to replace it,
5069 if the user runs out of space. */
5072 /* We can't make a new version;
5073 try to truncate and rewrite existing version if any. */
5075 desc
= emacs_open (fn
, O_RDWR
, 0);
5081 desc
= creat (fn
, 0666);
5085 desc
= emacs_open (fn
,
5086 O_WRONLY
| O_CREAT
| buffer_file_type
5087 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5088 S_IREAD
| S_IWRITE
);
5089 #else /* not DOS_NT */
5090 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5091 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5092 auto_saving
? auto_save_mode_bits
: 0666);
5093 #endif /* not DOS_NT */
5094 #endif /* not VMS */
5098 #ifdef CLASH_DETECTION
5100 if (!auto_saving
) unlock_file (lockname
);
5102 #endif /* CLASH_DETECTION */
5104 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5107 record_unwind_protect (close_file_unwind
, make_number (desc
));
5109 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5113 if (NUMBERP (append
))
5114 ret
= lseek (desc
, XINT (append
), 1);
5116 ret
= lseek (desc
, 0, 2);
5119 #ifdef CLASH_DETECTION
5120 if (!auto_saving
) unlock_file (lockname
);
5121 #endif /* CLASH_DETECTION */
5123 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5131 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5132 * if we do writes that don't end with a carriage return. Furthermore
5133 * it cannot handle writes of more then 16K. The modified
5134 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5135 * this EXCEPT for the last record (iff it doesn't end with a carriage
5136 * return). This implies that if your buffer doesn't end with a carriage
5137 * return, you get one free... tough. However it also means that if
5138 * we make two calls to sys_write (a la the following code) you can
5139 * get one at the gap as well. The easiest way to fix this (honest)
5140 * is to move the gap to the next newline (or the end of the buffer).
5145 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5146 move_gap (find_next_newline (GPT
, 1));
5148 /* Whether VMS or not, we must move the gap to the next of newline
5149 when we must put designation sequences at beginning of line. */
5150 if (INTEGERP (start
)
5151 && coding
.type
== coding_type_iso2022
5152 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5153 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5155 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5156 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5157 move_gap_both (PT
, PT_BYTE
);
5158 SET_PT_BOTH (opoint
, opoint_byte
);
5165 if (STRINGP (start
))
5167 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5168 &annotations
, &coding
);
5171 else if (XINT (start
) != XINT (end
))
5173 tem
= CHAR_TO_BYTE (XINT (start
));
5175 if (XINT (start
) < GPT
)
5177 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5178 min (GPT
, XINT (end
)) - XINT (start
),
5179 &annotations
, &coding
);
5183 if (XINT (end
) > GPT
&& !failure
)
5185 tem
= max (XINT (start
), GPT
);
5186 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5187 &annotations
, &coding
);
5193 /* If file was empty, still need to write the annotations */
5194 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5195 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5199 if (CODING_REQUIRE_FLUSHING (&coding
)
5200 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5203 /* We have to flush out a data. */
5204 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5205 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5212 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5213 Disk full in NFS may be reported here. */
5214 /* mib says that closing the file will try to write as fast as NFS can do
5215 it, and that means the fsync here is not crucial for autosave files. */
5216 if (!auto_saving
&& fsync (desc
) < 0)
5218 /* If fsync fails with EINTR, don't treat that as serious. */
5220 failure
= 1, save_errno
= errno
;
5224 /* Spurious "file has changed on disk" warnings have been
5225 observed on Suns as well.
5226 It seems that `close' can change the modtime, under nfs.
5228 (This has supposedly been fixed in Sunos 4,
5229 but who knows about all the other machines with NFS?) */
5232 /* On VMS and APOLLO, must do the stat after the close
5233 since closing changes the modtime. */
5236 /* Recall that #if defined does not work on VMS. */
5243 /* NFS can report a write failure now. */
5244 if (emacs_close (desc
) < 0)
5245 failure
= 1, save_errno
= errno
;
5248 /* If we wrote to a temporary name and had no errors, rename to real name. */
5252 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5260 /* Discard the unwind protect for close_file_unwind. */
5261 specpdl_ptr
= specpdl
+ count1
;
5262 /* Restore the original current buffer. */
5263 visit_file
= unbind_to (count
, visit_file
);
5265 #ifdef CLASH_DETECTION
5267 unlock_file (lockname
);
5268 #endif /* CLASH_DETECTION */
5270 /* Do this before reporting IO error
5271 to avoid a "file has changed on disk" warning on
5272 next attempt to save. */
5274 current_buffer
->modtime
= st
.st_mtime
;
5277 error ("IO error writing %s: %s", SDATA (filename
),
5278 emacs_strerror (save_errno
));
5282 SAVE_MODIFF
= MODIFF
;
5283 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5284 current_buffer
->filename
= visit_file
;
5285 update_mode_lines
++;
5290 && ! NILP (Fstring_equal (current_buffer
->filename
,
5291 current_buffer
->auto_save_file_name
)))
5292 SAVE_MODIFF
= MODIFF
;
5298 message_with_string ((INTEGERP (append
)
5308 Lisp_Object
merge ();
5310 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5311 doc
: /* Return t if (car A) is numerically less than (car B). */)
5315 return Flss (Fcar (a
), Fcar (b
));
5318 /* Build the complete list of annotations appropriate for writing out
5319 the text between START and END, by calling all the functions in
5320 write-region-annotate-functions and merging the lists they return.
5321 If one of these functions switches to a different buffer, we assume
5322 that buffer contains altered text. Therefore, the caller must
5323 make sure to restore the current buffer in all cases,
5324 as save-excursion would do. */
5327 build_annotations (start
, end
)
5328 Lisp_Object start
, end
;
5330 Lisp_Object annotations
;
5332 struct gcpro gcpro1
, gcpro2
;
5333 Lisp_Object original_buffer
;
5334 int i
, used_global
= 0;
5336 XSETBUFFER (original_buffer
, current_buffer
);
5339 p
= Vwrite_region_annotate_functions
;
5340 GCPRO2 (annotations
, p
);
5343 struct buffer
*given_buffer
= current_buffer
;
5344 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5345 { /* Use the global value of the hook. */
5348 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5350 p
= Fappend (2, arg
);
5353 Vwrite_region_annotations_so_far
= annotations
;
5354 res
= call2 (XCAR (p
), start
, end
);
5355 /* If the function makes a different buffer current,
5356 assume that means this buffer contains altered text to be output.
5357 Reset START and END from the buffer bounds
5358 and discard all previous annotations because they should have
5359 been dealt with by this function. */
5360 if (current_buffer
!= given_buffer
)
5362 XSETFASTINT (start
, BEGV
);
5363 XSETFASTINT (end
, ZV
);
5366 Flength (res
); /* Check basic validity of return value */
5367 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5371 /* Now do the same for annotation functions implied by the file-format */
5372 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
5373 p
= current_buffer
->auto_save_file_format
;
5375 p
= current_buffer
->file_format
;
5376 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5378 struct buffer
*given_buffer
= current_buffer
;
5380 Vwrite_region_annotations_so_far
= annotations
;
5382 /* Value is either a list of annotations or nil if the function
5383 has written annotations to a temporary buffer, which is now
5385 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5386 original_buffer
, make_number (i
));
5387 if (current_buffer
!= given_buffer
)
5389 XSETFASTINT (start
, BEGV
);
5390 XSETFASTINT (end
, ZV
);
5395 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5403 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5404 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5406 struct gcpro gcpro1
;
5409 GCPRO1 (annotations
);
5410 /* At last, do the same for the function PRE_WRITE_CONVERSION
5411 implied by the current coding-system. */
5412 if (!NILP (pre_write_conversion
))
5414 struct buffer
*given_buffer
= current_buffer
;
5415 Vwrite_region_annotations_so_far
= annotations
;
5416 res
= call2 (pre_write_conversion
, start
, end
);
5418 annotations
= (current_buffer
!= given_buffer
5420 : merge (annotations
, res
, Qcar_less_than_car
));
5427 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5428 If STRING is nil, POS is the character position in the current buffer.
5429 Intersperse with them the annotations from *ANNOT
5430 which fall within the range of POS to POS + NCHARS,
5431 each at its appropriate position.
5433 We modify *ANNOT by discarding elements as we use them up.
5435 The return value is negative in case of system call failure. */
5438 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5441 register int nchars
;
5444 struct coding_system
*coding
;
5448 int lastpos
= pos
+ nchars
;
5450 while (NILP (*annot
) || CONSP (*annot
))
5452 tem
= Fcar_safe (Fcar (*annot
));
5455 nextpos
= XFASTINT (tem
);
5457 /* If there are no more annotations in this range,
5458 output the rest of the range all at once. */
5459 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5460 return e_write (desc
, string
, pos
, lastpos
, coding
);
5462 /* Output buffer text up to the next annotation's position. */
5465 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5469 /* Output the annotation. */
5470 tem
= Fcdr (Fcar (*annot
));
5473 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5476 *annot
= Fcdr (*annot
);
5481 #ifndef WRITE_BUF_SIZE
5482 #define WRITE_BUF_SIZE (16 * 1024)
5485 /* Write text in the range START and END into descriptor DESC,
5486 encoding them with coding system CODING. If STRING is nil, START
5487 and END are character positions of the current buffer, else they
5488 are indexes to the string STRING. */
5491 e_write (desc
, string
, start
, end
, coding
)
5495 struct coding_system
*coding
;
5497 register char *addr
;
5498 register int nbytes
;
5499 char buf
[WRITE_BUF_SIZE
];
5503 coding
->composing
= COMPOSITION_DISABLED
;
5504 if (coding
->composing
!= COMPOSITION_DISABLED
)
5505 coding_save_composition (coding
, start
, end
, string
);
5507 if (STRINGP (string
))
5509 addr
= SDATA (string
);
5510 nbytes
= SBYTES (string
);
5511 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5513 else if (start
< end
)
5515 /* It is assured that the gap is not in the range START and END-1. */
5516 addr
= CHAR_POS_ADDR (start
);
5517 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5518 coding
->src_multibyte
5519 = !NILP (current_buffer
->enable_multibyte_characters
);
5525 coding
->src_multibyte
= 1;
5528 /* We used to have a code for handling selective display here. But,
5529 now it is handled within encode_coding. */
5534 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5535 if (coding
->produced
> 0)
5537 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5538 if (coding
->produced
)
5544 nbytes
-= coding
->consumed
;
5545 addr
+= coding
->consumed
;
5546 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5549 /* The source text ends by an incomplete multibyte form.
5550 There's no way other than write it out as is. */
5551 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5560 start
+= coding
->consumed_char
;
5561 if (coding
->cmp_data
)
5562 coding_adjust_composition_offset (coding
, start
);
5565 if (coding
->cmp_data
)
5566 coding_free_composition_data (coding
);
5571 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5572 Sverify_visited_file_modtime
, 1, 1, 0,
5573 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5574 This means that the file has not been changed since it was visited or saved.
5575 See Info node `(elisp)Modification Time' for more details. */)
5581 Lisp_Object handler
;
5582 Lisp_Object filename
;
5587 if (!STRINGP (b
->filename
)) return Qt
;
5588 if (b
->modtime
== 0) return Qt
;
5590 /* If the file name has special constructs in it,
5591 call the corresponding file handler. */
5592 handler
= Ffind_file_name_handler (b
->filename
,
5593 Qverify_visited_file_modtime
);
5594 if (!NILP (handler
))
5595 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5597 filename
= ENCODE_FILE (b
->filename
);
5599 if (stat (SDATA (filename
), &st
) < 0)
5601 /* If the file doesn't exist now and didn't exist before,
5602 we say that it isn't modified, provided the error is a tame one. */
5603 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5608 if (st
.st_mtime
== b
->modtime
5609 /* If both are positive, accept them if they are off by one second. */
5610 || (st
.st_mtime
> 0 && b
->modtime
> 0
5611 && (st
.st_mtime
== b
->modtime
+ 1
5612 || st
.st_mtime
== b
->modtime
- 1)))
5617 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5618 Sclear_visited_file_modtime
, 0, 0, 0,
5619 doc
: /* Clear out records of last mod time of visited file.
5620 Next attempt to save will certainly not complain of a discrepancy. */)
5623 current_buffer
->modtime
= 0;
5627 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5628 Svisited_file_modtime
, 0, 0, 0,
5629 doc
: /* Return the current buffer's recorded visited file modification time.
5630 The value is a list of the form (HIGH LOW), like the time values
5631 that `file-attributes' returns. If the current buffer has no recorded
5632 file modification time, this function returns 0.
5633 See Info node `(elisp)Modification Time' for more details. */)
5637 tcons
= long_to_cons ((unsigned long) current_buffer
->modtime
);
5639 return list2 (XCAR (tcons
), XCDR (tcons
));
5643 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5644 Sset_visited_file_modtime
, 0, 1, 0,
5645 doc
: /* Update buffer's recorded modification time from the visited file's time.
5646 Useful if the buffer was not read from the file normally
5647 or if the file itself has been changed for some known benign reason.
5648 An argument specifies the modification time value to use
5649 \(instead of that of the visited file), in the form of a list
5650 \(HIGH . LOW) or (HIGH LOW). */)
5652 Lisp_Object time_list
;
5654 if (!NILP (time_list
))
5655 current_buffer
->modtime
= cons_to_long (time_list
);
5658 register Lisp_Object filename
;
5660 Lisp_Object handler
;
5662 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5664 /* If the file name has special constructs in it,
5665 call the corresponding file handler. */
5666 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5667 if (!NILP (handler
))
5668 /* The handler can find the file name the same way we did. */
5669 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5671 filename
= ENCODE_FILE (filename
);
5673 if (stat (SDATA (filename
), &st
) >= 0)
5674 current_buffer
->modtime
= st
.st_mtime
;
5681 auto_save_error (error
)
5684 Lisp_Object args
[3], msg
;
5686 struct gcpro gcpro1
;
5690 args
[0] = build_string ("Auto-saving %s: %s");
5691 args
[1] = current_buffer
->name
;
5692 args
[2] = Ferror_message_string (error
);
5693 msg
= Fformat (3, args
);
5695 nbytes
= SBYTES (msg
);
5697 for (i
= 0; i
< 3; ++i
)
5700 message2 (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5702 message2_nolog (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5703 Fsleep_for (make_number (1), Qnil
);
5715 /* Get visited file's mode to become the auto save file's mode. */
5716 if (! NILP (current_buffer
->filename
)
5717 && stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5718 /* But make sure we can overwrite it later! */
5719 auto_save_mode_bits
= st
.st_mode
| 0600;
5721 auto_save_mode_bits
= 0666;
5724 Fwrite_region (Qnil
, Qnil
,
5725 current_buffer
->auto_save_file_name
,
5726 Qnil
, Qlambda
, Qnil
, Qnil
);
5730 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5735 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5736 | XFASTINT (XCDR (stream
))));
5741 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5744 minibuffer_auto_raise
= XINT (value
);
5749 do_auto_save_make_dir (dir
)
5752 return call2 (Qmake_directory
, dir
, Qt
);
5756 do_auto_save_eh (ignore
)
5762 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5763 doc
: /* Auto-save all buffers that need it.
5764 This is all buffers that have auto-saving enabled
5765 and are changed since last auto-saved.
5766 Auto-saving writes the buffer into a file
5767 so that your editing is not lost if the system crashes.
5768 This file is not the file you visited; that changes only when you save.
5769 Normally we run the normal hook `auto-save-hook' before saving.
5771 A non-nil NO-MESSAGE argument means do not print any message if successful.
5772 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5773 (no_message
, current_only
)
5774 Lisp_Object no_message
, current_only
;
5776 struct buffer
*old
= current_buffer
, *b
;
5777 Lisp_Object tail
, buf
;
5779 int do_handled_files
;
5782 Lisp_Object lispstream
;
5783 int count
= SPECPDL_INDEX ();
5784 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5785 int old_message_p
= 0;
5786 struct gcpro gcpro1
, gcpro2
;
5788 if (max_specpdl_size
< specpdl_size
+ 40)
5789 max_specpdl_size
= specpdl_size
+ 40;
5794 if (NILP (no_message
))
5796 old_message_p
= push_message ();
5797 record_unwind_protect (pop_message_unwind
, Qnil
);
5800 /* Ordinarily don't quit within this function,
5801 but don't make it impossible to quit (in case we get hung in I/O). */
5805 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5806 point to non-strings reached from Vbuffer_alist. */
5808 if (!NILP (Vrun_hooks
))
5809 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5811 if (STRINGP (Vauto_save_list_file_name
))
5813 Lisp_Object listfile
;
5815 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5817 /* Don't try to create the directory when shutting down Emacs,
5818 because creating the directory might signal an error, and
5819 that would leave Emacs in a strange state. */
5820 if (!NILP (Vrun_hooks
))
5824 GCPRO2 (dir
, listfile
);
5825 dir
= Ffile_name_directory (listfile
);
5826 if (NILP (Ffile_directory_p (dir
)))
5827 internal_condition_case_1 (do_auto_save_make_dir
,
5828 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5833 stream
= fopen (SDATA (listfile
), "w");
5836 /* Arrange to close that file whether or not we get an error.
5837 Also reset auto_saving to 0. */
5838 lispstream
= Fcons (Qnil
, Qnil
);
5839 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
5840 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
5851 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5852 record_unwind_protect (do_auto_save_unwind_1
,
5853 make_number (minibuffer_auto_raise
));
5854 minibuffer_auto_raise
= 0;
5857 /* On first pass, save all files that don't have handlers.
5858 On second pass, save all files that do have handlers.
5860 If Emacs is crashing, the handlers may tweak what is causing
5861 Emacs to crash in the first place, and it would be a shame if
5862 Emacs failed to autosave perfectly ordinary files because it
5863 couldn't handle some ange-ftp'd file. */
5865 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5866 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5868 buf
= XCDR (XCAR (tail
));
5871 /* Record all the buffers that have auto save mode
5872 in the special file that lists them. For each of these buffers,
5873 Record visited name (if any) and auto save name. */
5874 if (STRINGP (b
->auto_save_file_name
)
5875 && stream
!= NULL
&& do_handled_files
== 0)
5877 if (!NILP (b
->filename
))
5879 fwrite (SDATA (b
->filename
), 1,
5880 SBYTES (b
->filename
), stream
);
5882 putc ('\n', stream
);
5883 fwrite (SDATA (b
->auto_save_file_name
), 1,
5884 SBYTES (b
->auto_save_file_name
), stream
);
5885 putc ('\n', stream
);
5888 if (!NILP (current_only
)
5889 && b
!= current_buffer
)
5892 /* Don't auto-save indirect buffers.
5893 The base buffer takes care of it. */
5897 /* Check for auto save enabled
5898 and file changed since last auto save
5899 and file changed since last real save. */
5900 if (STRINGP (b
->auto_save_file_name
)
5901 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5902 && b
->auto_save_modified
< BUF_MODIFF (b
)
5903 /* -1 means we've turned off autosaving for a while--see below. */
5904 && XINT (b
->save_length
) >= 0
5905 && (do_handled_files
5906 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5909 EMACS_TIME before_time
, after_time
;
5911 EMACS_GET_TIME (before_time
);
5913 /* If we had a failure, don't try again for 20 minutes. */
5914 if (b
->auto_save_failure_time
>= 0
5915 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5918 if ((XFASTINT (b
->save_length
) * 10
5919 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5920 /* A short file is likely to change a large fraction;
5921 spare the user annoying messages. */
5922 && XFASTINT (b
->save_length
) > 5000
5923 /* These messages are frequent and annoying for `*mail*'. */
5924 && !EQ (b
->filename
, Qnil
)
5925 && NILP (no_message
))
5927 /* It has shrunk too much; turn off auto-saving here. */
5928 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5929 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5931 minibuffer_auto_raise
= 0;
5932 /* Turn off auto-saving until there's a real save,
5933 and prevent any more warnings. */
5934 XSETINT (b
->save_length
, -1);
5935 Fsleep_for (make_number (1), Qnil
);
5938 set_buffer_internal (b
);
5939 if (!auto_saved
&& NILP (no_message
))
5940 message1 ("Auto-saving...");
5941 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5943 b
->auto_save_modified
= BUF_MODIFF (b
);
5944 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5945 set_buffer_internal (old
);
5947 EMACS_GET_TIME (after_time
);
5949 /* If auto-save took more than 60 seconds,
5950 assume it was an NFS failure that got a timeout. */
5951 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5952 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5956 /* Prevent another auto save till enough input events come in. */
5957 record_auto_save ();
5959 if (auto_saved
&& NILP (no_message
))
5963 /* If we are going to restore an old message,
5964 give time to read ours. */
5965 sit_for (1, 0, 0, 0, 0);
5969 /* If we displayed a message and then restored a state
5970 with no message, leave a "done" message on the screen. */
5971 message1 ("Auto-saving...done");
5976 /* This restores the message-stack status. */
5977 unbind_to (count
, Qnil
);
5981 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5982 Sset_buffer_auto_saved
, 0, 0, 0,
5983 doc
: /* Mark current buffer as auto-saved with its current text.
5984 No auto-save file will be written until the buffer changes again. */)
5987 current_buffer
->auto_save_modified
= MODIFF
;
5988 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5989 current_buffer
->auto_save_failure_time
= -1;
5993 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5994 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5995 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5998 current_buffer
->auto_save_failure_time
= -1;
6002 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6004 doc
: /* Return t if buffer has been auto-saved since last read in or saved. */)
6007 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6010 /* Reading and completing file names */
6011 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
6013 /* In the string VAL, change each $ to $$ and return the result. */
6016 double_dollars (val
)
6019 register const unsigned char *old
;
6020 register unsigned char *new;
6024 osize
= SBYTES (val
);
6026 /* Count the number of $ characters. */
6027 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
6028 if (*old
++ == '$') count
++;
6032 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
6035 for (n
= osize
; n
> 0; n
--)
6049 read_file_name_cleanup (arg
)
6052 return (current_buffer
->directory
= arg
);
6055 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
6057 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
6058 (string
, dir
, action
)
6059 Lisp_Object string
, dir
, action
;
6060 /* action is nil for complete, t for return list of completions,
6061 lambda for verify final value */
6063 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
6065 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
6067 CHECK_STRING (string
);
6074 /* No need to protect ACTION--we only compare it with t and nil. */
6075 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6077 if (SCHARS (string
) == 0)
6079 if (EQ (action
, Qlambda
))
6087 orig_string
= string
;
6088 string
= Fsubstitute_in_file_name (string
);
6089 changed
= NILP (Fstring_equal (string
, orig_string
));
6090 name
= Ffile_name_nondirectory (string
);
6091 val
= Ffile_name_directory (string
);
6093 realdir
= Fexpand_file_name (val
, realdir
);
6098 specdir
= Ffile_name_directory (string
);
6099 val
= Ffile_name_completion (name
, realdir
);
6104 return double_dollars (string
);
6108 if (!NILP (specdir
))
6109 val
= concat2 (specdir
, val
);
6111 return double_dollars (val
);
6114 #endif /* not VMS */
6118 if (EQ (action
, Qt
))
6120 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6124 if (NILP (Vread_file_name_predicate
)
6125 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6129 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6131 /* Brute-force speed up for directory checking:
6132 Discard strings which don't end in a slash. */
6133 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6135 Lisp_Object tem
= XCAR (all
);
6137 if (STRINGP (tem
) &&
6138 (len
= SCHARS (tem
), len
> 0) &&
6139 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6140 comp
= Fcons (tem
, comp
);
6146 /* Must do it the hard (and slow) way. */
6147 GCPRO3 (all
, comp
, specdir
);
6148 count
= SPECPDL_INDEX ();
6149 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6150 current_buffer
->directory
= realdir
;
6151 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6152 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
6153 comp
= Fcons (XCAR (all
), comp
);
6154 unbind_to (count
, Qnil
);
6157 return Fnreverse (comp
);
6160 /* Only other case actually used is ACTION = lambda */
6162 /* Supposedly this helps commands such as `cd' that read directory names,
6163 but can someone explain how it helps them? -- RMS */
6164 if (SCHARS (name
) == 0)
6167 string
= Fexpand_file_name (string
, dir
);
6168 if (!NILP (Vread_file_name_predicate
))
6169 return call1 (Vread_file_name_predicate
, string
);
6170 return Ffile_exists_p (string
);
6173 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6174 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6175 Value is not expanded---you must call `expand-file-name' yourself.
6176 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6177 the same non-empty string that was inserted by this function.
6178 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6179 except that if INITIAL is specified, that combined with DIR is used.)
6180 If the user exits with an empty minibuffer, this function returns
6181 an empty string. (This can only happen if the user erased the
6182 pre-inserted contents or if `insert-default-directory' is nil.)
6183 Fourth arg MUSTMATCH non-nil means require existing file's name.
6184 Non-nil and non-t means also require confirmation after completion.
6185 Fifth arg INITIAL specifies text to start with.
6186 If optional sixth arg PREDICATE is non-nil, possible completions and
6187 the resulting file name must satisfy (funcall PREDICATE NAME).
6188 DIR should be an absolute directory name. It defaults to the value of
6189 `default-directory'.
6191 If this command was invoked with the mouse, use a file dialog box if
6192 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6193 provides a file dialog box.
6195 See also `read-file-name-completion-ignore-case'
6196 and `read-file-name-function'. */)
6197 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6198 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6200 Lisp_Object val
, insdef
, tem
;
6201 struct gcpro gcpro1
, gcpro2
;
6202 register char *homedir
;
6203 Lisp_Object decoded_homedir
;
6204 int replace_in_history
= 0;
6205 int add_to_history
= 0;
6209 dir
= current_buffer
->directory
;
6210 if (NILP (Ffile_name_absolute_p (dir
)))
6211 dir
= Fexpand_file_name (dir
, Qnil
);
6212 if (NILP (default_filename
))
6215 ? Fexpand_file_name (initial
, dir
)
6216 : current_buffer
->filename
);
6218 /* If dir starts with user's homedir, change that to ~. */
6219 homedir
= (char *) egetenv ("HOME");
6221 /* homedir can be NULL in temacs, since Vprocess_environment is not
6222 yet set up. We shouldn't crash in that case. */
6225 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6226 CORRECT_DIR_SEPS (homedir
);
6231 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6234 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6235 SBYTES (decoded_homedir
))
6236 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6238 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6239 dir
= concat2 (build_string ("~"), dir
);
6241 /* Likewise for default_filename. */
6243 && STRINGP (default_filename
)
6244 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6245 SBYTES (decoded_homedir
))
6246 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6249 = Fsubstring (default_filename
,
6250 make_number (SCHARS (decoded_homedir
)), Qnil
);
6251 default_filename
= concat2 (build_string ("~"), default_filename
);
6253 if (!NILP (default_filename
))
6255 CHECK_STRING (default_filename
);
6256 default_filename
= double_dollars (default_filename
);
6259 if (insert_default_directory
&& STRINGP (dir
))
6262 if (!NILP (initial
))
6264 Lisp_Object args
[2], pos
;
6268 insdef
= Fconcat (2, args
);
6269 pos
= make_number (SCHARS (double_dollars (dir
)));
6270 insdef
= Fcons (double_dollars (insdef
), pos
);
6273 insdef
= double_dollars (insdef
);
6275 else if (STRINGP (initial
))
6276 insdef
= Fcons (double_dollars (initial
), make_number (0));
6280 if (!NILP (Vread_file_name_function
))
6282 Lisp_Object args
[7];
6284 GCPRO2 (insdef
, default_filename
);
6285 args
[0] = Vread_file_name_function
;
6288 args
[3] = default_filename
;
6289 args
[4] = mustmatch
;
6291 args
[6] = predicate
;
6292 RETURN_UNGCPRO (Ffuncall (7, args
));
6295 count
= SPECPDL_INDEX ();
6296 specbind (intern ("completion-ignore-case"),
6297 read_file_name_completion_ignore_case
? Qt
: Qnil
);
6298 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6299 specbind (intern ("read-file-name-predicate"),
6300 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6302 GCPRO2 (insdef
, default_filename
);
6304 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (TARGET_API_MAC_CARBON)
6305 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6310 /* If DIR contains a file name, split it. */
6312 file
= Ffile_name_nondirectory (dir
);
6313 if (SCHARS (file
) && NILP (default_filename
))
6315 default_filename
= file
;
6316 dir
= Ffile_name_directory (dir
);
6318 if (!NILP(default_filename
))
6319 default_filename
= Fexpand_file_name (default_filename
, dir
);
6320 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
);
6325 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6326 dir
, mustmatch
, insdef
,
6327 Qfile_name_history
, default_filename
, Qnil
);
6329 tem
= Fsymbol_value (Qfile_name_history
);
6330 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6331 replace_in_history
= 1;
6333 /* If Fcompleting_read returned the inserted default string itself
6334 (rather than a new string with the same contents),
6335 it has to mean that the user typed RET with the minibuffer empty.
6336 In that case, we really want to return ""
6337 so that commands such as set-visited-file-name can distinguish. */
6338 if (EQ (val
, default_filename
))
6340 /* In this case, Fcompleting_read has not added an element
6341 to the history. Maybe we should. */
6342 if (! replace_in_history
)
6348 unbind_to (count
, Qnil
);
6351 error ("No file name specified");
6353 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6355 if (!NILP (tem
) && !NILP (default_filename
))
6356 val
= default_filename
;
6357 val
= Fsubstitute_in_file_name (val
);
6359 if (replace_in_history
)
6360 /* Replace what Fcompleting_read added to the history
6361 with what we will actually return. */
6362 XSETCAR (Fsymbol_value (Qfile_name_history
), double_dollars (val
));
6363 else if (add_to_history
)
6365 /* Add the value to the history--but not if it matches
6366 the last value already there. */
6367 Lisp_Object val1
= double_dollars (val
);
6368 tem
= Fsymbol_value (Qfile_name_history
);
6369 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6370 Fset (Qfile_name_history
,
6381 /* Must be set before any path manipulation is performed. */
6382 XSETFASTINT (Vdirectory_sep_char
, '/');
6389 Qexpand_file_name
= intern ("expand-file-name");
6390 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6391 Qdirectory_file_name
= intern ("directory-file-name");
6392 Qfile_name_directory
= intern ("file-name-directory");
6393 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6394 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6395 Qfile_name_as_directory
= intern ("file-name-as-directory");
6396 Qcopy_file
= intern ("copy-file");
6397 Qmake_directory_internal
= intern ("make-directory-internal");
6398 Qmake_directory
= intern ("make-directory");
6399 Qdelete_directory
= intern ("delete-directory");
6400 Qdelete_file
= intern ("delete-file");
6401 Qrename_file
= intern ("rename-file");
6402 Qadd_name_to_file
= intern ("add-name-to-file");
6403 Qmake_symbolic_link
= intern ("make-symbolic-link");
6404 Qfile_exists_p
= intern ("file-exists-p");
6405 Qfile_executable_p
= intern ("file-executable-p");
6406 Qfile_readable_p
= intern ("file-readable-p");
6407 Qfile_writable_p
= intern ("file-writable-p");
6408 Qfile_symlink_p
= intern ("file-symlink-p");
6409 Qaccess_file
= intern ("access-file");
6410 Qfile_directory_p
= intern ("file-directory-p");
6411 Qfile_regular_p
= intern ("file-regular-p");
6412 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6413 Qfile_modes
= intern ("file-modes");
6414 Qset_file_modes
= intern ("set-file-modes");
6415 Qset_file_times
= intern ("set-file-times");
6416 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6417 Qinsert_file_contents
= intern ("insert-file-contents");
6418 Qwrite_region
= intern ("write-region");
6419 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6420 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6421 Qauto_save_coding
= intern ("auto-save-coding");
6423 staticpro (&Qexpand_file_name
);
6424 staticpro (&Qsubstitute_in_file_name
);
6425 staticpro (&Qdirectory_file_name
);
6426 staticpro (&Qfile_name_directory
);
6427 staticpro (&Qfile_name_nondirectory
);
6428 staticpro (&Qunhandled_file_name_directory
);
6429 staticpro (&Qfile_name_as_directory
);
6430 staticpro (&Qcopy_file
);
6431 staticpro (&Qmake_directory_internal
);
6432 staticpro (&Qmake_directory
);
6433 staticpro (&Qdelete_directory
);
6434 staticpro (&Qdelete_file
);
6435 staticpro (&Qrename_file
);
6436 staticpro (&Qadd_name_to_file
);
6437 staticpro (&Qmake_symbolic_link
);
6438 staticpro (&Qfile_exists_p
);
6439 staticpro (&Qfile_executable_p
);
6440 staticpro (&Qfile_readable_p
);
6441 staticpro (&Qfile_writable_p
);
6442 staticpro (&Qaccess_file
);
6443 staticpro (&Qfile_symlink_p
);
6444 staticpro (&Qfile_directory_p
);
6445 staticpro (&Qfile_regular_p
);
6446 staticpro (&Qfile_accessible_directory_p
);
6447 staticpro (&Qfile_modes
);
6448 staticpro (&Qset_file_modes
);
6449 staticpro (&Qset_file_times
);
6450 staticpro (&Qfile_newer_than_file_p
);
6451 staticpro (&Qinsert_file_contents
);
6452 staticpro (&Qwrite_region
);
6453 staticpro (&Qverify_visited_file_modtime
);
6454 staticpro (&Qset_visited_file_modtime
);
6455 staticpro (&Qauto_save_coding
);
6457 Qfile_name_history
= intern ("file-name-history");
6458 Fset (Qfile_name_history
, Qnil
);
6459 staticpro (&Qfile_name_history
);
6461 Qfile_error
= intern ("file-error");
6462 staticpro (&Qfile_error
);
6463 Qfile_already_exists
= intern ("file-already-exists");
6464 staticpro (&Qfile_already_exists
);
6465 Qfile_date_error
= intern ("file-date-error");
6466 staticpro (&Qfile_date_error
);
6467 Qexcl
= intern ("excl");
6471 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6472 staticpro (&Qfind_buffer_file_type
);
6475 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6476 doc
: /* *Coding system for encoding file names.
6477 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6478 Vfile_name_coding_system
= Qnil
;
6480 DEFVAR_LISP ("default-file-name-coding-system",
6481 &Vdefault_file_name_coding_system
,
6482 doc
: /* Default coding system for encoding file names.
6483 This variable is used only when `file-name-coding-system' is nil.
6485 This variable is set/changed by the command `set-language-environment'.
6486 User should not set this variable manually,
6487 instead use `file-name-coding-system' to get a constant encoding
6488 of file names regardless of the current language environment. */);
6489 Vdefault_file_name_coding_system
= Qnil
;
6491 Qformat_decode
= intern ("format-decode");
6492 staticpro (&Qformat_decode
);
6493 Qformat_annotate_function
= intern ("format-annotate-function");
6494 staticpro (&Qformat_annotate_function
);
6495 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6496 staticpro (&Qafter_insert_file_set_coding
);
6498 Qcar_less_than_car
= intern ("car-less-than-car");
6499 staticpro (&Qcar_less_than_car
);
6501 Fput (Qfile_error
, Qerror_conditions
,
6502 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6503 Fput (Qfile_error
, Qerror_message
,
6504 build_string ("File error"));
6506 Fput (Qfile_already_exists
, Qerror_conditions
,
6507 Fcons (Qfile_already_exists
,
6508 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6509 Fput (Qfile_already_exists
, Qerror_message
,
6510 build_string ("File already exists"));
6512 Fput (Qfile_date_error
, Qerror_conditions
,
6513 Fcons (Qfile_date_error
,
6514 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6515 Fput (Qfile_date_error
, Qerror_message
,
6516 build_string ("Cannot set file date"));
6518 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6519 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6520 Vread_file_name_function
= Qnil
;
6522 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6523 doc
: /* Current predicate used by `read-file-name-internal'. */);
6524 Vread_file_name_predicate
= Qnil
;
6526 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case
,
6527 doc
: /* *Non-nil means when reading a file name completion ignores case. */);
6528 #if defined VMS || defined DOS_NT || defined MAC_OS
6529 read_file_name_completion_ignore_case
= 1;
6531 read_file_name_completion_ignore_case
= 0;
6534 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6535 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6536 If the initial minibuffer contents are non-empty, you can usually
6537 request a default filename by typing RETURN without editing. For some
6538 commands, exiting with an empty minibuffer has a special meaning,
6539 such as making the current buffer visit no file in the case of
6540 `set-visited-file-name'.
6541 If this variable is non-nil, the minibuffer contents are always
6542 initially non-empty and typing RETURN without editing will fetch the
6543 default name, if one is provided. Note however that this default name
6544 is not necessarily the name originally inserted in the minibuffer, if
6545 that is just the default directory.
6546 If this variable is nil, the minibuffer often starts out empty. In
6547 that case you may have to explicitly fetch the next history element to
6548 request the default name. */);
6549 insert_default_directory
= 1;
6551 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6552 doc
: /* *Non-nil means write new files with record format `stmlf'.
6553 nil means use format `var'. This variable is meaningful only on VMS. */);
6554 vms_stmlf_recfm
= 0;
6556 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6557 doc
: /* Directory separator character for built-in functions that return file names.
6558 The value is always ?/. Don't use this variable, just use `/'. */);
6560 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6561 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6562 If a file name matches REGEXP, then all I/O on that file is done by calling
6565 The first argument given to HANDLER is the name of the I/O primitive
6566 to be handled; the remaining arguments are the arguments that were
6567 passed to that primitive. For example, if you do
6568 (file-exists-p FILENAME)
6569 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6570 (funcall HANDLER 'file-exists-p FILENAME)
6571 The function `find-file-name-handler' checks this list for a handler
6572 for its argument. */);
6573 Vfile_name_handler_alist
= Qnil
;
6575 DEFVAR_LISP ("set-auto-coding-function",
6576 &Vset_auto_coding_function
,
6577 doc
: /* If non-nil, a function to call to decide a coding system of file.
6578 Two arguments are passed to this function: the file name
6579 and the length of a file contents following the point.
6580 This function should return a coding system to decode the file contents.
6581 It should check the file name against `auto-coding-alist'.
6582 If no coding system is decided, it should check a coding system
6583 specified in the heading lines with the format:
6584 -*- ... coding: CODING-SYSTEM; ... -*-
6585 or local variable spec of the tailing lines with `coding:' tag. */);
6586 Vset_auto_coding_function
= Qnil
;
6588 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6589 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6590 Each is passed one argument, the number of characters inserted.
6591 It should return the new character count, and leave point the same.
6592 If `insert-file-contents' is intercepted by a handler from
6593 `file-name-handler-alist', that handler is responsible for calling the
6594 functions in `after-insert-file-functions' if appropriate. */);
6595 Vafter_insert_file_functions
= Qnil
;
6597 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6598 doc
: /* A list of functions to be called at the start of `write-region'.
6599 Each is passed two arguments, START and END as for `write-region'.
6600 These are usually two numbers but not always; see the documentation
6601 for `write-region'. The function should return a list of pairs
6602 of the form (POSITION . STRING), consisting of strings to be effectively
6603 inserted at the specified positions of the file being written (1 means to
6604 insert before the first byte written). The POSITIONs must be sorted into
6605 increasing order. If there are several functions in the list, the several
6606 lists are merged destructively. Alternatively, the function can return
6607 with a different buffer current; in that case it should pay attention
6608 to the annotations returned by previous functions and listed in
6609 `write-region-annotations-so-far'.*/);
6610 Vwrite_region_annotate_functions
= Qnil
;
6611 staticpro (&Qwrite_region_annotate_functions
);
6612 Qwrite_region_annotate_functions
6613 = intern ("write-region-annotate-functions");
6615 DEFVAR_LISP ("write-region-annotations-so-far",
6616 &Vwrite_region_annotations_so_far
,
6617 doc
: /* When an annotation function is called, this holds the previous annotations.
6618 These are the annotations made by other annotation functions
6619 that were already called. See also `write-region-annotate-functions'. */);
6620 Vwrite_region_annotations_so_far
= Qnil
;
6622 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6623 doc
: /* A list of file name handlers that temporarily should not be used.
6624 This applies only to the operation `inhibit-file-name-operation'. */);
6625 Vinhibit_file_name_handlers
= Qnil
;
6627 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6628 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6629 Vinhibit_file_name_operation
= Qnil
;
6631 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6632 doc
: /* File name in which we write a list of all auto save file names.
6633 This variable is initialized automatically from `auto-save-list-file-prefix'
6634 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6635 a non-nil value. */);
6636 Vauto_save_list_file_name
= Qnil
;
6638 defsubr (&Sfind_file_name_handler
);
6639 defsubr (&Sfile_name_directory
);
6640 defsubr (&Sfile_name_nondirectory
);
6641 defsubr (&Sunhandled_file_name_directory
);
6642 defsubr (&Sfile_name_as_directory
);
6643 defsubr (&Sdirectory_file_name
);
6644 defsubr (&Smake_temp_name
);
6645 defsubr (&Sexpand_file_name
);
6646 defsubr (&Ssubstitute_in_file_name
);
6647 defsubr (&Scopy_file
);
6648 defsubr (&Smake_directory_internal
);
6649 defsubr (&Sdelete_directory
);
6650 defsubr (&Sdelete_file
);
6651 defsubr (&Srename_file
);
6652 defsubr (&Sadd_name_to_file
);
6654 defsubr (&Smake_symbolic_link
);
6655 #endif /* S_IFLNK */
6657 defsubr (&Sdefine_logical_name
);
6660 defsubr (&Ssysnetunam
);
6661 #endif /* HPUX_NET */
6662 defsubr (&Sfile_name_absolute_p
);
6663 defsubr (&Sfile_exists_p
);
6664 defsubr (&Sfile_executable_p
);
6665 defsubr (&Sfile_readable_p
);
6666 defsubr (&Sfile_writable_p
);
6667 defsubr (&Saccess_file
);
6668 defsubr (&Sfile_symlink_p
);
6669 defsubr (&Sfile_directory_p
);
6670 defsubr (&Sfile_accessible_directory_p
);
6671 defsubr (&Sfile_regular_p
);
6672 defsubr (&Sfile_modes
);
6673 defsubr (&Sset_file_modes
);
6674 defsubr (&Sset_file_times
);
6675 defsubr (&Sset_default_file_modes
);
6676 defsubr (&Sdefault_file_modes
);
6677 defsubr (&Sfile_newer_than_file_p
);
6678 defsubr (&Sinsert_file_contents
);
6679 defsubr (&Swrite_region
);
6680 defsubr (&Scar_less_than_car
);
6681 defsubr (&Sverify_visited_file_modtime
);
6682 defsubr (&Sclear_visited_file_modtime
);
6683 defsubr (&Svisited_file_modtime
);
6684 defsubr (&Sset_visited_file_modtime
);
6685 defsubr (&Sdo_auto_save
);
6686 defsubr (&Sset_buffer_auto_saved
);
6687 defsubr (&Sclear_buffer_auto_save_failure
);
6688 defsubr (&Srecent_auto_save_p
);
6690 defsubr (&Sread_file_name_internal
);
6691 defsubr (&Sread_file_name
);
6694 defsubr (&Sunix_sync
);
6698 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6699 (do not change this comment) */