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, 2005 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"
78 #include "character.h"
87 #endif /* not WINDOWSNT */
91 #include <sys/param.h>
99 #define CORRECT_DIR_SEPS(s) \
100 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
101 else unixtodos_filename (s); \
103 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
104 redirector allows the six letters between 'Z' and 'a' as well. */
106 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
109 #define IS_DRIVE(x) isalpha (x)
111 /* Need to lower-case the drive letter, or else expanded
112 filenames will sometimes compare inequal, because
113 `expand-file-name' doesn't always down-case the drive letter. */
114 #define DRIVE_LETTER(x) (tolower (x))
135 #include "commands.h"
136 extern int use_dialog_box
;
137 extern int use_file_dialog
;
151 #ifndef FILE_SYSTEM_CASE
152 #define FILE_SYSTEM_CASE(filename) (filename)
155 /* Nonzero during writing of auto-save files */
158 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
159 a new file with the same mode as the original */
160 int auto_save_mode_bits
;
162 /* The symbol bound to coding-system-for-read when
163 insert-file-contents is called for recovering a file. This is not
164 an actual coding system name, but just an indicator to tell
165 insert-file-contents to use `emacs-mule' with a special flag for
166 auto saving and recovering a file. */
167 Lisp_Object Qauto_save_coding
;
169 /* Coding system for file names, or nil if none. */
170 Lisp_Object Vfile_name_coding_system
;
172 /* Coding system for file names used only when
173 Vfile_name_coding_system is nil. */
174 Lisp_Object Vdefault_file_name_coding_system
;
176 /* Alist of elements (REGEXP . HANDLER) for file names
177 whose I/O is done with a special handler. */
178 Lisp_Object Vfile_name_handler_alist
;
180 /* Lisp functions for translating file formats */
181 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
183 /* Function to be called to decide a coding system of a reading file. */
184 Lisp_Object Vset_auto_coding_function
;
186 /* Functions to be called to process text properties in inserted file. */
187 Lisp_Object Vafter_insert_file_functions
;
189 /* Lisp function for setting buffer-file-coding-system and the
190 multibyteness of the current buffer after inserting a file. */
191 Lisp_Object Qafter_insert_file_set_coding
;
193 /* Functions to be called to create text property annotations for file. */
194 Lisp_Object Vwrite_region_annotate_functions
;
195 Lisp_Object Qwrite_region_annotate_functions
;
197 /* During build_annotations, each time an annotation function is called,
198 this holds the annotations made by the previous functions. */
199 Lisp_Object Vwrite_region_annotations_so_far
;
201 /* File name in which we write a list of all our auto save files. */
202 Lisp_Object Vauto_save_list_file_name
;
204 /* Function to call to read a file name. */
205 Lisp_Object Vread_file_name_function
;
207 /* Current predicate used by read_file_name_internal. */
208 Lisp_Object Vread_file_name_predicate
;
210 /* Nonzero means completion ignores case when reading file name. */
211 int read_file_name_completion_ignore_case
;
213 /* Nonzero means, when reading a filename in the minibuffer,
214 start out by inserting the default directory into the minibuffer. */
215 int insert_default_directory
;
217 /* On VMS, nonzero means write new files with record format stmlf.
218 Zero means use var format. */
221 /* On NT, specifies the directory separator character, used (eg.) when
222 expanding file names. This can be bound to / or \. */
223 Lisp_Object Vdirectory_sep_char
;
225 extern Lisp_Object Vuser_login_name
;
228 extern Lisp_Object Vw32_get_true_file_attributes
;
231 extern int minibuf_level
;
233 extern int minibuffer_auto_raise
;
235 extern int history_delete_duplicates
;
237 /* These variables describe handlers that have "already" had a chance
238 to handle the current operation.
240 Vinhibit_file_name_handlers is a list of file name handlers.
241 Vinhibit_file_name_operation is the operation being handled.
242 If we try to handle that operation, we ignore those handlers. */
244 static Lisp_Object Vinhibit_file_name_handlers
;
245 static Lisp_Object Vinhibit_file_name_operation
;
247 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
249 Lisp_Object Qfile_name_history
;
251 Lisp_Object Qcar_less_than_car
;
253 static int a_write
P_ ((int, Lisp_Object
, int, int,
254 Lisp_Object
*, struct coding_system
*));
255 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
259 report_file_error (string
, data
)
263 Lisp_Object errstring
;
267 synchronize_system_messages_locale ();
268 str
= strerror (errorno
);
269 errstring
= code_convert_string_norecord (make_unibyte_string (str
,
271 Vlocale_coding_system
, 0);
277 Fsignal (Qfile_already_exists
, Fcons (errstring
, data
));
280 /* System error messages are capitalized. Downcase the initial
281 unless it is followed by a slash. */
282 if (SREF (errstring
, 1) != '/')
283 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
285 Fsignal (Qfile_error
,
286 Fcons (build_string (string
), Fcons (errstring
, data
)));
291 close_file_unwind (fd
)
294 emacs_close (XFASTINT (fd
));
298 /* Restore point, having saved it as a marker. */
301 restore_point_unwind (location
)
302 Lisp_Object location
;
304 Fgoto_char (location
);
305 Fset_marker (location
, Qnil
, Qnil
);
310 Lisp_Object Qexpand_file_name
;
311 Lisp_Object Qsubstitute_in_file_name
;
312 Lisp_Object Qdirectory_file_name
;
313 Lisp_Object Qfile_name_directory
;
314 Lisp_Object Qfile_name_nondirectory
;
315 Lisp_Object Qunhandled_file_name_directory
;
316 Lisp_Object Qfile_name_as_directory
;
317 Lisp_Object Qcopy_file
;
318 Lisp_Object Qmake_directory_internal
;
319 Lisp_Object Qmake_directory
;
320 Lisp_Object Qdelete_directory
;
321 Lisp_Object Qdelete_file
;
322 Lisp_Object Qrename_file
;
323 Lisp_Object Qadd_name_to_file
;
324 Lisp_Object Qmake_symbolic_link
;
325 Lisp_Object Qfile_exists_p
;
326 Lisp_Object Qfile_executable_p
;
327 Lisp_Object Qfile_readable_p
;
328 Lisp_Object Qfile_writable_p
;
329 Lisp_Object Qfile_symlink_p
;
330 Lisp_Object Qaccess_file
;
331 Lisp_Object Qfile_directory_p
;
332 Lisp_Object Qfile_regular_p
;
333 Lisp_Object Qfile_accessible_directory_p
;
334 Lisp_Object Qfile_modes
;
335 Lisp_Object Qset_file_modes
;
336 Lisp_Object Qset_file_times
;
337 Lisp_Object Qfile_newer_than_file_p
;
338 Lisp_Object Qinsert_file_contents
;
339 Lisp_Object Qwrite_region
;
340 Lisp_Object Qverify_visited_file_modtime
;
341 Lisp_Object Qset_visited_file_modtime
;
343 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
344 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
345 Otherwise, return nil.
346 A file name is handled if one of the regular expressions in
347 `file-name-handler-alist' matches it.
349 If OPERATION equals `inhibit-file-name-operation', then we ignore
350 any handlers that are members of `inhibit-file-name-handlers',
351 but we still do run any other handlers. This lets handlers
352 use the standard functions without calling themselves recursively. */)
353 (filename
, operation
)
354 Lisp_Object filename
, operation
;
356 /* This function must not munge the match data. */
357 Lisp_Object chain
, inhibited_handlers
, result
;
361 CHECK_STRING (filename
);
363 if (EQ (operation
, Vinhibit_file_name_operation
))
364 inhibited_handlers
= Vinhibit_file_name_handlers
;
366 inhibited_handlers
= Qnil
;
368 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
369 chain
= XCDR (chain
))
379 && (match_pos
= fast_string_match (string
, filename
)) > pos
)
381 Lisp_Object handler
, tem
;
383 handler
= XCDR (elt
);
384 tem
= Fmemq (handler
, inhibited_handlers
);
398 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
400 doc
: /* Return the directory component in file name FILENAME.
401 Return nil if FILENAME does not include a directory.
402 Otherwise return a directory spec.
403 Given a Unix syntax file name, returns a string ending in slash;
404 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
406 Lisp_Object filename
;
409 register const unsigned char *beg
;
411 register unsigned char *beg
;
413 register const unsigned char *p
;
416 CHECK_STRING (filename
);
418 /* If the file name has special constructs in it,
419 call the corresponding file handler. */
420 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
422 return call2 (handler
, Qfile_name_directory
, filename
);
424 filename
= FILE_SYSTEM_CASE (filename
);
425 beg
= SDATA (filename
);
427 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
429 p
= beg
+ SBYTES (filename
);
431 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
433 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
436 /* only recognise drive specifier at the beginning */
438 /* handle the "/:d:foo" and "/:foo" cases correctly */
439 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
440 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
447 /* Expansion of "c:" to drive and default directory. */
450 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
451 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
452 unsigned char *r
= res
;
454 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
456 strncpy (res
, beg
, 2);
461 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
463 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
466 p
= beg
+ strlen (beg
);
469 CORRECT_DIR_SEPS (beg
);
472 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
475 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
476 Sfile_name_nondirectory
, 1, 1, 0,
477 doc
: /* Return file name FILENAME sans its directory.
478 For example, in a Unix-syntax file name,
479 this is everything after the last slash,
480 or the entire name if it contains no slash. */)
482 Lisp_Object filename
;
484 register const unsigned char *beg
, *p
, *end
;
487 CHECK_STRING (filename
);
489 /* If the file name has special constructs in it,
490 call the corresponding file handler. */
491 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
493 return call2 (handler
, Qfile_name_nondirectory
, filename
);
495 beg
= SDATA (filename
);
496 end
= p
= beg
+ SBYTES (filename
);
498 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
500 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
503 /* only recognise drive specifier at beginning */
505 /* handle the "/:d:foo" case correctly */
506 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
511 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
514 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
515 Sunhandled_file_name_directory
, 1, 1, 0,
516 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
517 A `directly usable' directory name is one that may be used without the
518 intervention of any file handler.
519 If FILENAME is a directly usable file itself, return
520 \(file-name-directory FILENAME).
521 The `call-process' and `start-process' functions use this function to
522 get a current directory to run processes in. */)
524 Lisp_Object filename
;
528 /* If the file name has special constructs in it,
529 call the corresponding file handler. */
530 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
532 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
534 return Ffile_name_directory (filename
);
539 file_name_as_directory (out
, in
)
542 int size
= strlen (in
) - 1;
555 /* Is it already a directory string? */
556 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
558 /* Is it a VMS directory file name? If so, hack VMS syntax. */
559 else if (! index (in
, '/')
560 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
561 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
562 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
563 || ! strncmp (&in
[size
- 5], ".dir", 4))
564 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
565 && in
[size
] == '1')))
567 register char *p
, *dot
;
571 dir:x.dir --> dir:[x]
572 dir:[x]y.dir --> dir:[x.y] */
574 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
577 strncpy (out
, in
, p
- in
);
596 dot
= index (p
, '.');
599 /* blindly remove any extension */
600 size
= strlen (out
) + (dot
- p
);
601 strncat (out
, p
, dot
- p
);
612 /* For Unix syntax, Append a slash if necessary */
613 if (!IS_DIRECTORY_SEP (out
[size
]))
615 /* Cannot use DIRECTORY_SEP, which could have any value */
617 out
[size
+ 2] = '\0';
620 CORRECT_DIR_SEPS (out
);
626 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
627 Sfile_name_as_directory
, 1, 1, 0,
628 doc
: /* Return a string representing the file name FILE interpreted as a directory.
629 This operation exists because a directory is also a file, but its name as
630 a directory is different from its name as a file.
631 The result can be used as the value of `default-directory'
632 or passed as second argument to `expand-file-name'.
633 For a Unix-syntax file name, just appends a slash.
634 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
645 /* If the file name has special constructs in it,
646 call the corresponding file handler. */
647 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
649 return call2 (handler
, Qfile_name_as_directory
, file
);
651 buf
= (char *) alloca (SBYTES (file
) + 10);
652 file_name_as_directory (buf
, SDATA (file
));
653 return make_specified_string (buf
, -1, strlen (buf
),
654 STRING_MULTIBYTE (file
));
658 * Convert from directory name to filename.
660 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
661 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
662 * On UNIX, it's simple: just make sure there isn't a terminating /
664 * Value is nonzero if the string output is different from the input.
668 directory_file_name (src
, dst
)
676 struct FAB fab
= cc$rms_fab
;
677 struct NAM nam
= cc$rms_nam
;
678 char esa
[NAM$C_MAXRSS
];
683 if (! index (src
, '/')
684 && (src
[slen
- 1] == ']'
685 || src
[slen
- 1] == ':'
686 || src
[slen
- 1] == '>'))
688 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
690 fab
.fab$b_fns
= slen
;
691 fab
.fab$l_nam
= &nam
;
692 fab
.fab$l_fop
= FAB$M_NAM
;
695 nam
.nam$b_ess
= sizeof esa
;
696 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
698 /* We call SYS$PARSE to handle such things as [--] for us. */
699 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
701 slen
= nam
.nam$b_esl
;
702 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
707 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
709 /* what about when we have logical_name:???? */
710 if (src
[slen
- 1] == ':')
711 { /* Xlate logical name and see what we get */
712 ptr
= strcpy (dst
, src
); /* upper case for getenv */
715 if ('a' <= *ptr
&& *ptr
<= 'z')
719 dst
[slen
- 1] = 0; /* remove colon */
720 if (!(src
= egetenv (dst
)))
722 /* should we jump to the beginning of this procedure?
723 Good points: allows us to use logical names that xlate
725 Bad points: can be a problem if we just translated to a device
727 For now, I'll punt and always expect VMS names, and hope for
730 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
731 { /* no recursion here! */
737 { /* not a directory spec */
742 bracket
= src
[slen
- 1];
744 /* If bracket is ']' or '>', bracket - 2 is the corresponding
746 ptr
= index (src
, bracket
- 2);
748 { /* no opening bracket */
752 if (!(rptr
= rindex (src
, '.')))
755 strncpy (dst
, src
, slen
);
759 dst
[slen
++] = bracket
;
764 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
765 then translate the device and recurse. */
766 if (dst
[slen
- 1] == ':'
767 && dst
[slen
- 2] != ':' /* skip decnet nodes */
768 && strcmp (src
+ slen
, "[000000]") == 0)
770 dst
[slen
- 1] = '\0';
771 if ((ptr
= egetenv (dst
))
772 && (rlen
= strlen (ptr
) - 1) > 0
773 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
774 && ptr
[rlen
- 1] == '.')
776 char * buf
= (char *) alloca (strlen (ptr
) + 1);
780 return directory_file_name (buf
, dst
);
785 strcat (dst
, "[000000]");
789 rlen
= strlen (rptr
) - 1;
790 strncat (dst
, rptr
, rlen
);
791 dst
[slen
+ rlen
] = '\0';
792 strcat (dst
, ".DIR.1");
796 /* Process as Unix format: just remove any final slash.
797 But leave "/" unchanged; do not change it to "". */
800 /* Handle // as root for apollo's. */
801 if ((slen
> 2 && dst
[slen
- 1] == '/')
802 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
806 && IS_DIRECTORY_SEP (dst
[slen
- 1])
808 && !IS_ANY_SEP (dst
[slen
- 2])
814 CORRECT_DIR_SEPS (dst
);
819 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
821 doc
: /* Returns the file name of the directory named DIRECTORY.
822 This is the name of the file that holds the data for the directory DIRECTORY.
823 This operation exists because a directory is also a file, but its name as
824 a directory is different from its name as a file.
825 In Unix-syntax, this function just removes the final slash.
826 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
827 it returns a file name such as \"[X]Y.DIR.1\". */)
829 Lisp_Object directory
;
834 CHECK_STRING (directory
);
836 if (NILP (directory
))
839 /* If the file name has special constructs in it,
840 call the corresponding file handler. */
841 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
843 return call2 (handler
, Qdirectory_file_name
, directory
);
846 /* 20 extra chars is insufficient for VMS, since we might perform a
847 logical name translation. an equivalence string can be up to 255
848 chars long, so grab that much extra space... - sss */
849 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
851 buf
= (char *) alloca (SBYTES (directory
) + 20);
853 directory_file_name (SDATA (directory
), buf
);
854 return make_specified_string (buf
, -1, strlen (buf
),
855 STRING_MULTIBYTE (directory
));
858 static char make_temp_name_tbl
[64] =
860 'A','B','C','D','E','F','G','H',
861 'I','J','K','L','M','N','O','P',
862 'Q','R','S','T','U','V','W','X',
863 'Y','Z','a','b','c','d','e','f',
864 'g','h','i','j','k','l','m','n',
865 'o','p','q','r','s','t','u','v',
866 'w','x','y','z','0','1','2','3',
867 '4','5','6','7','8','9','-','_'
870 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
872 /* Value is a temporary file name starting with PREFIX, a string.
874 The Emacs process number forms part of the result, so there is
875 no danger of generating a name being used by another process.
876 In addition, this function makes an attempt to choose a name
877 which has no existing file. To make this work, PREFIX should be
878 an absolute file name.
880 BASE64_P non-zero means add the pid as 3 characters in base64
881 encoding. In this case, 6 characters will be added to PREFIX to
882 form the file name. Otherwise, if Emacs is running on a system
883 with long file names, add the pid as a decimal number.
885 This function signals an error if no unique file name could be
889 make_temp_name (prefix
, base64_p
)
896 unsigned char *p
, *data
;
900 CHECK_STRING (prefix
);
902 /* VAL is created by adding 6 characters to PREFIX. The first
903 three are the PID of this process, in base 64, and the second
904 three are incremented if the file already exists. This ensures
905 262144 unique file names per PID per PREFIX. */
907 pid
= (int) getpid ();
911 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
912 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
913 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
918 #ifdef HAVE_LONG_FILE_NAMES
919 sprintf (pidbuf
, "%d", pid
);
920 pidlen
= strlen (pidbuf
);
922 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
923 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
924 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
929 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
930 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
931 if (!STRING_MULTIBYTE (prefix
))
932 STRING_SET_UNIBYTE (val
);
934 bcopy(SDATA (prefix
), data
, len
);
937 bcopy (pidbuf
, p
, pidlen
);
940 /* Here we try to minimize useless stat'ing when this function is
941 invoked many times successively with the same PREFIX. We achieve
942 this by initializing count to a random value, and incrementing it
945 We don't want make-temp-name to be called while dumping,
946 because then make_temp_name_count_initialized_p would get set
947 and then make_temp_name_count would not be set when Emacs starts. */
949 if (!make_temp_name_count_initialized_p
)
951 make_temp_name_count
= (unsigned) time (NULL
);
952 make_temp_name_count_initialized_p
= 1;
958 unsigned num
= make_temp_name_count
;
960 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
961 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
962 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
964 /* Poor man's congruential RN generator. Replace with
965 ++make_temp_name_count for debugging. */
966 make_temp_name_count
+= 25229;
967 make_temp_name_count
%= 225307;
969 if (stat (data
, &ignored
) < 0)
971 /* We want to return only if errno is ENOENT. */
975 /* The error here is dubious, but there is little else we
976 can do. The alternatives are to return nil, which is
977 as bad as (and in many cases worse than) throwing the
978 error, or to ignore the error, which will likely result
979 in looping through 225307 stat's, which is not only
980 dog-slow, but also useless since it will fallback to
981 the errow below, anyway. */
982 report_file_error ("Cannot create temporary name for prefix",
983 Fcons (prefix
, Qnil
));
988 error ("Cannot create temporary name for prefix `%s'",
994 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
995 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
996 The Emacs process number forms part of the result,
997 so there is no danger of generating a name being used by another process.
999 In addition, this function makes an attempt to choose a name
1000 which has no existing file. To make this work,
1001 PREFIX should be an absolute file name.
1003 There is a race condition between calling `make-temp-name' and creating the
1004 file which opens all kinds of security holes. For that reason, you should
1005 probably use `make-temp-file' instead, except in three circumstances:
1007 * If you are creating the file in the user's home directory.
1008 * If you are creating a directory rather than an ordinary file.
1009 * If you are taking special precautions as `make-temp-file' does. */)
1013 return make_temp_name (prefix
, 0);
1018 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1019 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1020 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1021 \(does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
1022 the current buffer's value of default-directory is used.
1023 File name components that are `.' are removed, and
1024 so are file name components followed by `..', along with the `..' itself;
1025 note that these simplifications are done without checking the resulting
1026 file names in the file system.
1027 An initial `~/' expands to your home directory.
1028 An initial `~USER/' expands to USER's home directory.
1029 See also the function `substitute-in-file-name'. */)
1030 (name
, default_directory
)
1031 Lisp_Object name
, default_directory
;
1035 register unsigned char *newdir
, *p
, *o
;
1037 unsigned char *target
;
1040 unsigned char * colon
= 0;
1041 unsigned char * close
= 0;
1042 unsigned char * slash
= 0;
1043 unsigned char * brack
= 0;
1044 int lbrack
= 0, rbrack
= 0;
1049 int collapse_newdir
= 1;
1053 Lisp_Object handler
, result
;
1055 CHECK_STRING (name
);
1057 /* If the file name has special constructs in it,
1058 call the corresponding file handler. */
1059 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1060 if (!NILP (handler
))
1061 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1063 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1064 if (NILP (default_directory
))
1065 default_directory
= current_buffer
->directory
;
1066 if (! STRINGP (default_directory
))
1069 /* "/" is not considered a root directory on DOS_NT, so using "/"
1070 here causes an infinite recursion in, e.g., the following:
1072 (let (default-directory)
1073 (expand-file-name "a"))
1075 To avoid this, we set default_directory to the root of the
1077 extern char *emacs_root_dir (void);
1079 default_directory
= build_string (emacs_root_dir ());
1081 default_directory
= build_string ("/");
1085 if (!NILP (default_directory
))
1087 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1088 if (!NILP (handler
))
1089 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1092 o
= SDATA (default_directory
);
1094 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1095 It would be better to do this down below where we actually use
1096 default_directory. Unfortunately, calling Fexpand_file_name recursively
1097 could invoke GC, and the strings might be relocated. This would
1098 be annoying because we have pointers into strings lying around
1099 that would need adjusting, and people would add new pointers to
1100 the code and forget to adjust them, resulting in intermittent bugs.
1101 Putting this call here avoids all that crud.
1103 The EQ test avoids infinite recursion. */
1104 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1105 /* Save time in some common cases - as long as default_directory
1106 is not relative, it can be canonicalized with name below (if it
1107 is needed at all) without requiring it to be expanded now. */
1109 /* Detect MSDOS file names with drive specifiers. */
1110 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1112 /* Detect Windows file names in UNC format. */
1113 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1115 #else /* not DOS_NT */
1116 /* Detect Unix absolute file names (/... alone is not absolute on
1118 && ! (IS_DIRECTORY_SEP (o
[0]))
1119 #endif /* not DOS_NT */
1122 struct gcpro gcpro1
;
1125 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1129 name
= FILE_SYSTEM_CASE (name
);
1133 /* We will force directory separators to be either all \ or /, so make
1134 a local copy to modify, even if there ends up being no change. */
1135 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1137 /* Note if special escape prefix is present, but remove for now. */
1138 if (nm
[0] == '/' && nm
[1] == ':')
1144 /* Find and remove drive specifier if present; this makes nm absolute
1145 even if the rest of the name appears to be relative. Only look for
1146 drive specifier at the beginning. */
1147 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1154 /* If we see "c://somedir", we want to strip the first slash after the
1155 colon when stripping the drive letter. Otherwise, this expands to
1157 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1159 #endif /* WINDOWSNT */
1163 /* Discard any previous drive specifier if nm is now in UNC format. */
1164 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1170 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1171 none are found, we can probably return right away. We will avoid
1172 allocating a new string if name is already fully expanded. */
1174 IS_DIRECTORY_SEP (nm
[0])
1176 && drive
&& !is_escaped
1179 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1186 /* If it turns out that the filename we want to return is just a
1187 suffix of FILENAME, we don't need to go through and edit
1188 things; we just need to construct a new string using data
1189 starting at the middle of FILENAME. If we set lose to a
1190 non-zero value, that means we've discovered that we can't do
1197 /* Since we know the name is absolute, we can assume that each
1198 element starts with a "/". */
1200 /* "." and ".." are hairy. */
1201 if (IS_DIRECTORY_SEP (p
[0])
1203 && (IS_DIRECTORY_SEP (p
[2])
1205 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1208 /* We want to replace multiple `/' in a row with a single
1211 && IS_DIRECTORY_SEP (p
[0])
1212 && IS_DIRECTORY_SEP (p
[1]))
1219 /* if dev:[dir]/, move nm to / */
1220 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1221 nm
= (brack
? brack
+ 1 : colon
+ 1);
1222 lbrack
= rbrack
= 0;
1229 #ifdef NO_HYPHENS_IN_FILENAMES
1230 if (lbrack
== rbrack
)
1232 /* Avoid clobbering negative version numbers. */
1237 #endif /* NO_HYPHENS_IN_FILENAMES */
1238 if (lbrack
> rbrack
&&
1239 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1240 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1242 #ifdef NO_HYPHENS_IN_FILENAMES
1245 #endif /* NO_HYPHENS_IN_FILENAMES */
1246 /* count open brackets, reset close bracket pointer */
1247 if (p
[0] == '[' || p
[0] == '<')
1248 lbrack
++, brack
= 0;
1249 /* count close brackets, set close bracket pointer */
1250 if (p
[0] == ']' || p
[0] == '>')
1251 rbrack
++, brack
= p
;
1252 /* detect ][ or >< */
1253 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1255 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1256 nm
= p
+ 1, lose
= 1;
1257 if (p
[0] == ':' && (colon
|| slash
))
1258 /* if dev1:[dir]dev2:, move nm to dev2: */
1264 /* if /name/dev:, move nm to dev: */
1267 /* if node::dev:, move colon following dev */
1268 else if (colon
&& colon
[-1] == ':')
1270 /* if dev1:dev2:, move nm to dev2: */
1271 else if (colon
&& colon
[-1] != ':')
1276 if (p
[0] == ':' && !colon
)
1282 if (lbrack
== rbrack
)
1285 else if (p
[0] == '.')
1293 if (index (nm
, '/'))
1295 nm
= sys_translate_unix (nm
);
1296 return make_specified_string (nm
, -1, strlen (nm
),
1297 STRING_MULTIBYTE (name
));
1301 /* Make sure directories are all separated with / or \ as
1302 desired, but avoid allocation of a new string when not
1304 CORRECT_DIR_SEPS (nm
);
1306 if (IS_DIRECTORY_SEP (nm
[1]))
1308 if (strcmp (nm
, SDATA (name
)) != 0)
1309 name
= make_specified_string (nm
, -1, strlen (nm
),
1310 STRING_MULTIBYTE (name
));
1314 /* drive must be set, so this is okay */
1315 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1319 name
= make_specified_string (nm
, -1, p
- nm
,
1320 STRING_MULTIBYTE (name
));
1321 temp
[0] = DRIVE_LETTER (drive
);
1322 name
= concat2 (build_string (temp
), name
);
1325 #else /* not DOS_NT */
1326 if (nm
== SDATA (name
))
1328 return make_specified_string (nm
, -1, strlen (nm
),
1329 STRING_MULTIBYTE (name
));
1330 #endif /* not DOS_NT */
1334 /* At this point, nm might or might not be an absolute file name. We
1335 need to expand ~ or ~user if present, otherwise prefix nm with
1336 default_directory if nm is not absolute, and finally collapse /./
1337 and /foo/../ sequences.
1339 We set newdir to be the appropriate prefix if one is needed:
1340 - the relevant user directory if nm starts with ~ or ~user
1341 - the specified drive's working dir (DOS/NT only) if nm does not
1343 - the value of default_directory.
1345 Note that these prefixes are not guaranteed to be absolute (except
1346 for the working dir of a drive). Therefore, to ensure we always
1347 return an absolute name, if the final prefix is not absolute we
1348 append it to the current working directory. */
1352 if (nm
[0] == '~') /* prefix ~ */
1354 if (IS_DIRECTORY_SEP (nm
[1])
1358 || nm
[1] == 0) /* ~ by itself */
1360 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1361 newdir
= (unsigned char *) "";
1364 collapse_newdir
= 0;
1367 nm
++; /* Don't leave the slash in nm. */
1370 else /* ~user/filename */
1372 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1377 o
= (unsigned char *) alloca (p
- nm
+ 1);
1378 bcopy ((char *) nm
, o
, p
- nm
);
1381 pw
= (struct passwd
*) getpwnam (o
+ 1);
1384 newdir
= (unsigned char *) pw
-> pw_dir
;
1386 nm
= p
+ 1; /* skip the terminator */
1390 collapse_newdir
= 0;
1395 /* If we don't find a user of that name, leave the name
1396 unchanged; don't move nm forward to p. */
1401 /* On DOS and Windows, nm is absolute if a drive name was specified;
1402 use the drive's current directory as the prefix if needed. */
1403 if (!newdir
&& drive
)
1405 /* Get default directory if needed to make nm absolute. */
1406 if (!IS_DIRECTORY_SEP (nm
[0]))
1408 newdir
= alloca (MAXPATHLEN
+ 1);
1409 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1414 /* Either nm starts with /, or drive isn't mounted. */
1415 newdir
= alloca (4);
1416 newdir
[0] = DRIVE_LETTER (drive
);
1424 /* Finally, if no prefix has been specified and nm is not absolute,
1425 then it must be expanded relative to default_directory. */
1429 /* /... alone is not absolute on DOS and Windows. */
1430 && !IS_DIRECTORY_SEP (nm
[0])
1433 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1440 newdir
= SDATA (default_directory
);
1442 /* Note if special escape prefix is present, but remove for now. */
1443 if (newdir
[0] == '/' && newdir
[1] == ':')
1454 /* First ensure newdir is an absolute name. */
1456 /* Detect MSDOS file names with drive specifiers. */
1457 ! (IS_DRIVE (newdir
[0])
1458 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1460 /* Detect Windows file names in UNC format. */
1461 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1465 /* Effectively, let newdir be (expand-file-name newdir cwd).
1466 Because of the admonition against calling expand-file-name
1467 when we have pointers into lisp strings, we accomplish this
1468 indirectly by prepending newdir to nm if necessary, and using
1469 cwd (or the wd of newdir's drive) as the new newdir. */
1471 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1476 if (!IS_DIRECTORY_SEP (nm
[0]))
1478 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1479 file_name_as_directory (tmp
, newdir
);
1483 newdir
= alloca (MAXPATHLEN
+ 1);
1486 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1493 /* Strip off drive name from prefix, if present. */
1494 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1500 /* Keep only a prefix from newdir if nm starts with slash
1501 (//server/share for UNC, nothing otherwise). */
1502 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1505 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1507 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1509 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1511 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1523 /* Get rid of any slash at the end of newdir, unless newdir is
1524 just / or // (an incomplete UNC name). */
1525 length
= strlen (newdir
);
1526 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1528 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1532 unsigned char *temp
= (unsigned char *) alloca (length
);
1533 bcopy (newdir
, temp
, length
- 1);
1534 temp
[length
- 1] = 0;
1542 /* Now concatenate the directory and name to new space in the stack frame */
1543 tlen
+= strlen (nm
) + 1;
1545 /* Reserve space for drive specifier and escape prefix, since either
1546 or both may need to be inserted. (The Microsoft x86 compiler
1547 produces incorrect code if the following two lines are combined.) */
1548 target
= (unsigned char *) alloca (tlen
+ 4);
1550 #else /* not DOS_NT */
1551 target
= (unsigned char *) alloca (tlen
);
1552 #endif /* not DOS_NT */
1558 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1561 /* If newdir is effectively "C:/", then the drive letter will have
1562 been stripped and newdir will be "/". Concatenating with an
1563 absolute directory in nm produces "//", which will then be
1564 incorrectly treated as a network share. Ignore newdir in
1565 this case (keeping the drive letter). */
1566 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1567 && newdir
[1] == '\0'))
1569 strcpy (target
, newdir
);
1573 file_name_as_directory (target
, newdir
);
1576 strcat (target
, nm
);
1578 if (index (target
, '/'))
1579 strcpy (target
, sys_translate_unix (target
));
1582 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1584 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1593 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1599 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1600 /* brackets are offset from each other by 2 */
1603 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1604 /* convert [foo][bar] to [bar] */
1605 while (o
[-1] != '[' && o
[-1] != '<')
1607 else if (*p
== '-' && *o
!= '.')
1610 else if (p
[0] == '-' && o
[-1] == '.' &&
1611 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1612 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1616 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1617 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1619 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1621 /* else [foo.-] ==> [-] */
1625 #ifdef NO_HYPHENS_IN_FILENAMES
1627 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1628 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1630 #endif /* NO_HYPHENS_IN_FILENAMES */
1634 if (!IS_DIRECTORY_SEP (*p
))
1638 else if (IS_DIRECTORY_SEP (p
[0])
1640 && (IS_DIRECTORY_SEP (p
[2])
1643 /* If "/." is the entire filename, keep the "/". Otherwise,
1644 just delete the whole "/.". */
1645 if (o
== target
&& p
[2] == '\0')
1649 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1650 /* `/../' is the "superroot" on certain file systems. */
1652 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1654 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1656 /* Keep initial / only if this is the whole name. */
1657 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1662 && IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1]))
1664 /* Collapse multiple `/' in a row. */
1666 while (IS_DIRECTORY_SEP (*p
))
1673 #endif /* not VMS */
1677 /* At last, set drive name. */
1679 /* Except for network file name. */
1680 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1681 #endif /* WINDOWSNT */
1683 if (!drive
) abort ();
1685 target
[0] = DRIVE_LETTER (drive
);
1688 /* Reinsert the escape prefix if required. */
1695 CORRECT_DIR_SEPS (target
);
1698 result
= make_specified_string (target
, -1, o
- target
,
1699 STRING_MULTIBYTE (name
));
1701 /* Again look to see if the file name has special constructs in it
1702 and perhaps call the corresponding file handler. This is needed
1703 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1704 the ".." component gives us "/user@host:/bar/../baz" which needs
1705 to be expanded again. */
1706 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1707 if (!NILP (handler
))
1708 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1714 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1715 This is the old version of expand-file-name, before it was thoroughly
1716 rewritten for Emacs 10.31. We leave this version here commented-out,
1717 because the code is very complex and likely to have subtle bugs. If
1718 bugs _are_ found, it might be of interest to look at the old code and
1719 see what did it do in the relevant situation.
1721 Don't remove this code: it's true that it will be accessible via CVS,
1722 but a few years from deletion, people will forget it is there. */
1724 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1725 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1726 "Convert FILENAME to absolute, and canonicalize it.\n\
1727 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1728 \(does not start with slash); if DEFAULT is nil or missing,\n\
1729 the current buffer's value of default-directory is used.\n\
1730 Filenames containing `.' or `..' as components are simplified;\n\
1731 initial `~/' expands to your home directory.\n\
1732 See also the function `substitute-in-file-name'.")
1734 Lisp_Object name
, defalt
;
1738 register unsigned char *newdir
, *p
, *o
;
1740 unsigned char *target
;
1744 unsigned char * colon
= 0;
1745 unsigned char * close
= 0;
1746 unsigned char * slash
= 0;
1747 unsigned char * brack
= 0;
1748 int lbrack
= 0, rbrack
= 0;
1752 CHECK_STRING (name
);
1755 /* Filenames on VMS are always upper case. */
1756 name
= Fupcase (name
);
1761 /* If nm is absolute, flush ...// and detect /./ and /../.
1762 If no /./ or /../ we can return right away. */
1774 if (p
[0] == '/' && p
[1] == '/'
1776 /* // at start of filename is meaningful on Apollo system. */
1781 if (p
[0] == '/' && p
[1] == '~')
1782 nm
= p
+ 1, lose
= 1;
1783 if (p
[0] == '/' && p
[1] == '.'
1784 && (p
[2] == '/' || p
[2] == 0
1785 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1791 /* if dev:[dir]/, move nm to / */
1792 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1793 nm
= (brack
? brack
+ 1 : colon
+ 1);
1794 lbrack
= rbrack
= 0;
1802 /* VMS pre V4.4,convert '-'s in filenames. */
1803 if (lbrack
== rbrack
)
1805 if (dots
< 2) /* this is to allow negative version numbers */
1810 if (lbrack
> rbrack
&&
1811 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1812 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1818 /* count open brackets, reset close bracket pointer */
1819 if (p
[0] == '[' || p
[0] == '<')
1820 lbrack
++, brack
= 0;
1821 /* count close brackets, set close bracket pointer */
1822 if (p
[0] == ']' || p
[0] == '>')
1823 rbrack
++, brack
= p
;
1824 /* detect ][ or >< */
1825 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1827 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1828 nm
= p
+ 1, lose
= 1;
1829 if (p
[0] == ':' && (colon
|| slash
))
1830 /* if dev1:[dir]dev2:, move nm to dev2: */
1836 /* If /name/dev:, move nm to dev: */
1839 /* If node::dev:, move colon following dev */
1840 else if (colon
&& colon
[-1] == ':')
1842 /* If dev1:dev2:, move nm to dev2: */
1843 else if (colon
&& colon
[-1] != ':')
1848 if (p
[0] == ':' && !colon
)
1854 if (lbrack
== rbrack
)
1857 else if (p
[0] == '.')
1865 if (index (nm
, '/'))
1866 return build_string (sys_translate_unix (nm
));
1868 if (nm
== SDATA (name
))
1870 return build_string (nm
);
1874 /* Now determine directory to start with and put it in NEWDIR */
1878 if (nm
[0] == '~') /* prefix ~ */
1883 || nm
[1] == 0)/* ~/filename */
1885 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1886 newdir
= (unsigned char *) "";
1889 nm
++; /* Don't leave the slash in nm. */
1892 else /* ~user/filename */
1894 /* Get past ~ to user */
1895 unsigned char *user
= nm
+ 1;
1896 /* Find end of name. */
1897 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1898 int len
= ptr
? ptr
- user
: strlen (user
);
1900 unsigned char *ptr1
= index (user
, ':');
1901 if (ptr1
!= 0 && ptr1
- user
< len
)
1904 /* Copy the user name into temp storage. */
1905 o
= (unsigned char *) alloca (len
+ 1);
1906 bcopy ((char *) user
, o
, len
);
1909 /* Look up the user name. */
1910 pw
= (struct passwd
*) getpwnam (o
+ 1);
1912 error ("\"%s\" isn't a registered user", o
+ 1);
1914 newdir
= (unsigned char *) pw
->pw_dir
;
1916 /* Discard the user name from NM. */
1923 #endif /* not VMS */
1927 defalt
= current_buffer
->directory
;
1928 CHECK_STRING (defalt
);
1929 newdir
= SDATA (defalt
);
1932 /* Now concatenate the directory and name to new space in the stack frame */
1934 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1935 target
= (unsigned char *) alloca (tlen
);
1941 if (nm
[0] == 0 || nm
[0] == '/')
1942 strcpy (target
, newdir
);
1945 file_name_as_directory (target
, newdir
);
1948 strcat (target
, nm
);
1950 if (index (target
, '/'))
1951 strcpy (target
, sys_translate_unix (target
));
1954 /* Now canonicalize by removing /. and /foo/.. if they appear */
1962 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1968 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1969 /* brackets are offset from each other by 2 */
1972 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1973 /* convert [foo][bar] to [bar] */
1974 while (o
[-1] != '[' && o
[-1] != '<')
1976 else if (*p
== '-' && *o
!= '.')
1979 else if (p
[0] == '-' && o
[-1] == '.' &&
1980 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1981 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1985 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1986 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1988 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1990 /* else [foo.-] ==> [-] */
1996 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1997 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2007 else if (!strncmp (p
, "//", 2)
2009 /* // at start of filename is meaningful in Apollo system. */
2017 else if (p
[0] == '/' && p
[1] == '.' &&
2018 (p
[2] == '/' || p
[2] == 0))
2020 else if (!strncmp (p
, "/..", 3)
2021 /* `/../' is the "superroot" on certain file systems. */
2023 && (p
[3] == '/' || p
[3] == 0))
2025 while (o
!= target
&& *--o
!= '/')
2028 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2032 if (o
== target
&& *o
== '/')
2040 #endif /* not VMS */
2043 return make_string (target
, o
- target
);
2047 /* If /~ or // appears, discard everything through first slash. */
2049 file_name_absolute_p (filename
)
2050 const unsigned char *filename
;
2053 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
2055 /* ??? This criterion is probably wrong for '<'. */
2056 || index (filename
, ':') || index (filename
, '<')
2057 || (*filename
== '[' && (filename
[1] != '-'
2058 || (filename
[2] != '.' && filename
[2] != ']'))
2059 && filename
[1] != '.')
2062 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
2063 && IS_DIRECTORY_SEP (filename
[2]))
2068 static unsigned char *
2069 search_embedded_absfilename (nm
, endp
)
2070 unsigned char *nm
, *endp
;
2072 unsigned char *p
, *s
;
2074 for (p
= nm
+ 1; p
< endp
; p
++)
2078 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2080 || IS_DIRECTORY_SEP (p
[-1]))
2081 && file_name_absolute_p (p
)
2082 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2083 /* // at start of file name is meaningful in Apollo,
2084 WindowsNT and Cygwin systems. */
2085 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
2086 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2089 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2094 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2096 unsigned char *o
= alloca (s
- p
+ 1);
2098 bcopy (p
, o
, s
- p
);
2101 /* If we have ~user and `user' exists, discard
2102 everything up to ~. But if `user' does not exist, leave
2103 ~user alone, it might be a literal file name. */
2104 if ((pw
= getpwnam (o
+ 1)))
2116 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2117 Ssubstitute_in_file_name
, 1, 1, 0,
2118 doc
: /* Substitute environment variables referred to in FILENAME.
2119 `$FOO' where FOO is an environment variable name means to substitute
2120 the value of that variable. The variable name should be terminated
2121 with a character not a letter, digit or underscore; otherwise, enclose
2122 the entire variable name in braces.
2123 If `/~' appears, all of FILENAME through that `/' is discarded.
2125 On VMS, `$' substitution is not done; this function does little and only
2126 duplicates what `expand-file-name' does. */)
2128 Lisp_Object filename
;
2132 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2133 unsigned char *target
= NULL
;
2135 int substituted
= 0;
2137 Lisp_Object handler
;
2139 CHECK_STRING (filename
);
2141 /* If the file name has special constructs in it,
2142 call the corresponding file handler. */
2143 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2144 if (!NILP (handler
))
2145 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2147 nm
= SDATA (filename
);
2149 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2150 CORRECT_DIR_SEPS (nm
);
2151 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2153 endp
= nm
+ SBYTES (filename
);
2155 /* If /~ or // appears, discard everything through first slash. */
2156 p
= search_embedded_absfilename (nm
, endp
);
2158 /* Start over with the new string, so we check the file-name-handler
2159 again. Important with filenames like "/home/foo//:/hello///there"
2160 which whould substitute to "/:/hello///there" rather than "/there". */
2161 return Fsubstitute_in_file_name
2162 (make_specified_string (p
, -1, endp
- p
,
2163 STRING_MULTIBYTE (filename
)));
2169 /* See if any variables are substituted into the string
2170 and find the total length of their values in `total' */
2172 for (p
= nm
; p
!= endp
;)
2182 /* "$$" means a single "$" */
2191 while (p
!= endp
&& *p
!= '}') p
++;
2192 if (*p
!= '}') goto missingclose
;
2198 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2202 /* Copy out the variable name */
2203 target
= (unsigned char *) alloca (s
- o
+ 1);
2204 strncpy (target
, o
, s
- o
);
2207 strupr (target
); /* $home == $HOME etc. */
2210 /* Get variable value */
2211 o
= (unsigned char *) egetenv (target
);
2214 total
+= strlen (o
);
2224 /* If substitution required, recopy the string and do it */
2225 /* Make space in stack frame for the new copy */
2226 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2229 /* Copy the rest of the name through, replacing $ constructs with values */
2246 while (p
!= endp
&& *p
!= '}') p
++;
2247 if (*p
!= '}') goto missingclose
;
2253 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2257 /* Copy out the variable name */
2258 target
= (unsigned char *) alloca (s
- o
+ 1);
2259 strncpy (target
, o
, s
- o
);
2262 strupr (target
); /* $home == $HOME etc. */
2265 /* Get variable value */
2266 o
= (unsigned char *) egetenv (target
);
2270 strcpy (x
, target
); x
+= strlen (target
);
2272 else if (STRING_MULTIBYTE (filename
))
2274 /* If the original string is multibyte,
2275 convert what we substitute into multibyte. */
2279 c
= unibyte_char_to_multibyte (c
);
2280 x
+= CHAR_STRING (c
, x
);
2292 /* If /~ or // appears, discard everything through first slash. */
2293 while ((p
= search_embedded_absfilename (xnm
, x
)))
2294 /* This time we do not start over because we've already expanded envvars
2295 and replaced $$ with $. Maybe we should start over as well, but we'd
2296 need to quote some $ to $$ first. */
2299 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2302 error ("Bad format environment-variable substitution");
2304 error ("Missing \"}\" in environment-variable substitution");
2306 error ("Substituting nonexistent environment variable \"%s\"", target
);
2309 #endif /* not VMS */
2313 /* A slightly faster and more convenient way to get
2314 (directory-file-name (expand-file-name FOO)). */
2317 expand_and_dir_to_file (filename
, defdir
)
2318 Lisp_Object filename
, defdir
;
2320 register Lisp_Object absname
;
2322 absname
= Fexpand_file_name (filename
, defdir
);
2325 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2326 if (c
== ':' || c
== ']' || c
== '>')
2327 absname
= Fdirectory_file_name (absname
);
2330 /* Remove final slash, if any (unless this is the root dir).
2331 stat behaves differently depending! */
2332 if (SCHARS (absname
) > 1
2333 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2334 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2335 /* We cannot take shortcuts; they might be wrong for magic file names. */
2336 absname
= Fdirectory_file_name (absname
);
2341 /* Signal an error if the file ABSNAME already exists.
2342 If INTERACTIVE is nonzero, ask the user whether to proceed,
2343 and bypass the error if the user says to go ahead.
2344 QUERYSTRING is a name for the action that is being considered
2347 *STATPTR is used to store the stat information if the file exists.
2348 If the file does not exist, STATPTR->st_mode is set to 0.
2349 If STATPTR is null, we don't store into it.
2351 If QUICK is nonzero, we ask for y or n, not yes or no. */
2354 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2355 Lisp_Object absname
;
2356 unsigned char *querystring
;
2358 struct stat
*statptr
;
2361 register Lisp_Object tem
, encoded_filename
;
2362 struct stat statbuf
;
2363 struct gcpro gcpro1
;
2365 encoded_filename
= ENCODE_FILE (absname
);
2367 /* stat is a good way to tell whether the file exists,
2368 regardless of what access permissions it has. */
2369 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
2372 Fsignal (Qfile_already_exists
,
2373 Fcons (build_string ("File already exists"),
2374 Fcons (absname
, Qnil
)));
2376 tem
= format2 ("File %s already exists; %s anyway? ",
2377 absname
, build_string (querystring
));
2379 tem
= Fy_or_n_p (tem
);
2381 tem
= do_yes_or_no_p (tem
);
2384 Fsignal (Qfile_already_exists
,
2385 Fcons (build_string ("File already exists"),
2386 Fcons (absname
, Qnil
)));
2393 statptr
->st_mode
= 0;
2398 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2399 "fCopy file: \nGCopy %s to file: \np\nP",
2400 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2401 If NEWNAME names a directory, copy FILE there.
2402 Signals a `file-already-exists' error if file NEWNAME already exists,
2403 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
2404 A number as third arg means request confirmation if NEWNAME already exists.
2405 This is what happens in interactive use with M-x.
2406 Always sets the file modes of the output file to match the input file.
2407 Fourth arg KEEP-TIME non-nil means give the output file the same
2408 last-modified time as the old one. (This works on only some systems.)
2409 A prefix arg makes KEEP-TIME non-nil. */)
2410 (file
, newname
, ok_if_already_exists
, keep_time
)
2411 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2414 char buf
[16 * 1024];
2415 struct stat st
, out_st
;
2416 Lisp_Object handler
;
2417 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2418 int count
= SPECPDL_INDEX ();
2419 int input_file_statable_p
;
2420 Lisp_Object encoded_file
, encoded_newname
;
2422 encoded_file
= encoded_newname
= Qnil
;
2423 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2424 CHECK_STRING (file
);
2425 CHECK_STRING (newname
);
2427 if (!NILP (Ffile_directory_p (newname
)))
2428 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2430 newname
= Fexpand_file_name (newname
, Qnil
);
2432 file
= Fexpand_file_name (file
, Qnil
);
2434 /* If the input file name has special constructs in it,
2435 call the corresponding file handler. */
2436 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2437 /* Likewise for output file name. */
2439 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2440 if (!NILP (handler
))
2441 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2442 ok_if_already_exists
, keep_time
));
2444 encoded_file
= ENCODE_FILE (file
);
2445 encoded_newname
= ENCODE_FILE (newname
);
2447 if (NILP (ok_if_already_exists
)
2448 || INTEGERP (ok_if_already_exists
))
2449 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2450 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2451 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2455 if (!CopyFile (SDATA (encoded_file
),
2456 SDATA (encoded_newname
),
2458 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2459 /* CopyFile retains the timestamp by default. */
2460 else if (NILP (keep_time
))
2466 EMACS_GET_TIME (now
);
2467 filename
= SDATA (encoded_newname
);
2469 /* Ensure file is writable while its modified time is set. */
2470 attributes
= GetFileAttributes (filename
);
2471 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2472 if (set_file_times (filename
, now
, now
))
2474 /* Restore original attributes. */
2475 SetFileAttributes (filename
, attributes
);
2476 Fsignal (Qfile_date_error
,
2477 Fcons (build_string ("Cannot set file date"),
2478 Fcons (newname
, Qnil
)));
2480 /* Restore original attributes. */
2481 SetFileAttributes (filename
, attributes
);
2483 #else /* not WINDOWSNT */
2485 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2489 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2491 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2493 /* We can only copy regular files and symbolic links. Other files are not
2495 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2497 #if !defined (DOS_NT) || __DJGPP__ > 1
2498 if (out_st
.st_mode
!= 0
2499 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2502 report_file_error ("Input and output files are the same",
2503 Fcons (file
, Fcons (newname
, Qnil
)));
2507 #if defined (S_ISREG) && defined (S_ISLNK)
2508 if (input_file_statable_p
)
2510 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2512 #if defined (EISDIR)
2513 /* Get a better looking error message. */
2516 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2519 #endif /* S_ISREG && S_ISLNK */
2522 /* Create the copy file with the same record format as the input file */
2523 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2526 /* System's default file type was set to binary by _fmode in emacs.c. */
2527 ofd
= creat (SDATA (encoded_newname
), S_IREAD
| S_IWRITE
);
2528 #else /* not MSDOS */
2529 ofd
= creat (SDATA (encoded_newname
), 0666);
2530 #endif /* not MSDOS */
2533 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2535 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2539 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2540 if (emacs_write (ofd
, buf
, n
) != n
)
2541 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2544 /* Closing the output clobbers the file times on some systems. */
2545 if (emacs_close (ofd
) < 0)
2546 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2548 if (input_file_statable_p
)
2550 if (!NILP (keep_time
))
2552 EMACS_TIME atime
, mtime
;
2553 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2554 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2555 if (set_file_times (SDATA (encoded_newname
),
2557 Fsignal (Qfile_date_error
,
2558 Fcons (build_string ("Cannot set file date"),
2559 Fcons (newname
, Qnil
)));
2562 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2564 #if defined (__DJGPP__) && __DJGPP__ > 1
2565 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2566 and if it can't, it tells so. Otherwise, under MSDOS we usually
2567 get only the READ bit, which will make the copied file read-only,
2568 so it's better not to chmod at all. */
2569 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2570 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2571 #endif /* DJGPP version 2 or newer */
2576 #endif /* WINDOWSNT */
2578 /* Discard the unwind protects. */
2579 specpdl_ptr
= specpdl
+ count
;
2585 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2586 Smake_directory_internal
, 1, 1, 0,
2587 doc
: /* Create a new directory named DIRECTORY. */)
2589 Lisp_Object directory
;
2591 const unsigned char *dir
;
2592 Lisp_Object handler
;
2593 Lisp_Object encoded_dir
;
2595 CHECK_STRING (directory
);
2596 directory
= Fexpand_file_name (directory
, Qnil
);
2598 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2599 if (!NILP (handler
))
2600 return call2 (handler
, Qmake_directory_internal
, directory
);
2602 encoded_dir
= ENCODE_FILE (directory
);
2604 dir
= SDATA (encoded_dir
);
2607 if (mkdir (dir
) != 0)
2609 if (mkdir (dir
, 0777) != 0)
2611 report_file_error ("Creating directory", Flist (1, &directory
));
2616 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2617 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2619 Lisp_Object directory
;
2621 const unsigned char *dir
;
2622 Lisp_Object handler
;
2623 Lisp_Object encoded_dir
;
2625 CHECK_STRING (directory
);
2626 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2628 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2629 if (!NILP (handler
))
2630 return call2 (handler
, Qdelete_directory
, directory
);
2632 encoded_dir
= ENCODE_FILE (directory
);
2634 dir
= SDATA (encoded_dir
);
2636 if (rmdir (dir
) != 0)
2637 report_file_error ("Removing directory", Flist (1, &directory
));
2642 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2643 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2644 If file has multiple names, it continues to exist with the other names. */)
2646 Lisp_Object filename
;
2648 Lisp_Object handler
;
2649 Lisp_Object encoded_file
;
2650 struct gcpro gcpro1
;
2653 if (!NILP (Ffile_directory_p (filename
))
2654 && NILP (Ffile_symlink_p (filename
)))
2655 Fsignal (Qfile_error
,
2656 Fcons (build_string ("Removing old name: is a directory"),
2657 Fcons (filename
, Qnil
)));
2659 filename
= Fexpand_file_name (filename
, Qnil
);
2661 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2662 if (!NILP (handler
))
2663 return call2 (handler
, Qdelete_file
, filename
);
2665 encoded_file
= ENCODE_FILE (filename
);
2667 if (0 > unlink (SDATA (encoded_file
)))
2668 report_file_error ("Removing old name", Flist (1, &filename
));
2673 internal_delete_file_1 (ignore
)
2679 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2682 internal_delete_file (filename
)
2683 Lisp_Object filename
;
2685 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2686 Qt
, internal_delete_file_1
));
2689 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2690 "fRename file: \nGRename %s to file: \np",
2691 doc
: /* Rename FILE as NEWNAME. Both args strings.
2692 If file has names other than FILE, it continues to have those names.
2693 Signals a `file-already-exists' error if a file NEWNAME already exists
2694 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2695 A number as third arg means request confirmation if NEWNAME already exists.
2696 This is what happens in interactive use with M-x. */)
2697 (file
, newname
, ok_if_already_exists
)
2698 Lisp_Object file
, newname
, ok_if_already_exists
;
2701 Lisp_Object args
[2];
2703 Lisp_Object handler
;
2704 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2705 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2707 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2708 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2709 CHECK_STRING (file
);
2710 CHECK_STRING (newname
);
2711 file
= Fexpand_file_name (file
, Qnil
);
2713 if (!NILP (Ffile_directory_p (newname
)))
2714 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2716 newname
= Fexpand_file_name (newname
, Qnil
);
2718 /* If the file name has special constructs in it,
2719 call the corresponding file handler. */
2720 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2722 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2723 if (!NILP (handler
))
2724 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2725 file
, newname
, ok_if_already_exists
));
2727 encoded_file
= ENCODE_FILE (file
);
2728 encoded_newname
= ENCODE_FILE (newname
);
2731 /* If the file names are identical but for the case, don't ask for
2732 confirmation: they simply want to change the letter-case of the
2734 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2736 if (NILP (ok_if_already_exists
)
2737 || INTEGERP (ok_if_already_exists
))
2738 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2739 INTEGERP (ok_if_already_exists
), 0, 0);
2741 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2743 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2744 || 0 > unlink (SDATA (encoded_file
)))
2750 symlink_target
= Ffile_symlink_p (file
);
2751 if (! NILP (symlink_target
))
2752 Fmake_symbolic_link (symlink_target
, newname
,
2753 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2756 Fcopy_file (file
, newname
,
2757 /* We have already prompted if it was an integer,
2758 so don't have copy-file prompt again. */
2759 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2760 Fdelete_file (file
);
2767 report_file_error ("Renaming", Flist (2, args
));
2770 report_file_error ("Renaming", Flist (2, &file
));
2777 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2778 "fAdd name to file: \nGName to add to %s: \np",
2779 doc
: /* Give FILE additional name NEWNAME. Both args strings.
2780 Signals a `file-already-exists' error if a file NEWNAME already exists
2781 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2782 A number as third arg means request confirmation if NEWNAME already exists.
2783 This is what happens in interactive use with M-x. */)
2784 (file
, newname
, ok_if_already_exists
)
2785 Lisp_Object file
, newname
, ok_if_already_exists
;
2788 Lisp_Object args
[2];
2790 Lisp_Object handler
;
2791 Lisp_Object encoded_file
, encoded_newname
;
2792 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2794 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2795 encoded_file
= encoded_newname
= Qnil
;
2796 CHECK_STRING (file
);
2797 CHECK_STRING (newname
);
2798 file
= Fexpand_file_name (file
, Qnil
);
2800 if (!NILP (Ffile_directory_p (newname
)))
2801 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2803 newname
= Fexpand_file_name (newname
, Qnil
);
2805 /* If the file name has special constructs in it,
2806 call the corresponding file handler. */
2807 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2808 if (!NILP (handler
))
2809 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2810 newname
, ok_if_already_exists
));
2812 /* If the new name has special constructs in it,
2813 call the corresponding file handler. */
2814 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2815 if (!NILP (handler
))
2816 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2817 newname
, ok_if_already_exists
));
2819 encoded_file
= ENCODE_FILE (file
);
2820 encoded_newname
= ENCODE_FILE (newname
);
2822 if (NILP (ok_if_already_exists
)
2823 || INTEGERP (ok_if_already_exists
))
2824 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2825 INTEGERP (ok_if_already_exists
), 0, 0);
2827 unlink (SDATA (newname
));
2828 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2833 report_file_error ("Adding new name", Flist (2, args
));
2835 report_file_error ("Adding new name", Flist (2, &file
));
2844 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2845 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2846 doc
: /* Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2847 Signals a `file-already-exists' error if a file LINKNAME already exists
2848 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2849 A number as third arg means request confirmation if LINKNAME already exists.
2850 This happens for interactive use with M-x. */)
2851 (filename
, linkname
, ok_if_already_exists
)
2852 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2855 Lisp_Object args
[2];
2857 Lisp_Object handler
;
2858 Lisp_Object encoded_filename
, encoded_linkname
;
2859 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2861 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2862 encoded_filename
= encoded_linkname
= Qnil
;
2863 CHECK_STRING (filename
);
2864 CHECK_STRING (linkname
);
2865 /* If the link target has a ~, we must expand it to get
2866 a truly valid file name. Otherwise, do not expand;
2867 we want to permit links to relative file names. */
2868 if (SREF (filename
, 0) == '~')
2869 filename
= Fexpand_file_name (filename
, Qnil
);
2871 if (!NILP (Ffile_directory_p (linkname
)))
2872 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2874 linkname
= Fexpand_file_name (linkname
, Qnil
);
2876 /* If the file name has special constructs in it,
2877 call the corresponding file handler. */
2878 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2879 if (!NILP (handler
))
2880 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2881 linkname
, ok_if_already_exists
));
2883 /* If the new link name has special constructs in it,
2884 call the corresponding file handler. */
2885 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2886 if (!NILP (handler
))
2887 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2888 linkname
, ok_if_already_exists
));
2890 encoded_filename
= ENCODE_FILE (filename
);
2891 encoded_linkname
= ENCODE_FILE (linkname
);
2893 if (NILP (ok_if_already_exists
)
2894 || INTEGERP (ok_if_already_exists
))
2895 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2896 INTEGERP (ok_if_already_exists
), 0, 0);
2897 if (0 > symlink (SDATA (encoded_filename
),
2898 SDATA (encoded_linkname
)))
2900 /* If we didn't complain already, silently delete existing file. */
2901 if (errno
== EEXIST
)
2903 unlink (SDATA (encoded_linkname
));
2904 if (0 <= symlink (SDATA (encoded_filename
),
2905 SDATA (encoded_linkname
)))
2915 report_file_error ("Making symbolic link", Flist (2, args
));
2917 report_file_error ("Making symbolic link", Flist (2, &filename
));
2923 #endif /* S_IFLNK */
2927 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2928 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2929 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2930 If STRING is nil or a null string, the logical name NAME is deleted. */)
2935 CHECK_STRING (name
);
2937 delete_logical_name (SDATA (name
));
2940 CHECK_STRING (string
);
2942 if (SCHARS (string
) == 0)
2943 delete_logical_name (SDATA (name
));
2945 define_logical_name (SDATA (name
), SDATA (string
));
2954 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2955 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2957 Lisp_Object path
, login
;
2961 CHECK_STRING (path
);
2962 CHECK_STRING (login
);
2964 netresult
= netunam (SDATA (path
), SDATA (login
));
2966 if (netresult
== -1)
2971 #endif /* HPUX_NET */
2973 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2975 doc
: /* Return t if file FILENAME specifies an absolute file name.
2976 On Unix, this is a name starting with a `/' or a `~'. */)
2978 Lisp_Object filename
;
2980 CHECK_STRING (filename
);
2981 return file_name_absolute_p (SDATA (filename
)) ? Qt
: Qnil
;
2984 /* Return nonzero if file FILENAME exists and can be executed. */
2987 check_executable (filename
)
2991 int len
= strlen (filename
);
2994 if (stat (filename
, &st
) < 0)
2996 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2997 return ((st
.st_mode
& S_IEXEC
) != 0);
2999 return (S_ISREG (st
.st_mode
)
3001 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
3002 || stricmp (suffix
, ".exe") == 0
3003 || stricmp (suffix
, ".bat") == 0)
3004 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3005 #endif /* not WINDOWSNT */
3006 #else /* not DOS_NT */
3007 #ifdef HAVE_EUIDACCESS
3008 return (euidaccess (filename
, 1) >= 0);
3010 /* Access isn't quite right because it uses the real uid
3011 and we really want to test with the effective uid.
3012 But Unix doesn't give us a right way to do it. */
3013 return (access (filename
, 1) >= 0);
3015 #endif /* not DOS_NT */
3018 /* Return nonzero if file FILENAME exists and can be written. */
3021 check_writable (filename
)
3026 if (stat (filename
, &st
) < 0)
3028 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3029 #else /* not MSDOS */
3030 #ifdef HAVE_EUIDACCESS
3031 return (euidaccess (filename
, 2) >= 0);
3033 /* Access isn't quite right because it uses the real uid
3034 and we really want to test with the effective uid.
3035 But Unix doesn't give us a right way to do it.
3036 Opening with O_WRONLY could work for an ordinary file,
3037 but would lose for directories. */
3038 return (access (filename
, 2) >= 0);
3040 #endif /* not MSDOS */
3043 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3044 doc
: /* Return t if file FILENAME exists. (This does not mean you can read it.)
3045 See also `file-readable-p' and `file-attributes'. */)
3047 Lisp_Object filename
;
3049 Lisp_Object absname
;
3050 Lisp_Object handler
;
3051 struct stat statbuf
;
3053 CHECK_STRING (filename
);
3054 absname
= Fexpand_file_name (filename
, Qnil
);
3056 /* If the file name has special constructs in it,
3057 call the corresponding file handler. */
3058 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3059 if (!NILP (handler
))
3060 return call2 (handler
, Qfile_exists_p
, absname
);
3062 absname
= ENCODE_FILE (absname
);
3064 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3067 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3068 doc
: /* Return t if FILENAME can be executed by you.
3069 For a directory, this means you can access files in that directory. */)
3071 Lisp_Object filename
;
3073 Lisp_Object absname
;
3074 Lisp_Object handler
;
3076 CHECK_STRING (filename
);
3077 absname
= Fexpand_file_name (filename
, Qnil
);
3079 /* If the file name has special constructs in it,
3080 call the corresponding file handler. */
3081 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3082 if (!NILP (handler
))
3083 return call2 (handler
, Qfile_executable_p
, absname
);
3085 absname
= ENCODE_FILE (absname
);
3087 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3090 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3091 doc
: /* Return t if file FILENAME exists and you can read it.
3092 See also `file-exists-p' and `file-attributes'. */)
3094 Lisp_Object filename
;
3096 Lisp_Object absname
;
3097 Lisp_Object handler
;
3100 struct stat statbuf
;
3102 CHECK_STRING (filename
);
3103 absname
= Fexpand_file_name (filename
, Qnil
);
3105 /* If the file name has special constructs in it,
3106 call the corresponding file handler. */
3107 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3108 if (!NILP (handler
))
3109 return call2 (handler
, Qfile_readable_p
, absname
);
3111 absname
= ENCODE_FILE (absname
);
3113 #if defined(DOS_NT) || defined(macintosh)
3114 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3116 if (access (SDATA (absname
), 0) == 0)
3119 #else /* not DOS_NT and not macintosh */
3121 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3122 /* Opening a fifo without O_NONBLOCK can wait.
3123 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3124 except in the case of a fifo, on a system which handles it. */
3125 desc
= stat (SDATA (absname
), &statbuf
);
3128 if (S_ISFIFO (statbuf
.st_mode
))
3129 flags
|= O_NONBLOCK
;
3131 desc
= emacs_open (SDATA (absname
), flags
, 0);
3136 #endif /* not DOS_NT and not macintosh */
3139 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3141 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3142 doc
: /* Return t if file FILENAME can be written or created by you. */)
3144 Lisp_Object filename
;
3146 Lisp_Object absname
, dir
, encoded
;
3147 Lisp_Object handler
;
3148 struct stat statbuf
;
3150 CHECK_STRING (filename
);
3151 absname
= Fexpand_file_name (filename
, Qnil
);
3153 /* If the file name has special constructs in it,
3154 call the corresponding file handler. */
3155 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3156 if (!NILP (handler
))
3157 return call2 (handler
, Qfile_writable_p
, absname
);
3159 encoded
= ENCODE_FILE (absname
);
3160 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3161 return (check_writable (SDATA (encoded
))
3164 dir
= Ffile_name_directory (absname
);
3167 dir
= Fdirectory_file_name (dir
);
3171 dir
= Fdirectory_file_name (dir
);
3174 dir
= ENCODE_FILE (dir
);
3176 /* The read-only attribute of the parent directory doesn't affect
3177 whether a file or directory can be created within it. Some day we
3178 should check ACLs though, which do affect this. */
3179 if (stat (SDATA (dir
), &statbuf
) < 0)
3181 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3183 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3188 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3189 doc
: /* Access file FILENAME, and get an error if that does not work.
3190 The second argument STRING is used in the error message.
3191 If there is no error, we return nil. */)
3193 Lisp_Object filename
, string
;
3195 Lisp_Object handler
, encoded_filename
, absname
;
3198 CHECK_STRING (filename
);
3199 absname
= Fexpand_file_name (filename
, Qnil
);
3201 CHECK_STRING (string
);
3203 /* If the file name has special constructs in it,
3204 call the corresponding file handler. */
3205 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3206 if (!NILP (handler
))
3207 return call3 (handler
, Qaccess_file
, absname
, string
);
3209 encoded_filename
= ENCODE_FILE (absname
);
3211 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3213 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3219 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3220 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3221 The value is the link target, as a string.
3222 Otherwise returns nil. */)
3224 Lisp_Object filename
;
3226 Lisp_Object handler
;
3228 CHECK_STRING (filename
);
3229 filename
= Fexpand_file_name (filename
, Qnil
);
3231 /* If the file name has special constructs in it,
3232 call the corresponding file handler. */
3233 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3234 if (!NILP (handler
))
3235 return call2 (handler
, Qfile_symlink_p
, filename
);
3244 filename
= ENCODE_FILE (filename
);
3251 buf
= (char *) xrealloc (buf
, bufsize
);
3252 bzero (buf
, bufsize
);
3255 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3259 /* HP-UX reports ERANGE if buffer is too small. */
3260 if (errno
== ERANGE
)
3270 while (valsize
>= bufsize
);
3272 val
= make_string (buf
, valsize
);
3273 if (buf
[0] == '/' && index (buf
, ':'))
3274 val
= concat2 (build_string ("/:"), val
);
3276 val
= DECODE_FILE (val
);
3279 #else /* not S_IFLNK */
3281 #endif /* not S_IFLNK */
3284 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3285 doc
: /* Return t if FILENAME names an existing directory.
3286 Symbolic links to directories count as directories.
3287 See `file-symlink-p' to distinguish symlinks. */)
3289 Lisp_Object filename
;
3291 register Lisp_Object absname
;
3293 Lisp_Object handler
;
3295 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3297 /* If the file name has special constructs in it,
3298 call the corresponding file handler. */
3299 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3300 if (!NILP (handler
))
3301 return call2 (handler
, Qfile_directory_p
, absname
);
3303 absname
= ENCODE_FILE (absname
);
3305 if (stat (SDATA (absname
), &st
) < 0)
3307 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3310 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3311 doc
: /* Return t if file FILENAME names a directory you can open.
3312 For the value to be t, FILENAME must specify the name of a directory as a file,
3313 and the directory must allow you to open files in it. In order to use a
3314 directory as a buffer's current directory, this predicate must return true.
3315 A directory name spec may be given instead; then the value is t
3316 if the directory so specified exists and really is a readable and
3317 searchable directory. */)
3319 Lisp_Object filename
;
3321 Lisp_Object handler
;
3323 struct gcpro gcpro1
;
3325 /* If the file name has special constructs in it,
3326 call the corresponding file handler. */
3327 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3328 if (!NILP (handler
))
3329 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3332 tem
= (NILP (Ffile_directory_p (filename
))
3333 || NILP (Ffile_executable_p (filename
)));
3335 return tem
? Qnil
: Qt
;
3338 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3339 doc
: /* Return t if file FILENAME is the name of a regular file.
3340 This is the sort of file that holds an ordinary stream of data bytes. */)
3342 Lisp_Object filename
;
3344 register Lisp_Object absname
;
3346 Lisp_Object handler
;
3348 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3350 /* If the file name has special constructs in it,
3351 call the corresponding file handler. */
3352 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3353 if (!NILP (handler
))
3354 return call2 (handler
, Qfile_regular_p
, absname
);
3356 absname
= ENCODE_FILE (absname
);
3361 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3363 /* Tell stat to use expensive method to get accurate info. */
3364 Vw32_get_true_file_attributes
= Qt
;
3365 result
= stat (SDATA (absname
), &st
);
3366 Vw32_get_true_file_attributes
= tem
;
3370 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3373 if (stat (SDATA (absname
), &st
) < 0)
3375 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3379 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3380 doc
: /* Return mode bits of file named FILENAME, as an integer.
3381 Return nil, if file does not exist or is not accessible. */)
3383 Lisp_Object filename
;
3385 Lisp_Object absname
;
3387 Lisp_Object handler
;
3389 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3391 /* If the file name has special constructs in it,
3392 call the corresponding file handler. */
3393 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3394 if (!NILP (handler
))
3395 return call2 (handler
, Qfile_modes
, absname
);
3397 absname
= ENCODE_FILE (absname
);
3399 if (stat (SDATA (absname
), &st
) < 0)
3401 #if defined (MSDOS) && __DJGPP__ < 2
3402 if (check_executable (SDATA (absname
)))
3403 st
.st_mode
|= S_IEXEC
;
3404 #endif /* MSDOS && __DJGPP__ < 2 */
3406 return make_number (st
.st_mode
& 07777);
3409 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3410 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3411 Only the 12 low bits of MODE are used. */)
3413 Lisp_Object filename
, mode
;
3415 Lisp_Object absname
, encoded_absname
;
3416 Lisp_Object handler
;
3418 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3419 CHECK_NUMBER (mode
);
3421 /* If the file name has special constructs in it,
3422 call the corresponding file handler. */
3423 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3424 if (!NILP (handler
))
3425 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3427 encoded_absname
= ENCODE_FILE (absname
);
3429 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3430 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3435 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3436 doc
: /* Set the file permission bits for newly created files.
3437 The argument MODE should be an integer; only the low 9 bits are used.
3438 This setting is inherited by subprocesses. */)
3442 CHECK_NUMBER (mode
);
3444 umask ((~ XINT (mode
)) & 0777);
3449 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3450 doc
: /* Return the default file protection for created files.
3451 The value is an integer. */)
3457 realmask
= umask (0);
3460 XSETINT (value
, (~ realmask
) & 0777);
3464 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3466 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3467 doc
: /* Set times of file FILENAME to TIME.
3468 Set both access and modification times.
3469 Return t on success, else nil.
3470 Use the current time if TIME is nil. TIME is in the format of
3473 Lisp_Object filename
, time
;
3475 Lisp_Object absname
, encoded_absname
;
3476 Lisp_Object handler
;
3480 if (! lisp_time_argument (time
, &sec
, &usec
))
3481 error ("Invalid time specification");
3483 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3485 /* If the file name has special constructs in it,
3486 call the corresponding file handler. */
3487 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3488 if (!NILP (handler
))
3489 return call3 (handler
, Qset_file_times
, absname
, time
);
3491 encoded_absname
= ENCODE_FILE (absname
);
3496 EMACS_SET_SECS (t
, sec
);
3497 EMACS_SET_USECS (t
, usec
);
3499 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3504 /* Setting times on a directory always fails. */
3505 if (stat (SDATA (encoded_absname
), &st
) == 0
3506 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3509 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3522 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3523 doc
: /* Tell Unix to finish all pending disk updates. */)
3532 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3533 doc
: /* Return t if file FILE1 is newer than file FILE2.
3534 If FILE1 does not exist, the answer is nil;
3535 otherwise, if FILE2 does not exist, the answer is t. */)
3537 Lisp_Object file1
, file2
;
3539 Lisp_Object absname1
, absname2
;
3542 Lisp_Object handler
;
3543 struct gcpro gcpro1
, gcpro2
;
3545 CHECK_STRING (file1
);
3546 CHECK_STRING (file2
);
3549 GCPRO2 (absname1
, file2
);
3550 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3551 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3554 /* If the file name has special constructs in it,
3555 call the corresponding file handler. */
3556 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3558 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3559 if (!NILP (handler
))
3560 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3562 GCPRO2 (absname1
, absname2
);
3563 absname1
= ENCODE_FILE (absname1
);
3564 absname2
= ENCODE_FILE (absname2
);
3567 if (stat (SDATA (absname1
), &st
) < 0)
3570 mtime1
= st
.st_mtime
;
3572 if (stat (SDATA (absname2
), &st
) < 0)
3575 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3579 Lisp_Object Qfind_buffer_file_type
;
3582 #ifndef READ_BUF_SIZE
3583 #define READ_BUF_SIZE (64 << 10)
3586 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3588 /* This function is called after Lisp functions to decide a coding
3589 system are called, or when they cause an error. Before they are
3590 called, the current buffer is set unibyte and it contains only a
3591 newly inserted text (thus the buffer was empty before the
3594 The functions may set markers, overlays, text properties, or even
3595 alter the buffer contents, change the current buffer.
3597 Here, we reset all those changes by:
3598 o set back the current buffer.
3599 o move all markers and overlays to BEG.
3600 o remove all text properties.
3601 o set back the buffer multibyteness. */
3604 decide_coding_unwind (unwind_data
)
3605 Lisp_Object unwind_data
;
3607 Lisp_Object multibyte
, undo_list
, buffer
;
3609 multibyte
= XCAR (unwind_data
);
3610 unwind_data
= XCDR (unwind_data
);
3611 undo_list
= XCAR (unwind_data
);
3612 buffer
= XCDR (unwind_data
);
3614 if (current_buffer
!= XBUFFER (buffer
))
3615 set_buffer_internal (XBUFFER (buffer
));
3616 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3617 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3618 BUF_INTERVALS (current_buffer
) = 0;
3619 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3621 /* Now we are safe to change the buffer's multibyteness directly. */
3622 current_buffer
->enable_multibyte_characters
= multibyte
;
3623 current_buffer
->undo_list
= undo_list
;
3629 /* Used to pass values from insert-file-contents to read_non_regular. */
3631 static int non_regular_fd
;
3632 static int non_regular_inserted
;
3633 static int non_regular_nbytes
;
3636 /* Read from a non-regular file.
3637 Read non_regular_trytry bytes max from non_regular_fd.
3638 Non_regular_inserted specifies where to put the read bytes.
3639 Value is the number of bytes read. */
3648 nbytes
= emacs_read (non_regular_fd
,
3649 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3650 non_regular_nbytes
);
3652 return make_number (nbytes
);
3656 /* Condition-case handler used when reading from non-regular files
3657 in insert-file-contents. */
3660 read_non_regular_quit ()
3666 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3668 doc
: /* Insert contents of file FILENAME after point.
3669 Returns list of absolute file name and number of characters inserted.
3670 If second argument VISIT is non-nil, the buffer's visited filename
3671 and last save file modtime are set, and it is marked unmodified.
3672 If visiting and the file does not exist, visiting is completed
3673 before the error is signaled.
3674 The optional third and fourth arguments BEG and END
3675 specify what portion of the file to insert.
3676 These arguments count bytes in the file, not characters in the buffer.
3677 If VISIT is non-nil, BEG and END must be nil.
3679 If optional fifth argument REPLACE is non-nil,
3680 it means replace the current buffer contents (in the accessible portion)
3681 with the file contents. This is better than simply deleting and inserting
3682 the whole thing because (1) it preserves some marker positions
3683 and (2) it puts less data in the undo list.
3684 When REPLACE is non-nil, the value is the number of characters actually read,
3685 which is often less than the number of characters to be read.
3687 This does code conversion according to the value of
3688 `coding-system-for-read' or `file-coding-system-alist',
3689 and sets the variable `last-coding-system-used' to the coding system
3691 (filename
, visit
, beg
, end
, replace
)
3692 Lisp_Object filename
, visit
, beg
, end
, replace
;
3697 register int how_much
;
3698 register int unprocessed
;
3699 int count
= SPECPDL_INDEX ();
3700 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3701 Lisp_Object handler
, val
, insval
, orig_filename
;
3704 int not_regular
= 0;
3705 unsigned char read_buf
[READ_BUF_SIZE
];
3706 struct coding_system coding
;
3707 unsigned char buffer
[1 << 14];
3708 int replace_handled
= 0;
3709 int set_coding_system
= 0;
3710 Lisp_Object coding_system
;
3713 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3714 error ("Cannot do file visiting in an indirect buffer");
3716 if (!NILP (current_buffer
->read_only
))
3717 Fbarf_if_buffer_read_only ();
3721 orig_filename
= Qnil
;
3723 GCPRO4 (filename
, val
, p
, orig_filename
);
3725 CHECK_STRING (filename
);
3726 filename
= Fexpand_file_name (filename
, Qnil
);
3728 /* The value Qnil means that the coding system is not yet
3730 coding_system
= Qnil
;
3732 /* If the file name has special constructs in it,
3733 call the corresponding file handler. */
3734 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3735 if (!NILP (handler
))
3737 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3738 visit
, beg
, end
, replace
);
3739 if (CONSP (val
) && CONSP (XCDR (val
)))
3740 inserted
= XINT (XCAR (XCDR (val
)));
3744 orig_filename
= filename
;
3745 filename
= ENCODE_FILE (filename
);
3751 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3753 /* Tell stat to use expensive method to get accurate info. */
3754 Vw32_get_true_file_attributes
= Qt
;
3755 total
= stat (SDATA (filename
), &st
);
3756 Vw32_get_true_file_attributes
= tem
;
3761 if (stat (SDATA (filename
), &st
) < 0)
3763 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3764 || fstat (fd
, &st
) < 0)
3765 #endif /* not APOLLO */
3766 #endif /* WINDOWSNT */
3768 if (fd
>= 0) emacs_close (fd
);
3771 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3774 if (!NILP (Vcoding_system_for_read
))
3775 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3780 /* This code will need to be changed in order to work on named
3781 pipes, and it's probably just not worth it. So we should at
3782 least signal an error. */
3783 if (!S_ISREG (st
.st_mode
))
3790 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3791 Fsignal (Qfile_error
,
3792 Fcons (build_string ("not a regular file"),
3793 Fcons (orig_filename
, Qnil
)));
3798 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3801 /* Replacement should preserve point as it preserves markers. */
3802 if (!NILP (replace
))
3803 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3805 record_unwind_protect (close_file_unwind
, make_number (fd
));
3807 /* Supposedly happens on VMS. */
3808 /* Can happen on any platform that uses long as type of off_t, but allows
3809 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3810 give a message suitable for the latter case. */
3811 if (! not_regular
&& st
.st_size
< 0)
3812 error ("Maximum buffer size exceeded");
3814 /* Prevent redisplay optimizations. */
3815 current_buffer
->clip_changed
= 1;
3819 if (!NILP (beg
) || !NILP (end
))
3820 error ("Attempt to visit less than an entire file");
3821 if (BEG
< Z
&& NILP (replace
))
3822 error ("Cannot do file visiting in a non-empty buffer");
3828 XSETFASTINT (beg
, 0);
3836 XSETINT (end
, st
.st_size
);
3838 /* Arithmetic overflow can occur if an Emacs integer cannot
3839 represent the file size, or if the calculations below
3840 overflow. The calculations below double the file size
3841 twice, so check that it can be multiplied by 4 safely. */
3842 if (XINT (end
) != st
.st_size
3843 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3844 error ("Maximum buffer size exceeded");
3846 /* The file size returned from stat may be zero, but data
3847 may be readable nonetheless, for example when this is a
3848 file in the /proc filesystem. */
3849 if (st
.st_size
== 0)
3850 XSETINT (end
, READ_BUF_SIZE
);
3854 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3856 coding_system
= Qutf_8_emacs
;
3857 setup_coding_system (coding_system
, &coding
);
3858 /* Ensure we set Vlast_coding_system_used. */
3859 set_coding_system
= 1;
3863 /* Decide the coding system to use for reading the file now
3864 because we can't use an optimized method for handling
3865 `coding:' tag if the current buffer is not empty. */
3866 if (!NILP (Vcoding_system_for_read
))
3867 coding_system
= Vcoding_system_for_read
;
3870 /* Don't try looking inside a file for a coding system
3871 specification if it is not seekable. */
3872 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3874 /* Find a coding system specified in the heading two
3875 lines or in the tailing several lines of the file.
3876 We assume that the 1K-byte and 3K-byte for heading
3877 and tailing respectively are sufficient for this
3881 if (st
.st_size
<= (1024 * 4))
3882 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3885 nread
= emacs_read (fd
, read_buf
, 1024);
3888 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3889 report_file_error ("Setting file position",
3890 Fcons (orig_filename
, Qnil
));
3891 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3896 error ("IO error reading %s: %s",
3897 SDATA (orig_filename
), emacs_strerror (errno
));
3900 struct buffer
*prev
= current_buffer
;
3904 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3906 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3907 buf
= XBUFFER (buffer
);
3909 delete_all_overlays (buf
);
3910 buf
->directory
= current_buffer
->directory
;
3911 buf
->read_only
= Qnil
;
3912 buf
->filename
= Qnil
;
3913 buf
->undo_list
= Qt
;
3914 eassert (buf
->overlays_before
== NULL
);
3915 eassert (buf
->overlays_after
== NULL
);
3917 set_buffer_internal (buf
);
3919 buf
->enable_multibyte_characters
= Qnil
;
3921 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3922 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3923 coding_system
= call2 (Vset_auto_coding_function
,
3924 filename
, make_number (nread
));
3925 set_buffer_internal (prev
);
3927 /* Discard the unwind protect for recovering the
3931 /* Rewind the file for the actual read done later. */
3932 if (lseek (fd
, 0, 0) < 0)
3933 report_file_error ("Setting file position",
3934 Fcons (orig_filename
, Qnil
));
3938 if (NILP (coding_system
))
3940 /* If we have not yet decided a coding system, check
3941 file-coding-system-alist. */
3942 Lisp_Object args
[6];
3944 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3945 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3946 coding_system
= Ffind_operation_coding_system (6, args
);
3947 if (CONSP (coding_system
))
3948 coding_system
= XCAR (coding_system
);
3952 if (NILP (coding_system
))
3953 coding_system
= Qundecided
;
3955 CHECK_CODING_SYSTEM (coding_system
);
3957 if (NILP (current_buffer
->enable_multibyte_characters
))
3958 /* We must suppress all character code conversion except for
3959 end-of-line conversion. */
3960 coding_system
= raw_text_coding_system (coding_system
);
3962 setup_coding_system (coding_system
, &coding
);
3963 /* Ensure we set Vlast_coding_system_used. */
3964 set_coding_system
= 1;
3967 /* If requested, replace the accessible part of the buffer
3968 with the file contents. Avoid replacing text at the
3969 beginning or end of the buffer that matches the file contents;
3970 that preserves markers pointing to the unchanged parts.
3972 Here we implement this feature in an optimized way
3973 for the case where code conversion is NOT needed.
3974 The following if-statement handles the case of conversion
3975 in a less optimal way.
3977 If the code conversion is "automatic" then we try using this
3978 method and hope for the best.
3979 But if we discover the need for conversion, we give up on this method
3980 and let the following if-statement handle the replace job. */
3983 && (NILP (coding_system
)
3984 || ! CODING_REQUIRE_DECODING (&coding
)))
3986 /* same_at_start and same_at_end count bytes,
3987 because file access counts bytes
3988 and BEG and END count bytes. */
3989 int same_at_start
= BEGV_BYTE
;
3990 int same_at_end
= ZV_BYTE
;
3992 /* There is still a possibility we will find the need to do code
3993 conversion. If that happens, we set this variable to 1 to
3994 give up on handling REPLACE in the optimized way. */
3995 int giveup_match_end
= 0;
3997 if (XINT (beg
) != 0)
3999 if (lseek (fd
, XINT (beg
), 0) < 0)
4000 report_file_error ("Setting file position",
4001 Fcons (orig_filename
, Qnil
));
4006 /* Count how many chars at the start of the file
4007 match the text at the beginning of the buffer. */
4012 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4014 error ("IO error reading %s: %s",
4015 SDATA (orig_filename
), emacs_strerror (errno
));
4016 else if (nread
== 0)
4019 if (CODING_REQUIRE_DETECTION (&coding
))
4021 coding_system
= detect_coding_system (buffer
, nread
, nread
, 1, 0,
4023 setup_coding_system (coding_system
, &coding
);
4026 if (CODING_REQUIRE_DECODING (&coding
))
4027 /* We found that the file should be decoded somehow.
4028 Let's give up here. */
4030 giveup_match_end
= 1;
4035 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4036 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4037 same_at_start
++, bufpos
++;
4038 /* If we found a discrepancy, stop the scan.
4039 Otherwise loop around and scan the next bufferful. */
4040 if (bufpos
!= nread
)
4044 /* If the file matches the buffer completely,
4045 there's no need to replace anything. */
4046 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4050 /* Truncate the buffer to the size of the file. */
4051 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4056 /* Count how many chars at the end of the file
4057 match the text at the end of the buffer. But, if we have
4058 already found that decoding is necessary, don't waste time. */
4059 while (!giveup_match_end
)
4061 int total_read
, nread
, bufpos
, curpos
, trial
;
4063 /* At what file position are we now scanning? */
4064 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4065 /* If the entire file matches the buffer tail, stop the scan. */
4068 /* How much can we scan in the next step? */
4069 trial
= min (curpos
, sizeof buffer
);
4070 if (lseek (fd
, curpos
- trial
, 0) < 0)
4071 report_file_error ("Setting file position",
4072 Fcons (orig_filename
, Qnil
));
4074 total_read
= nread
= 0;
4075 while (total_read
< trial
)
4077 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4079 error ("IO error reading %s: %s",
4080 SDATA (orig_filename
), emacs_strerror (errno
));
4081 else if (nread
== 0)
4083 total_read
+= nread
;
4086 /* Scan this bufferful from the end, comparing with
4087 the Emacs buffer. */
4088 bufpos
= total_read
;
4090 /* Compare with same_at_start to avoid counting some buffer text
4091 as matching both at the file's beginning and at the end. */
4092 while (bufpos
> 0 && same_at_end
> same_at_start
4093 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4094 same_at_end
--, bufpos
--;
4096 /* If we found a discrepancy, stop the scan.
4097 Otherwise loop around and scan the preceding bufferful. */
4100 /* If this discrepancy is because of code conversion,
4101 we cannot use this method; giveup and try the other. */
4102 if (same_at_end
> same_at_start
4103 && FETCH_BYTE (same_at_end
- 1) >= 0200
4104 && ! NILP (current_buffer
->enable_multibyte_characters
)
4105 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4106 giveup_match_end
= 1;
4115 if (! giveup_match_end
)
4119 /* We win! We can handle REPLACE the optimized way. */
4121 /* Extend the start of non-matching text area to multibyte
4122 character boundary. */
4123 if (! NILP (current_buffer
->enable_multibyte_characters
))
4124 while (same_at_start
> BEGV_BYTE
4125 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4128 /* Extend the end of non-matching text area to multibyte
4129 character boundary. */
4130 if (! NILP (current_buffer
->enable_multibyte_characters
))
4131 while (same_at_end
< ZV_BYTE
4132 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4135 /* Don't try to reuse the same piece of text twice. */
4136 overlap
= (same_at_start
- BEGV_BYTE
4137 - (same_at_end
+ st
.st_size
- ZV
));
4139 same_at_end
+= overlap
;
4141 /* Arrange to read only the nonmatching middle part of the file. */
4142 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4143 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4145 del_range_byte (same_at_start
, same_at_end
, 0);
4146 /* Insert from the file at the proper position. */
4147 temp
= BYTE_TO_CHAR (same_at_start
);
4148 SET_PT_BOTH (temp
, same_at_start
);
4150 /* If display currently starts at beginning of line,
4151 keep it that way. */
4152 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4153 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4155 replace_handled
= 1;
4159 /* If requested, replace the accessible part of the buffer
4160 with the file contents. Avoid replacing text at the
4161 beginning or end of the buffer that matches the file contents;
4162 that preserves markers pointing to the unchanged parts.
4164 Here we implement this feature for the case where code conversion
4165 is needed, in a simple way that needs a lot of memory.
4166 The preceding if-statement handles the case of no conversion
4167 in a more optimized way. */
4168 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4170 int same_at_start
= BEGV_BYTE
;
4171 int same_at_end
= ZV_BYTE
;
4172 int same_at_start_charpos
;
4176 unsigned char *decoded
;
4178 int this_count
= SPECPDL_INDEX ();
4179 int multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
4180 Lisp_Object conversion_buffer
;
4182 conversion_buffer
= code_conversion_save (1, multibyte
);
4184 /* First read the whole file, performing code conversion into
4185 CONVERSION_BUFFER. */
4187 if (lseek (fd
, XINT (beg
), 0) < 0)
4188 report_file_error ("Setting file position",
4189 Fcons (orig_filename
, Qnil
));
4191 total
= st
.st_size
; /* Total bytes in the file. */
4192 how_much
= 0; /* Bytes read from file so far. */
4193 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4194 unprocessed
= 0; /* Bytes not processed in previous loop. */
4196 GCPRO1 (conversion_buffer
);
4197 while (how_much
< total
)
4199 /* We read one bunch by one (READ_BUF_SIZE bytes) to allow
4200 quitting while reading a huge while. */
4201 /* try is reserved in some compilers (Microsoft C) */
4202 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4205 /* Allow quitting out of the actual I/O. */
4208 this = emacs_read (fd
, read_buf
+ unprocessed
, trytry
);
4220 BUF_SET_PT (XBUFFER (conversion_buffer
),
4221 BUF_Z (XBUFFER (conversion_buffer
)));
4222 decode_coding_c_string (&coding
, read_buf
, unprocessed
+ this,
4224 unprocessed
= coding
.carryover_bytes
;
4225 if (coding
.carryover_bytes
> 0)
4226 bcopy (coding
.carryover
, read_buf
, unprocessed
);
4231 /* At this point, HOW_MUCH should equal TOTAL, or should be <= 0
4232 if we couldn't read the file. */
4237 error ("IO error reading %s: %s",
4238 SDATA (orig_filename
), emacs_strerror (errno
));
4239 else if (how_much
== -2)
4240 error ("maximum buffer size exceeded");
4243 if (unprocessed
> 0)
4245 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4246 decode_coding_c_string (&coding
, read_buf
, unprocessed
,
4248 coding
.mode
&= ~CODING_MODE_LAST_BLOCK
;
4251 decoded
= BUF_BEG_ADDR (XBUFFER (conversion_buffer
));
4252 inserted
= (BUF_Z_BYTE (XBUFFER (conversion_buffer
))
4253 - BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
4255 /* Compare the beginning of the converted string with the buffer
4259 while (bufpos
< inserted
&& same_at_start
< same_at_end
4260 && FETCH_BYTE (same_at_start
) == decoded
[bufpos
])
4261 same_at_start
++, bufpos
++;
4263 /* If the file matches the head of buffer completely,
4264 there's no need to replace anything. */
4266 if (bufpos
== inserted
)
4269 /* Truncate the buffer to the size of the file. */
4270 del_range_byte (same_at_start
, same_at_end
, 0);
4273 unbind_to (this_count
, Qnil
);
4277 /* Extend the start of non-matching text area to the previous
4278 multibyte character boundary. */
4279 if (! NILP (current_buffer
->enable_multibyte_characters
))
4280 while (same_at_start
> BEGV_BYTE
4281 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4284 /* Scan this bufferful from the end, comparing with
4285 the Emacs buffer. */
4288 /* Compare with same_at_start to avoid counting some buffer text
4289 as matching both at the file's beginning and at the end. */
4290 while (bufpos
> 0 && same_at_end
> same_at_start
4291 && FETCH_BYTE (same_at_end
- 1) == decoded
[bufpos
- 1])
4292 same_at_end
--, bufpos
--;
4294 /* Extend the end of non-matching text area to the next
4295 multibyte character boundary. */
4296 if (! NILP (current_buffer
->enable_multibyte_characters
))
4297 while (same_at_end
< ZV_BYTE
4298 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4301 /* Don't try to reuse the same piece of text twice. */
4302 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4304 same_at_end
+= overlap
;
4306 /* If display currently starts at beginning of line,
4307 keep it that way. */
4308 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4309 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4311 /* Replace the chars that we need to replace,
4312 and update INSERTED to equal the number of bytes
4313 we are taking from the decoded string. */
4314 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4316 if (same_at_end
!= same_at_start
)
4318 del_range_byte (same_at_start
, same_at_end
, 0);
4320 same_at_start
= GPT_BYTE
;
4324 temp
= BYTE_TO_CHAR (same_at_start
);
4326 /* Insert from the file at the proper position. */
4327 SET_PT_BOTH (temp
, same_at_start
);
4328 same_at_start_charpos
4329 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4332 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4333 same_at_start
+ inserted
)
4334 - same_at_start_charpos
);
4335 insert_from_buffer (XBUFFER (conversion_buffer
),
4336 same_at_start_charpos
, inserted_chars
, 0);
4337 /* Set `inserted' to the number of inserted characters. */
4338 inserted
= PT
- temp
;
4340 unbind_to (this_count
, Qnil
);
4347 register Lisp_Object temp
;
4349 total
= XINT (end
) - XINT (beg
);
4351 /* Make sure point-max won't overflow after this insertion. */
4352 XSETINT (temp
, total
);
4353 if (total
!= XINT (temp
))
4354 error ("Maximum buffer size exceeded");
4357 /* For a special file, all we can do is guess. */
4358 total
= READ_BUF_SIZE
;
4360 if (NILP (visit
) && total
> 0)
4361 prepare_to_modify_buffer (PT
, PT
, NULL
);
4364 if (GAP_SIZE
< total
)
4365 make_gap (total
- GAP_SIZE
);
4367 if (XINT (beg
) != 0 || !NILP (replace
))
4369 if (lseek (fd
, XINT (beg
), 0) < 0)
4370 report_file_error ("Setting file position",
4371 Fcons (orig_filename
, Qnil
));
4374 /* In the following loop, HOW_MUCH contains the total bytes read so
4375 far for a regular file, and not changed for a special file. But,
4376 before exiting the loop, it is set to a negative value if I/O
4380 /* Total bytes inserted. */
4383 /* Here, we don't do code conversion in the loop. It is done by
4384 decode_coding_gap after all data are read into the buffer. */
4386 int gap_size
= GAP_SIZE
;
4388 while (how_much
< total
)
4390 /* try is reserved in some compilers (Microsoft C) */
4391 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4398 /* Maybe make more room. */
4399 if (gap_size
< trytry
)
4401 make_gap (total
- gap_size
);
4402 gap_size
= GAP_SIZE
;
4405 /* Read from the file, capturing `quit'. When an
4406 error occurs, end the loop, and arrange for a quit
4407 to be signaled after decoding the text we read. */
4408 non_regular_fd
= fd
;
4409 non_regular_inserted
= inserted
;
4410 non_regular_nbytes
= trytry
;
4411 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4412 read_non_regular_quit
);
4423 /* Allow quitting out of the actual I/O. We don't make text
4424 part of the buffer until all the reading is done, so a C-g
4425 here doesn't do any harm. */
4428 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4440 /* For a regular file, where TOTAL is the real size,
4441 count HOW_MUCH to compare with it.
4442 For a special file, where TOTAL is just a buffer size,
4443 so don't bother counting in HOW_MUCH.
4444 (INSERTED is where we count the number of characters inserted.) */
4451 /* Make the text read part of the buffer. */
4452 GAP_SIZE
-= inserted
;
4454 GPT_BYTE
+= inserted
;
4456 ZV_BYTE
+= inserted
;
4461 /* Put an anchor to ensure multi-byte form ends at gap. */
4466 /* Discard the unwind protect for closing the file. */
4470 error ("IO error reading %s: %s",
4471 SDATA (orig_filename
), emacs_strerror (errno
));
4475 if (NILP (coding_system
))
4477 /* The coding system is not yet decided. Decide it by an
4478 optimized method for handling `coding:' tag.
4480 Note that we can get here only if the buffer was empty
4481 before the insertion. */
4483 if (!NILP (Vcoding_system_for_read
))
4484 coding_system
= Vcoding_system_for_read
;
4487 /* Since we are sure that the current buffer was empty
4488 before the insertion, we can toggle
4489 enable-multibyte-characters directly here without taking
4490 care of marker adjustment. By this way, we can run Lisp
4491 program safely before decoding the inserted text. */
4492 Lisp_Object unwind_data
;
4493 int count
= SPECPDL_INDEX ();
4495 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4496 Fcons (current_buffer
->undo_list
,
4497 Fcurrent_buffer ()));
4498 current_buffer
->enable_multibyte_characters
= Qnil
;
4499 current_buffer
->undo_list
= Qt
;
4500 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4502 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4504 coding_system
= call2 (Vset_auto_coding_function
,
4505 filename
, make_number (inserted
));
4508 if (NILP (coding_system
))
4510 /* If the coding system is not yet decided, check
4511 file-coding-system-alist. */
4512 Lisp_Object args
[6];
4514 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4515 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4516 coding_system
= Ffind_operation_coding_system (6, args
);
4517 if (CONSP (coding_system
))
4518 coding_system
= XCAR (coding_system
);
4520 unbind_to (count
, Qnil
);
4521 inserted
= Z_BYTE
- BEG_BYTE
;
4524 if (NILP (coding_system
))
4525 coding_system
= Qundecided
;
4527 CHECK_CODING_SYSTEM (coding_system
);
4529 if (NILP (current_buffer
->enable_multibyte_characters
))
4530 /* We must suppress all character code conversion except for
4531 end-of-line conversion. */
4532 coding_system
= raw_text_coding_system (coding_system
);
4533 setup_coding_system (coding_system
, &coding
);
4534 /* Ensure we set Vlast_coding_system_used. */
4535 set_coding_system
= 1;
4540 /* When we visit a file by raw-text, we change the buffer to
4542 if (CODING_FOR_UNIBYTE (&coding
)
4543 /* Can't do this if part of the buffer might be preserved. */
4545 /* Visiting a file with these coding system makes the buffer
4547 current_buffer
->enable_multibyte_characters
= Qnil
;
4550 coding
.dst_multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
4551 if (CODING_MAY_REQUIRE_DECODING (&coding
)
4552 && (inserted
> 0 || CODING_REQUIRE_FLUSHING (&coding
)))
4554 move_gap_both (PT
, PT_BYTE
);
4555 GAP_SIZE
+= inserted
;
4556 ZV_BYTE
-= inserted
;
4560 decode_coding_gap (&coding
, inserted
, inserted
);
4561 inserted
= coding
.produced_char
;
4562 coding_system
= CODING_ID_NAME (coding
.id
);
4564 else if (inserted
> 0)
4565 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4568 /* Now INSERTED is measured in characters. */
4571 /* Use the conversion type to determine buffer-file-type
4572 (find-buffer-file-type is now used to help determine the
4574 if ((VECTORP (CODING_ID_EOL_TYPE (coding
.id
))
4575 || EQ (CODING_ID_EOL_TYPE (coding
.id
), Qunix
))
4576 && ! CODING_REQUIRE_DECODING (&coding
))
4577 current_buffer
->buffer_file_type
= Qt
;
4579 current_buffer
->buffer_file_type
= Qnil
;
4586 if (!EQ (current_buffer
->undo_list
, Qt
))
4587 current_buffer
->undo_list
= Qnil
;
4589 stat (SDATA (filename
), &st
);
4594 current_buffer
->modtime
= st
.st_mtime
;
4595 current_buffer
->filename
= orig_filename
;
4598 SAVE_MODIFF
= MODIFF
;
4599 current_buffer
->auto_save_modified
= MODIFF
;
4600 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4601 #ifdef CLASH_DETECTION
4604 if (!NILP (current_buffer
->file_truename
))
4605 unlock_file (current_buffer
->file_truename
);
4606 unlock_file (filename
);
4608 #endif /* CLASH_DETECTION */
4610 Fsignal (Qfile_error
,
4611 Fcons (build_string ("not a regular file"),
4612 Fcons (orig_filename
, Qnil
)));
4615 if (set_coding_system
)
4616 Vlast_coding_system_used
= coding_system
;
4618 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4620 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4622 if (! NILP (insval
))
4624 CHECK_NUMBER (insval
);
4625 inserted
= XFASTINT (insval
);
4629 /* Decode file format */
4632 int empty_undo_list_p
= 0;
4634 /* If we're anyway going to discard undo information, don't
4635 record it in the first place. The buffer's undo list at this
4636 point is either nil or t when visiting a file. */
4639 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4640 current_buffer
->undo_list
= Qt
;
4643 insval
= call3 (Qformat_decode
,
4644 Qnil
, make_number (inserted
), visit
);
4645 CHECK_NUMBER (insval
);
4646 inserted
= XFASTINT (insval
);
4649 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4652 /* Call after-change hooks for the inserted text, aside from the case
4653 of normal visiting (not with REPLACE), which is done in a new buffer
4654 "before" the buffer is changed. */
4655 if (inserted
> 0 && total
> 0
4656 && (NILP (visit
) || !NILP (replace
)))
4658 signal_after_change (PT
, 0, inserted
);
4659 update_compositions (PT
, PT
, CHECK_BORDER
);
4662 p
= Vafter_insert_file_functions
;
4665 insval
= call1 (XCAR (p
), make_number (inserted
));
4668 CHECK_NUMBER (insval
);
4669 inserted
= XFASTINT (insval
);
4676 && current_buffer
->modtime
== -1)
4678 /* If visiting nonexistent file, return nil. */
4679 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4683 Fsignal (Qquit
, Qnil
);
4685 /* ??? Retval needs to be dealt with in all cases consistently. */
4687 val
= Fcons (orig_filename
,
4688 Fcons (make_number (inserted
),
4691 RETURN_UNGCPRO (unbind_to (count
, val
));
4694 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4696 /* If build_annotations switched buffers, switch back to BUF.
4697 Kill the temporary buffer that was selected in the meantime.
4699 Since this kill only the last temporary buffer, some buffers remain
4700 not killed if build_annotations switched buffers more than once.
4704 build_annotations_unwind (buf
)
4709 if (XBUFFER (buf
) == current_buffer
)
4711 tembuf
= Fcurrent_buffer ();
4713 Fkill_buffer (tembuf
);
4717 /* Decide the coding-system to encode the data with. */
4720 choose_write_coding_system (start
, end
, filename
,
4721 append
, visit
, lockname
, coding
)
4722 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4723 struct coding_system
*coding
;
4728 && NILP (Fstring_equal (current_buffer
->filename
,
4729 current_buffer
->auto_save_file_name
)))
4731 else if (!NILP (Vcoding_system_for_write
))
4733 val
= Vcoding_system_for_write
;
4734 if (coding_system_require_warning
4735 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4736 /* Confirm that VAL can surely encode the current region. */
4737 val
= call5 (Vselect_safe_coding_system_function
,
4738 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4743 /* If the variable `buffer-file-coding-system' is set locally,
4744 it means that the file was read with some kind of code
4745 conversion or the variable is explicitly set by users. We
4746 had better write it out with the same coding system even if
4747 `enable-multibyte-characters' is nil.
4749 If it is not set locally, we anyway have to convert EOL
4750 format if the default value of `buffer-file-coding-system'
4751 tells that it is not Unix-like (LF only) format. */
4752 int using_default_coding
= 0;
4753 int force_raw_text
= 0;
4755 val
= current_buffer
->buffer_file_coding_system
;
4757 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4760 if (NILP (current_buffer
->enable_multibyte_characters
))
4766 /* Check file-coding-system-alist. */
4767 Lisp_Object args
[7], coding_systems
;
4769 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4770 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4772 coding_systems
= Ffind_operation_coding_system (7, args
);
4773 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4774 val
= XCDR (coding_systems
);
4779 /* If we still have not decided a coding system, use the
4780 default value of buffer-file-coding-system. */
4781 val
= current_buffer
->buffer_file_coding_system
;
4782 using_default_coding
= 1;
4785 if (! NILP (val
) && ! force_raw_text
)
4787 Lisp_Object spec
, attrs
;
4789 CHECK_CODING_SYSTEM_GET_SPEC (val
, spec
);
4790 attrs
= AREF (spec
, 0);
4791 if (EQ (CODING_ATTR_TYPE (attrs
), Qraw_text
))
4796 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4797 /* Confirm that VAL can surely encode the current region. */
4798 val
= call5 (Vselect_safe_coding_system_function
,
4799 start
, end
, val
, Qnil
, filename
);
4801 /* If the decided coding-system doesn't specify end-of-line
4802 format, we use that of
4803 `default-buffer-file-coding-system'. */
4804 if (! using_default_coding
4805 && ! NILP (buffer_defaults
.buffer_file_coding_system
))
4806 val
= (coding_inherit_eol_type
4807 (val
, buffer_defaults
.buffer_file_coding_system
));
4809 /* If we decide not to encode text, use `raw-text' or one of its
4812 val
= raw_text_coding_system (val
);
4815 setup_coding_system (val
, coding
);
4817 && VECTORP (CODING_ID_EOL_TYPE (coding
->id
)))
4818 val
= AREF (CODING_ID_EOL_TYPE (coding
->id
), 0);
4820 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4821 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4825 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4826 "r\nFWrite region to file: \ni\ni\ni\np",
4827 doc
: /* Write current region into specified file.
4828 When called from a program, requires three arguments:
4829 START, END and FILENAME. START and END are normally buffer positions
4830 specifying the part of the buffer to write.
4831 If START is nil, that means to use the entire buffer contents.
4832 If START is a string, then output that string to the file
4833 instead of any buffer contents; END is ignored.
4835 Optional fourth argument APPEND if non-nil means
4836 append to existing file contents (if any). If it is an integer,
4837 seek to that offset in the file before writing.
4838 Optional fifth argument VISIT, if t or a string, means
4839 set the last-save-file-modtime of buffer to this file's modtime
4840 and mark buffer not modified.
4841 If VISIT is a string, it is a second file name;
4842 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4843 VISIT is also the file name to lock and unlock for clash detection.
4844 If VISIT is neither t nor nil nor a string,
4845 that means do not display the \"Wrote file\" message.
4846 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4847 use for locking and unlocking, overriding FILENAME and VISIT.
4848 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4849 for an existing file with the same name. If MUSTBENEW is `excl',
4850 that means to get an error if the file already exists; never overwrite.
4851 If MUSTBENEW is neither nil nor `excl', that means ask for
4852 confirmation before overwriting, but do go ahead and overwrite the file
4853 if the user confirms.
4855 This does code conversion according to the value of
4856 `coding-system-for-write', `buffer-file-coding-system', or
4857 `file-coding-system-alist', and sets the variable
4858 `last-coding-system-used' to the coding system actually used. */)
4859 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4860 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4865 const unsigned char *fn
;
4867 int count
= SPECPDL_INDEX ();
4870 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4872 Lisp_Object handler
;
4873 Lisp_Object visit_file
;
4874 Lisp_Object annotations
;
4875 Lisp_Object encoded_filename
;
4876 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4877 int quietly
= !NILP (visit
);
4878 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4879 struct buffer
*given_buffer
;
4881 int buffer_file_type
= O_BINARY
;
4883 struct coding_system coding
;
4885 if (current_buffer
->base_buffer
&& visiting
)
4886 error ("Cannot do file visiting in an indirect buffer");
4888 if (!NILP (start
) && !STRINGP (start
))
4889 validate_region (&start
, &end
);
4891 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4893 filename
= Fexpand_file_name (filename
, Qnil
);
4895 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4896 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4898 if (STRINGP (visit
))
4899 visit_file
= Fexpand_file_name (visit
, Qnil
);
4901 visit_file
= filename
;
4903 if (NILP (lockname
))
4904 lockname
= visit_file
;
4908 /* If the file name has special constructs in it,
4909 call the corresponding file handler. */
4910 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4911 /* If FILENAME has no handler, see if VISIT has one. */
4912 if (NILP (handler
) && STRINGP (visit
))
4913 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4915 if (!NILP (handler
))
4918 val
= call6 (handler
, Qwrite_region
, start
, end
,
4919 filename
, append
, visit
);
4923 SAVE_MODIFF
= MODIFF
;
4924 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4925 current_buffer
->filename
= visit_file
;
4931 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4933 /* Special kludge to simplify auto-saving. */
4936 XSETFASTINT (start
, BEG
);
4937 XSETFASTINT (end
, Z
);
4941 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4942 count1
= SPECPDL_INDEX ();
4944 given_buffer
= current_buffer
;
4946 if (!STRINGP (start
))
4948 annotations
= build_annotations (start
, end
);
4950 if (current_buffer
!= given_buffer
)
4952 XSETFASTINT (start
, BEGV
);
4953 XSETFASTINT (end
, ZV
);
4959 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4961 /* Decide the coding-system to encode the data with.
4962 We used to make this choice before calling build_annotations, but that
4963 leads to problems when a write-annotate-function takes care of
4964 unsavable chars (as was the case with X-Symbol). */
4965 Vlast_coding_system_used
4966 = choose_write_coding_system (start
, end
, filename
,
4967 append
, visit
, lockname
, &coding
);
4969 #ifdef CLASH_DETECTION
4972 #if 0 /* This causes trouble for GNUS. */
4973 /* If we've locked this file for some other buffer,
4974 query before proceeding. */
4975 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4976 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4979 lock_file (lockname
);
4981 #endif /* CLASH_DETECTION */
4983 encoded_filename
= ENCODE_FILE (filename
);
4985 fn
= SDATA (encoded_filename
);
4989 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
4990 #else /* not DOS_NT */
4991 desc
= emacs_open (fn
, O_WRONLY
, 0);
4992 #endif /* not DOS_NT */
4994 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4996 if (auto_saving
) /* Overwrite any previous version of autosave file */
4998 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4999 desc
= emacs_open (fn
, O_RDWR
, 0);
5001 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5002 ? SDATA (current_buffer
->filename
) : 0,
5005 else /* Write to temporary name and rename if no errors */
5007 Lisp_Object temp_name
;
5008 temp_name
= Ffile_name_directory (filename
);
5010 if (!NILP (temp_name
))
5012 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5013 build_string ("$$SAVE$$")));
5014 fname
= SDATA (filename
);
5015 fn
= SDATA (temp_name
);
5016 desc
= creat_copy_attrs (fname
, fn
);
5019 /* If we can't open the temporary file, try creating a new
5020 version of the original file. VMS "creat" creates a
5021 new version rather than truncating an existing file. */
5024 desc
= creat (fn
, 0666);
5025 #if 0 /* This can clobber an existing file and fail to replace it,
5026 if the user runs out of space. */
5029 /* We can't make a new version;
5030 try to truncate and rewrite existing version if any. */
5032 desc
= emacs_open (fn
, O_RDWR
, 0);
5038 desc
= creat (fn
, 0666);
5042 desc
= emacs_open (fn
,
5043 O_WRONLY
| O_CREAT
| buffer_file_type
5044 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5045 S_IREAD
| S_IWRITE
);
5046 #else /* not DOS_NT */
5047 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5048 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5049 auto_saving
? auto_save_mode_bits
: 0666);
5050 #endif /* not DOS_NT */
5051 #endif /* not VMS */
5055 #ifdef CLASH_DETECTION
5057 if (!auto_saving
) unlock_file (lockname
);
5059 #endif /* CLASH_DETECTION */
5061 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5064 record_unwind_protect (close_file_unwind
, make_number (desc
));
5066 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5070 if (NUMBERP (append
))
5071 ret
= lseek (desc
, XINT (append
), 1);
5073 ret
= lseek (desc
, 0, 2);
5076 #ifdef CLASH_DETECTION
5077 if (!auto_saving
) unlock_file (lockname
);
5078 #endif /* CLASH_DETECTION */
5080 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5088 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5089 * if we do writes that don't end with a carriage return. Furthermore
5090 * it cannot handle writes of more then 16K. The modified
5091 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5092 * this EXCEPT for the last record (iff it doesn't end with a carriage
5093 * return). This implies that if your buffer doesn't end with a carriage
5094 * return, you get one free... tough. However it also means that if
5095 * we make two calls to sys_write (a la the following code) you can
5096 * get one at the gap as well. The easiest way to fix this (honest)
5097 * is to move the gap to the next newline (or the end of the buffer).
5102 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5103 move_gap (find_next_newline (GPT
, 1));
5106 /* The new encoding routine doesn't require the following. */
5108 /* Whether VMS or not, we must move the gap to the next of newline
5109 when we must put designation sequences at beginning of line. */
5110 if (INTEGERP (start
)
5111 && coding
.type
== coding_type_iso2022
5112 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5113 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5115 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5116 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5117 move_gap_both (PT
, PT_BYTE
);
5118 SET_PT_BOTH (opoint
, opoint_byte
);
5126 if (STRINGP (start
))
5128 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5129 &annotations
, &coding
);
5132 else if (XINT (start
) != XINT (end
))
5134 failure
= 0 > a_write (desc
, Qnil
,
5135 XINT (start
), XINT (end
) - XINT (start
),
5136 &annotations
, &coding
);
5141 /* If file was empty, still need to write the annotations */
5142 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5143 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5147 if (CODING_REQUIRE_FLUSHING (&coding
)
5148 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5151 /* We have to flush out a data. */
5152 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5153 failure
= 0 > e_write (desc
, Qnil
, 1, 1, &coding
);
5160 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5161 Disk full in NFS may be reported here. */
5162 /* mib says that closing the file will try to write as fast as NFS can do
5163 it, and that means the fsync here is not crucial for autosave files. */
5164 if (!auto_saving
&& fsync (desc
) < 0)
5166 /* If fsync fails with EINTR, don't treat that as serious. */
5168 failure
= 1, save_errno
= errno
;
5172 /* Spurious "file has changed on disk" warnings have been
5173 observed on Suns as well.
5174 It seems that `close' can change the modtime, under nfs.
5176 (This has supposedly been fixed in Sunos 4,
5177 but who knows about all the other machines with NFS?) */
5180 /* On VMS and APOLLO, must do the stat after the close
5181 since closing changes the modtime. */
5184 /* Recall that #if defined does not work on VMS. */
5191 /* NFS can report a write failure now. */
5192 if (emacs_close (desc
) < 0)
5193 failure
= 1, save_errno
= errno
;
5196 /* If we wrote to a temporary name and had no errors, rename to real name. */
5200 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5208 /* Discard the unwind protect for close_file_unwind. */
5209 specpdl_ptr
= specpdl
+ count1
;
5210 /* Restore the original current buffer. */
5211 visit_file
= unbind_to (count
, visit_file
);
5213 #ifdef CLASH_DETECTION
5215 unlock_file (lockname
);
5216 #endif /* CLASH_DETECTION */
5218 /* Do this before reporting IO error
5219 to avoid a "file has changed on disk" warning on
5220 next attempt to save. */
5222 current_buffer
->modtime
= st
.st_mtime
;
5225 error ("IO error writing %s: %s", SDATA (filename
),
5226 emacs_strerror (save_errno
));
5230 SAVE_MODIFF
= MODIFF
;
5231 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5232 current_buffer
->filename
= visit_file
;
5233 update_mode_lines
++;
5238 && ! NILP (Fstring_equal (current_buffer
->filename
,
5239 current_buffer
->auto_save_file_name
)))
5240 SAVE_MODIFF
= MODIFF
;
5246 message_with_string ((INTEGERP (append
)
5256 Lisp_Object
merge ();
5258 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5259 doc
: /* Return t if (car A) is numerically less than (car B). */)
5263 return Flss (Fcar (a
), Fcar (b
));
5266 /* Build the complete list of annotations appropriate for writing out
5267 the text between START and END, by calling all the functions in
5268 write-region-annotate-functions and merging the lists they return.
5269 If one of these functions switches to a different buffer, we assume
5270 that buffer contains altered text. Therefore, the caller must
5271 make sure to restore the current buffer in all cases,
5272 as save-excursion would do. */
5275 build_annotations (start
, end
)
5276 Lisp_Object start
, end
;
5278 Lisp_Object annotations
;
5280 struct gcpro gcpro1
, gcpro2
;
5281 Lisp_Object original_buffer
;
5282 int i
, used_global
= 0;
5284 XSETBUFFER (original_buffer
, current_buffer
);
5287 p
= Vwrite_region_annotate_functions
;
5288 GCPRO2 (annotations
, p
);
5291 struct buffer
*given_buffer
= current_buffer
;
5292 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5293 { /* Use the global value of the hook. */
5296 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5298 p
= Fappend (2, arg
);
5301 Vwrite_region_annotations_so_far
= annotations
;
5302 res
= call2 (XCAR (p
), start
, end
);
5303 /* If the function makes a different buffer current,
5304 assume that means this buffer contains altered text to be output.
5305 Reset START and END from the buffer bounds
5306 and discard all previous annotations because they should have
5307 been dealt with by this function. */
5308 if (current_buffer
!= given_buffer
)
5310 XSETFASTINT (start
, BEGV
);
5311 XSETFASTINT (end
, ZV
);
5314 Flength (res
); /* Check basic validity of return value */
5315 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5319 /* Now do the same for annotation functions implied by the file-format */
5320 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
5321 p
= current_buffer
->auto_save_file_format
;
5323 p
= current_buffer
->file_format
;
5324 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5326 struct buffer
*given_buffer
= current_buffer
;
5328 Vwrite_region_annotations_so_far
= annotations
;
5330 /* Value is either a list of annotations or nil if the function
5331 has written annotations to a temporary buffer, which is now
5333 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5334 original_buffer
, make_number (i
));
5335 if (current_buffer
!= given_buffer
)
5337 XSETFASTINT (start
, BEGV
);
5338 XSETFASTINT (end
, ZV
);
5343 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5351 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5352 If STRING is nil, POS is the character position in the current buffer.
5353 Intersperse with them the annotations from *ANNOT
5354 which fall within the range of POS to POS + NCHARS,
5355 each at its appropriate position.
5357 We modify *ANNOT by discarding elements as we use them up.
5359 The return value is negative in case of system call failure. */
5362 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5365 register int nchars
;
5368 struct coding_system
*coding
;
5372 int lastpos
= pos
+ nchars
;
5374 while (NILP (*annot
) || CONSP (*annot
))
5376 tem
= Fcar_safe (Fcar (*annot
));
5379 nextpos
= XFASTINT (tem
);
5381 /* If there are no more annotations in this range,
5382 output the rest of the range all at once. */
5383 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5384 return e_write (desc
, string
, pos
, lastpos
, coding
);
5386 /* Output buffer text up to the next annotation's position. */
5389 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5393 /* Output the annotation. */
5394 tem
= Fcdr (Fcar (*annot
));
5397 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5400 *annot
= Fcdr (*annot
);
5406 /* Write text in the range START and END into descriptor DESC,
5407 encoding them with coding system CODING. If STRING is nil, START
5408 and END are character positions of the current buffer, else they
5409 are indexes to the string STRING. */
5412 e_write (desc
, string
, start
, end
, coding
)
5416 struct coding_system
*coding
;
5418 if (STRINGP (string
))
5421 end
= SCHARS (string
);
5424 /* We used to have a code for handling selective display here. But,
5425 now it is handled within encode_coding. */
5429 if (STRINGP (string
))
5431 coding
->src_multibyte
= SCHARS (string
) < SBYTES (string
);
5432 if (CODING_REQUIRE_ENCODING (coding
))
5434 encode_coding_object (coding
, string
,
5435 start
, string_char_to_byte (string
, start
),
5436 end
, string_char_to_byte (string
, end
), Qt
);
5440 coding
->dst_object
= string
;
5441 coding
->consumed_char
= SCHARS (string
);
5442 coding
->produced
= SBYTES (string
);
5447 int start_byte
= CHAR_TO_BYTE (start
);
5448 int end_byte
= CHAR_TO_BYTE (end
);
5450 coding
->src_multibyte
= (end
- start
) < (end_byte
- start_byte
);
5451 if (CODING_REQUIRE_ENCODING (coding
))
5453 encode_coding_object (coding
, Fcurrent_buffer (),
5454 start
, start_byte
, end
, end_byte
, Qt
);
5458 coding
->dst_object
= Qnil
;
5459 coding
->dst_pos_byte
= start_byte
;
5460 if (start
>= GPT
|| end
<= GPT
)
5462 coding
->consumed_char
= end
- start
;
5463 coding
->produced
= end_byte
- start_byte
;
5467 coding
->consumed_char
= GPT
- start
;
5468 coding
->produced
= GPT_BYTE
- start_byte
;
5473 if (coding
->produced
> 0)
5477 STRINGP (coding
->dst_object
)
5478 ? SDATA (coding
->dst_object
)
5479 : BYTE_POS_ADDR (coding
->dst_pos_byte
),
5482 if (coding
->produced
)
5485 start
+= coding
->consumed_char
;
5491 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5492 Sverify_visited_file_modtime
, 1, 1, 0,
5493 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5494 This means that the file has not been changed since it was visited or saved.
5495 See Info node `(elisp)Modification Time' for more details. */)
5501 Lisp_Object handler
;
5502 Lisp_Object filename
;
5507 if (!STRINGP (b
->filename
)) return Qt
;
5508 if (b
->modtime
== 0) return Qt
;
5510 /* If the file name has special constructs in it,
5511 call the corresponding file handler. */
5512 handler
= Ffind_file_name_handler (b
->filename
,
5513 Qverify_visited_file_modtime
);
5514 if (!NILP (handler
))
5515 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5517 filename
= ENCODE_FILE (b
->filename
);
5519 if (stat (SDATA (filename
), &st
) < 0)
5521 /* If the file doesn't exist now and didn't exist before,
5522 we say that it isn't modified, provided the error is a tame one. */
5523 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5528 if (st
.st_mtime
== b
->modtime
5529 /* If both are positive, accept them if they are off by one second. */
5530 || (st
.st_mtime
> 0 && b
->modtime
> 0
5531 && (st
.st_mtime
== b
->modtime
+ 1
5532 || st
.st_mtime
== b
->modtime
- 1)))
5537 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5538 Sclear_visited_file_modtime
, 0, 0, 0,
5539 doc
: /* Clear out records of last mod time of visited file.
5540 Next attempt to save will certainly not complain of a discrepancy. */)
5543 current_buffer
->modtime
= 0;
5547 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5548 Svisited_file_modtime
, 0, 0, 0,
5549 doc
: /* Return the current buffer's recorded visited file modification time.
5550 The value is a list of the form (HIGH LOW), like the time values
5551 that `file-attributes' returns. If the current buffer has no recorded
5552 file modification time, this function returns 0.
5553 See Info node `(elisp)Modification Time' for more details. */)
5557 tcons
= long_to_cons ((unsigned long) current_buffer
->modtime
);
5559 return list2 (XCAR (tcons
), XCDR (tcons
));
5563 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5564 Sset_visited_file_modtime
, 0, 1, 0,
5565 doc
: /* Update buffer's recorded modification time from the visited file's time.
5566 Useful if the buffer was not read from the file normally
5567 or if the file itself has been changed for some known benign reason.
5568 An argument specifies the modification time value to use
5569 \(instead of that of the visited file), in the form of a list
5570 \(HIGH . LOW) or (HIGH LOW). */)
5572 Lisp_Object time_list
;
5574 if (!NILP (time_list
))
5575 current_buffer
->modtime
= cons_to_long (time_list
);
5578 register Lisp_Object filename
;
5580 Lisp_Object handler
;
5582 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5584 /* If the file name has special constructs in it,
5585 call the corresponding file handler. */
5586 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5587 if (!NILP (handler
))
5588 /* The handler can find the file name the same way we did. */
5589 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5591 filename
= ENCODE_FILE (filename
);
5593 if (stat (SDATA (filename
), &st
) >= 0)
5594 current_buffer
->modtime
= st
.st_mtime
;
5601 auto_save_error (error
)
5604 Lisp_Object args
[3], msg
;
5606 struct gcpro gcpro1
;
5610 args
[0] = build_string ("Auto-saving %s: %s");
5611 args
[1] = current_buffer
->name
;
5612 args
[2] = Ferror_message_string (error
);
5613 msg
= Fformat (3, args
);
5615 nbytes
= SBYTES (msg
);
5617 for (i
= 0; i
< 3; ++i
)
5620 message2 (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5622 message2_nolog (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5623 Fsleep_for (make_number (1), Qnil
);
5636 auto_save_mode_bits
= 0666;
5638 /* Get visited file's mode to become the auto save file's mode. */
5639 if (! NILP (current_buffer
->filename
))
5641 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5642 /* But make sure we can overwrite it later! */
5643 auto_save_mode_bits
= st
.st_mode
| 0600;
5644 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5646 /* Remote files don't cooperate with stat. */
5647 auto_save_mode_bits
= XINT (modes
) | 0600;
5651 Fwrite_region (Qnil
, Qnil
,
5652 current_buffer
->auto_save_file_name
,
5653 Qnil
, Qlambda
, Qnil
, Qnil
);
5657 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5662 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5663 | XFASTINT (XCDR (stream
))));
5668 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5671 minibuffer_auto_raise
= XINT (value
);
5676 do_auto_save_make_dir (dir
)
5679 return call2 (Qmake_directory
, dir
, Qt
);
5683 do_auto_save_eh (ignore
)
5689 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5690 doc
: /* Auto-save all buffers that need it.
5691 This is all buffers that have auto-saving enabled
5692 and are changed since last auto-saved.
5693 Auto-saving writes the buffer into a file
5694 so that your editing is not lost if the system crashes.
5695 This file is not the file you visited; that changes only when you save.
5696 Normally we run the normal hook `auto-save-hook' before saving.
5698 A non-nil NO-MESSAGE argument means do not print any message if successful.
5699 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5700 (no_message
, current_only
)
5701 Lisp_Object no_message
, current_only
;
5703 struct buffer
*old
= current_buffer
, *b
;
5704 Lisp_Object tail
, buf
;
5706 int do_handled_files
;
5709 Lisp_Object lispstream
;
5710 int count
= SPECPDL_INDEX ();
5711 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5712 int old_message_p
= 0;
5713 struct gcpro gcpro1
, gcpro2
;
5715 if (max_specpdl_size
< specpdl_size
+ 40)
5716 max_specpdl_size
= specpdl_size
+ 40;
5721 if (NILP (no_message
))
5723 old_message_p
= push_message ();
5724 record_unwind_protect (pop_message_unwind
, Qnil
);
5727 /* Ordinarily don't quit within this function,
5728 but don't make it impossible to quit (in case we get hung in I/O). */
5732 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5733 point to non-strings reached from Vbuffer_alist. */
5735 if (!NILP (Vrun_hooks
))
5736 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5738 if (STRINGP (Vauto_save_list_file_name
))
5740 Lisp_Object listfile
;
5742 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5744 /* Don't try to create the directory when shutting down Emacs,
5745 because creating the directory might signal an error, and
5746 that would leave Emacs in a strange state. */
5747 if (!NILP (Vrun_hooks
))
5751 GCPRO2 (dir
, listfile
);
5752 dir
= Ffile_name_directory (listfile
);
5753 if (NILP (Ffile_directory_p (dir
)))
5754 internal_condition_case_1 (do_auto_save_make_dir
,
5755 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5760 stream
= fopen (SDATA (listfile
), "w");
5763 /* Arrange to close that file whether or not we get an error.
5764 Also reset auto_saving to 0. */
5765 lispstream
= Fcons (Qnil
, Qnil
);
5766 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
5767 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
5778 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5779 record_unwind_protect (do_auto_save_unwind_1
,
5780 make_number (minibuffer_auto_raise
));
5781 minibuffer_auto_raise
= 0;
5784 /* On first pass, save all files that don't have handlers.
5785 On second pass, save all files that do have handlers.
5787 If Emacs is crashing, the handlers may tweak what is causing
5788 Emacs to crash in the first place, and it would be a shame if
5789 Emacs failed to autosave perfectly ordinary files because it
5790 couldn't handle some ange-ftp'd file. */
5792 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5793 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5795 buf
= XCDR (XCAR (tail
));
5798 /* Record all the buffers that have auto save mode
5799 in the special file that lists them. For each of these buffers,
5800 Record visited name (if any) and auto save name. */
5801 if (STRINGP (b
->auto_save_file_name
)
5802 && stream
!= NULL
&& do_handled_files
== 0)
5804 if (!NILP (b
->filename
))
5806 fwrite (SDATA (b
->filename
), 1,
5807 SBYTES (b
->filename
), stream
);
5809 putc ('\n', stream
);
5810 fwrite (SDATA (b
->auto_save_file_name
), 1,
5811 SBYTES (b
->auto_save_file_name
), stream
);
5812 putc ('\n', stream
);
5815 if (!NILP (current_only
)
5816 && b
!= current_buffer
)
5819 /* Don't auto-save indirect buffers.
5820 The base buffer takes care of it. */
5824 /* Check for auto save enabled
5825 and file changed since last auto save
5826 and file changed since last real save. */
5827 if (STRINGP (b
->auto_save_file_name
)
5828 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5829 && b
->auto_save_modified
< BUF_MODIFF (b
)
5830 /* -1 means we've turned off autosaving for a while--see below. */
5831 && XINT (b
->save_length
) >= 0
5832 && (do_handled_files
5833 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5836 EMACS_TIME before_time
, after_time
;
5838 EMACS_GET_TIME (before_time
);
5840 /* If we had a failure, don't try again for 20 minutes. */
5841 if (b
->auto_save_failure_time
>= 0
5842 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5845 if ((XFASTINT (b
->save_length
) * 10
5846 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5847 /* A short file is likely to change a large fraction;
5848 spare the user annoying messages. */
5849 && XFASTINT (b
->save_length
) > 5000
5850 /* These messages are frequent and annoying for `*mail*'. */
5851 && !EQ (b
->filename
, Qnil
)
5852 && NILP (no_message
))
5854 /* It has shrunk too much; turn off auto-saving here. */
5855 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5856 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5858 minibuffer_auto_raise
= 0;
5859 /* Turn off auto-saving until there's a real save,
5860 and prevent any more warnings. */
5861 XSETINT (b
->save_length
, -1);
5862 Fsleep_for (make_number (1), Qnil
);
5865 set_buffer_internal (b
);
5866 if (!auto_saved
&& NILP (no_message
))
5867 message1 ("Auto-saving...");
5868 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5870 b
->auto_save_modified
= BUF_MODIFF (b
);
5871 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5872 set_buffer_internal (old
);
5874 EMACS_GET_TIME (after_time
);
5876 /* If auto-save took more than 60 seconds,
5877 assume it was an NFS failure that got a timeout. */
5878 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5879 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5883 /* Prevent another auto save till enough input events come in. */
5884 record_auto_save ();
5886 if (auto_saved
&& NILP (no_message
))
5890 /* If we are going to restore an old message,
5891 give time to read ours. */
5892 sit_for (1, 0, 0, 0, 0);
5896 /* If we displayed a message and then restored a state
5897 with no message, leave a "done" message on the screen. */
5898 message1 ("Auto-saving...done");
5903 /* This restores the message-stack status. */
5904 unbind_to (count
, Qnil
);
5908 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5909 Sset_buffer_auto_saved
, 0, 0, 0,
5910 doc
: /* Mark current buffer as auto-saved with its current text.
5911 No auto-save file will be written until the buffer changes again. */)
5914 current_buffer
->auto_save_modified
= MODIFF
;
5915 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5916 current_buffer
->auto_save_failure_time
= -1;
5920 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5921 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5922 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5925 current_buffer
->auto_save_failure_time
= -1;
5929 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5931 doc
: /* Return t if buffer has been auto-saved since last read in or saved. */)
5934 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5937 /* Reading and completing file names */
5938 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
5940 /* In the string VAL, change each $ to $$ and return the result. */
5943 double_dollars (val
)
5946 register const unsigned char *old
;
5947 register unsigned char *new;
5951 osize
= SBYTES (val
);
5953 /* Count the number of $ characters. */
5954 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
5955 if (*old
++ == '$') count
++;
5959 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
5962 for (n
= osize
; n
> 0; n
--)
5976 read_file_name_cleanup (arg
)
5979 return (current_buffer
->directory
= arg
);
5982 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
5984 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
5985 (string
, dir
, action
)
5986 Lisp_Object string
, dir
, action
;
5987 /* action is nil for complete, t for return list of completions,
5988 lambda for verify final value */
5990 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
5992 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5994 CHECK_STRING (string
);
6001 /* No need to protect ACTION--we only compare it with t and nil. */
6002 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6004 if (SCHARS (string
) == 0)
6006 if (EQ (action
, Qlambda
))
6014 orig_string
= string
;
6015 string
= Fsubstitute_in_file_name (string
);
6016 changed
= NILP (Fstring_equal (string
, orig_string
));
6017 name
= Ffile_name_nondirectory (string
);
6018 val
= Ffile_name_directory (string
);
6020 realdir
= Fexpand_file_name (val
, realdir
);
6025 specdir
= Ffile_name_directory (string
);
6026 val
= Ffile_name_completion (name
, realdir
);
6031 return double_dollars (string
);
6035 if (!NILP (specdir
))
6036 val
= concat2 (specdir
, val
);
6038 return double_dollars (val
);
6041 #endif /* not VMS */
6045 if (EQ (action
, Qt
))
6047 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6051 if (NILP (Vread_file_name_predicate
)
6052 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6056 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6058 /* Brute-force speed up for directory checking:
6059 Discard strings which don't end in a slash. */
6060 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6062 Lisp_Object tem
= XCAR (all
);
6064 if (STRINGP (tem
) &&
6065 (len
= SCHARS (tem
), len
> 0) &&
6066 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6067 comp
= Fcons (tem
, comp
);
6073 /* Must do it the hard (and slow) way. */
6074 GCPRO3 (all
, comp
, specdir
);
6075 count
= SPECPDL_INDEX ();
6076 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6077 current_buffer
->directory
= realdir
;
6078 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6079 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
6080 comp
= Fcons (XCAR (all
), comp
);
6081 unbind_to (count
, Qnil
);
6084 return Fnreverse (comp
);
6087 /* Only other case actually used is ACTION = lambda */
6089 /* Supposedly this helps commands such as `cd' that read directory names,
6090 but can someone explain how it helps them? -- RMS */
6091 if (SCHARS (name
) == 0)
6094 string
= Fexpand_file_name (string
, dir
);
6095 if (!NILP (Vread_file_name_predicate
))
6096 return call1 (Vread_file_name_predicate
, string
);
6097 return Ffile_exists_p (string
);
6100 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
6101 Snext_read_file_uses_dialog_p
, 0, 0, 0,
6102 doc
: /* Return t if a call to `read-file-name' will use a dialog.
6103 The return value is only relevant for a call to `read-file-name' that happens
6104 before any other event (mouse or keypress) is handeled. */)
6107 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6108 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6117 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6118 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6119 Value is not expanded---you must call `expand-file-name' yourself.
6120 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6121 the same non-empty string that was inserted by this function.
6122 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6123 except that if INITIAL is specified, that combined with DIR is used.)
6124 If the user exits with an empty minibuffer, this function returns
6125 an empty string. (This can only happen if the user erased the
6126 pre-inserted contents or if `insert-default-directory' is nil.)
6127 Fourth arg MUSTMATCH non-nil means require existing file's name.
6128 Non-nil and non-t means also require confirmation after completion.
6129 Fifth arg INITIAL specifies text to start with.
6130 If optional sixth arg PREDICATE is non-nil, possible completions and
6131 the resulting file name must satisfy (funcall PREDICATE NAME).
6132 DIR should be an absolute directory name. It defaults to the value of
6133 `default-directory'.
6135 If this command was invoked with the mouse, use a file dialog box if
6136 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6137 provides a file dialog box.
6139 See also `read-file-name-completion-ignore-case'
6140 and `read-file-name-function'. */)
6141 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6142 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6144 Lisp_Object val
, insdef
, tem
;
6145 struct gcpro gcpro1
, gcpro2
;
6146 register char *homedir
;
6147 Lisp_Object decoded_homedir
;
6148 int replace_in_history
= 0;
6149 int add_to_history
= 0;
6153 dir
= current_buffer
->directory
;
6154 if (NILP (Ffile_name_absolute_p (dir
)))
6155 dir
= Fexpand_file_name (dir
, Qnil
);
6156 if (NILP (default_filename
))
6159 ? Fexpand_file_name (initial
, dir
)
6160 : current_buffer
->filename
);
6162 /* If dir starts with user's homedir, change that to ~. */
6163 homedir
= (char *) egetenv ("HOME");
6165 /* homedir can be NULL in temacs, since Vprocess_environment is not
6166 yet set up. We shouldn't crash in that case. */
6169 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6170 CORRECT_DIR_SEPS (homedir
);
6175 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6178 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6179 SBYTES (decoded_homedir
))
6180 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6182 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6183 dir
= concat2 (build_string ("~"), dir
);
6185 /* Likewise for default_filename. */
6187 && STRINGP (default_filename
)
6188 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6189 SBYTES (decoded_homedir
))
6190 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6193 = Fsubstring (default_filename
,
6194 make_number (SCHARS (decoded_homedir
)), Qnil
);
6195 default_filename
= concat2 (build_string ("~"), default_filename
);
6197 if (!NILP (default_filename
))
6199 CHECK_STRING (default_filename
);
6200 default_filename
= double_dollars (default_filename
);
6203 if (insert_default_directory
&& STRINGP (dir
))
6206 if (!NILP (initial
))
6208 Lisp_Object args
[2], pos
;
6212 insdef
= Fconcat (2, args
);
6213 pos
= make_number (SCHARS (double_dollars (dir
)));
6214 insdef
= Fcons (double_dollars (insdef
), pos
);
6217 insdef
= double_dollars (insdef
);
6219 else if (STRINGP (initial
))
6220 insdef
= Fcons (double_dollars (initial
), make_number (0));
6224 if (!NILP (Vread_file_name_function
))
6226 Lisp_Object args
[7];
6228 GCPRO2 (insdef
, default_filename
);
6229 args
[0] = Vread_file_name_function
;
6232 args
[3] = default_filename
;
6233 args
[4] = mustmatch
;
6235 args
[6] = predicate
;
6236 RETURN_UNGCPRO (Ffuncall (7, args
));
6239 count
= SPECPDL_INDEX ();
6240 specbind (intern ("completion-ignore-case"),
6241 read_file_name_completion_ignore_case
? Qt
: Qnil
);
6242 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6243 specbind (intern ("read-file-name-predicate"),
6244 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6246 GCPRO2 (insdef
, default_filename
);
6248 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6249 if (! NILP (Fnext_read_file_uses_dialog_p ()))
6251 /* If DIR contains a file name, split it. */
6253 file
= Ffile_name_nondirectory (dir
);
6254 if (SCHARS (file
) && NILP (default_filename
))
6256 default_filename
= file
;
6257 dir
= Ffile_name_directory (dir
);
6259 if (!NILP(default_filename
))
6260 default_filename
= Fexpand_file_name (default_filename
, dir
);
6261 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
,
6262 EQ (predicate
, Qfile_directory_p
) ? Qt
: Qnil
);
6267 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6268 dir
, mustmatch
, insdef
,
6269 Qfile_name_history
, default_filename
, Qnil
);
6271 tem
= Fsymbol_value (Qfile_name_history
);
6272 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6273 replace_in_history
= 1;
6275 /* If Fcompleting_read returned the inserted default string itself
6276 (rather than a new string with the same contents),
6277 it has to mean that the user typed RET with the minibuffer empty.
6278 In that case, we really want to return ""
6279 so that commands such as set-visited-file-name can distinguish. */
6280 if (EQ (val
, default_filename
))
6282 /* In this case, Fcompleting_read has not added an element
6283 to the history. Maybe we should. */
6284 if (! replace_in_history
)
6290 unbind_to (count
, Qnil
);
6293 error ("No file name specified");
6295 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6297 if (!NILP (tem
) && !NILP (default_filename
))
6298 val
= default_filename
;
6299 val
= Fsubstitute_in_file_name (val
);
6301 if (replace_in_history
)
6302 /* Replace what Fcompleting_read added to the history
6303 with what we will actually return. */
6305 Lisp_Object val1
= double_dollars (val
);
6306 tem
= Fsymbol_value (Qfile_name_history
);
6307 if (history_delete_duplicates
)
6308 XSETCDR (tem
, Fdelete (val1
, XCDR(tem
)));
6309 XSETCAR (tem
, val1
);
6311 else if (add_to_history
)
6313 /* Add the value to the history--but not if it matches
6314 the last value already there. */
6315 Lisp_Object val1
= double_dollars (val
);
6316 tem
= Fsymbol_value (Qfile_name_history
);
6317 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6319 if (history_delete_duplicates
) tem
= Fdelete (val1
, tem
);
6320 Fset (Qfile_name_history
, Fcons (val1
, tem
));
6331 /* Must be set before any path manipulation is performed. */
6332 XSETFASTINT (Vdirectory_sep_char
, '/');
6339 Qexpand_file_name
= intern ("expand-file-name");
6340 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6341 Qdirectory_file_name
= intern ("directory-file-name");
6342 Qfile_name_directory
= intern ("file-name-directory");
6343 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6344 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6345 Qfile_name_as_directory
= intern ("file-name-as-directory");
6346 Qcopy_file
= intern ("copy-file");
6347 Qmake_directory_internal
= intern ("make-directory-internal");
6348 Qmake_directory
= intern ("make-directory");
6349 Qdelete_directory
= intern ("delete-directory");
6350 Qdelete_file
= intern ("delete-file");
6351 Qrename_file
= intern ("rename-file");
6352 Qadd_name_to_file
= intern ("add-name-to-file");
6353 Qmake_symbolic_link
= intern ("make-symbolic-link");
6354 Qfile_exists_p
= intern ("file-exists-p");
6355 Qfile_executable_p
= intern ("file-executable-p");
6356 Qfile_readable_p
= intern ("file-readable-p");
6357 Qfile_writable_p
= intern ("file-writable-p");
6358 Qfile_symlink_p
= intern ("file-symlink-p");
6359 Qaccess_file
= intern ("access-file");
6360 Qfile_directory_p
= intern ("file-directory-p");
6361 Qfile_regular_p
= intern ("file-regular-p");
6362 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6363 Qfile_modes
= intern ("file-modes");
6364 Qset_file_modes
= intern ("set-file-modes");
6365 Qset_file_times
= intern ("set-file-times");
6366 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6367 Qinsert_file_contents
= intern ("insert-file-contents");
6368 Qwrite_region
= intern ("write-region");
6369 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6370 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6371 Qauto_save_coding
= intern ("auto-save-coding");
6373 staticpro (&Qexpand_file_name
);
6374 staticpro (&Qsubstitute_in_file_name
);
6375 staticpro (&Qdirectory_file_name
);
6376 staticpro (&Qfile_name_directory
);
6377 staticpro (&Qfile_name_nondirectory
);
6378 staticpro (&Qunhandled_file_name_directory
);
6379 staticpro (&Qfile_name_as_directory
);
6380 staticpro (&Qcopy_file
);
6381 staticpro (&Qmake_directory_internal
);
6382 staticpro (&Qmake_directory
);
6383 staticpro (&Qdelete_directory
);
6384 staticpro (&Qdelete_file
);
6385 staticpro (&Qrename_file
);
6386 staticpro (&Qadd_name_to_file
);
6387 staticpro (&Qmake_symbolic_link
);
6388 staticpro (&Qfile_exists_p
);
6389 staticpro (&Qfile_executable_p
);
6390 staticpro (&Qfile_readable_p
);
6391 staticpro (&Qfile_writable_p
);
6392 staticpro (&Qaccess_file
);
6393 staticpro (&Qfile_symlink_p
);
6394 staticpro (&Qfile_directory_p
);
6395 staticpro (&Qfile_regular_p
);
6396 staticpro (&Qfile_accessible_directory_p
);
6397 staticpro (&Qfile_modes
);
6398 staticpro (&Qset_file_modes
);
6399 staticpro (&Qset_file_times
);
6400 staticpro (&Qfile_newer_than_file_p
);
6401 staticpro (&Qinsert_file_contents
);
6402 staticpro (&Qwrite_region
);
6403 staticpro (&Qverify_visited_file_modtime
);
6404 staticpro (&Qset_visited_file_modtime
);
6405 staticpro (&Qauto_save_coding
);
6407 Qfile_name_history
= intern ("file-name-history");
6408 Fset (Qfile_name_history
, Qnil
);
6409 staticpro (&Qfile_name_history
);
6411 Qfile_error
= intern ("file-error");
6412 staticpro (&Qfile_error
);
6413 Qfile_already_exists
= intern ("file-already-exists");
6414 staticpro (&Qfile_already_exists
);
6415 Qfile_date_error
= intern ("file-date-error");
6416 staticpro (&Qfile_date_error
);
6417 Qexcl
= intern ("excl");
6421 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6422 staticpro (&Qfind_buffer_file_type
);
6425 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6426 doc
: /* *Coding system for encoding file names.
6427 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6428 Vfile_name_coding_system
= Qnil
;
6430 DEFVAR_LISP ("default-file-name-coding-system",
6431 &Vdefault_file_name_coding_system
,
6432 doc
: /* Default coding system for encoding file names.
6433 This variable is used only when `file-name-coding-system' is nil.
6435 This variable is set/changed by the command `set-language-environment'.
6436 User should not set this variable manually,
6437 instead use `file-name-coding-system' to get a constant encoding
6438 of file names regardless of the current language environment. */);
6439 Vdefault_file_name_coding_system
= Qnil
;
6441 Qformat_decode
= intern ("format-decode");
6442 staticpro (&Qformat_decode
);
6443 Qformat_annotate_function
= intern ("format-annotate-function");
6444 staticpro (&Qformat_annotate_function
);
6445 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6446 staticpro (&Qafter_insert_file_set_coding
);
6448 Qcar_less_than_car
= intern ("car-less-than-car");
6449 staticpro (&Qcar_less_than_car
);
6451 Fput (Qfile_error
, Qerror_conditions
,
6452 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6453 Fput (Qfile_error
, Qerror_message
,
6454 build_string ("File error"));
6456 Fput (Qfile_already_exists
, Qerror_conditions
,
6457 Fcons (Qfile_already_exists
,
6458 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6459 Fput (Qfile_already_exists
, Qerror_message
,
6460 build_string ("File already exists"));
6462 Fput (Qfile_date_error
, Qerror_conditions
,
6463 Fcons (Qfile_date_error
,
6464 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6465 Fput (Qfile_date_error
, Qerror_message
,
6466 build_string ("Cannot set file date"));
6468 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6469 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6470 Vread_file_name_function
= Qnil
;
6472 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6473 doc
: /* Current predicate used by `read-file-name-internal'. */);
6474 Vread_file_name_predicate
= Qnil
;
6476 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case
,
6477 doc
: /* *Non-nil means when reading a file name completion ignores case. */);
6478 #if defined VMS || defined DOS_NT || defined MAC_OS
6479 read_file_name_completion_ignore_case
= 1;
6481 read_file_name_completion_ignore_case
= 0;
6484 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6485 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6486 If the initial minibuffer contents are non-empty, you can usually
6487 request a default filename by typing RETURN without editing. For some
6488 commands, exiting with an empty minibuffer has a special meaning,
6489 such as making the current buffer visit no file in the case of
6490 `set-visited-file-name'.
6491 If this variable is non-nil, the minibuffer contents are always
6492 initially non-empty and typing RETURN without editing will fetch the
6493 default name, if one is provided. Note however that this default name
6494 is not necessarily the name originally inserted in the minibuffer, if
6495 that is just the default directory.
6496 If this variable is nil, the minibuffer often starts out empty. In
6497 that case you may have to explicitly fetch the next history element to
6498 request the default name. */);
6499 insert_default_directory
= 1;
6501 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6502 doc
: /* *Non-nil means write new files with record format `stmlf'.
6503 nil means use format `var'. This variable is meaningful only on VMS. */);
6504 vms_stmlf_recfm
= 0;
6506 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6507 doc
: /* Directory separator character for built-in functions that return file names.
6508 The value is always ?/. Don't use this variable, just use `/'. */);
6510 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6511 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6512 If a file name matches REGEXP, then all I/O on that file is done by calling
6515 The first argument given to HANDLER is the name of the I/O primitive
6516 to be handled; the remaining arguments are the arguments that were
6517 passed to that primitive. For example, if you do
6518 (file-exists-p FILENAME)
6519 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6520 (funcall HANDLER 'file-exists-p FILENAME)
6521 The function `find-file-name-handler' checks this list for a handler
6522 for its argument. */);
6523 Vfile_name_handler_alist
= Qnil
;
6525 DEFVAR_LISP ("set-auto-coding-function",
6526 &Vset_auto_coding_function
,
6527 doc
: /* If non-nil, a function to call to decide a coding system of file.
6528 Two arguments are passed to this function: the file name
6529 and the length of a file contents following the point.
6530 This function should return a coding system to decode the file contents.
6531 It should check the file name against `auto-coding-alist'.
6532 If no coding system is decided, it should check a coding system
6533 specified in the heading lines with the format:
6534 -*- ... coding: CODING-SYSTEM; ... -*-
6535 or local variable spec of the tailing lines with `coding:' tag. */);
6536 Vset_auto_coding_function
= Qnil
;
6538 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6539 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6540 Each is passed one argument, the number of characters inserted.
6541 It should return the new character count, and leave point the same.
6542 If `insert-file-contents' is intercepted by a handler from
6543 `file-name-handler-alist', that handler is responsible for calling the
6544 functions in `after-insert-file-functions' if appropriate. */);
6545 Vafter_insert_file_functions
= Qnil
;
6547 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6548 doc
: /* A list of functions to be called at the start of `write-region'.
6549 Each is passed two arguments, START and END as for `write-region'.
6550 These are usually two numbers but not always; see the documentation
6551 for `write-region'. The function should return a list of pairs
6552 of the form (POSITION . STRING), consisting of strings to be effectively
6553 inserted at the specified positions of the file being written (1 means to
6554 insert before the first byte written). The POSITIONs must be sorted into
6555 increasing order. If there are several functions in the list, the several
6556 lists are merged destructively. Alternatively, the function can return
6557 with a different buffer current; in that case it should pay attention
6558 to the annotations returned by previous functions and listed in
6559 `write-region-annotations-so-far'.*/);
6560 Vwrite_region_annotate_functions
= Qnil
;
6561 staticpro (&Qwrite_region_annotate_functions
);
6562 Qwrite_region_annotate_functions
6563 = intern ("write-region-annotate-functions");
6565 DEFVAR_LISP ("write-region-annotations-so-far",
6566 &Vwrite_region_annotations_so_far
,
6567 doc
: /* When an annotation function is called, this holds the previous annotations.
6568 These are the annotations made by other annotation functions
6569 that were already called. See also `write-region-annotate-functions'. */);
6570 Vwrite_region_annotations_so_far
= Qnil
;
6572 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6573 doc
: /* A list of file name handlers that temporarily should not be used.
6574 This applies only to the operation `inhibit-file-name-operation'. */);
6575 Vinhibit_file_name_handlers
= Qnil
;
6577 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6578 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6579 Vinhibit_file_name_operation
= Qnil
;
6581 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6582 doc
: /* File name in which we write a list of all auto save file names.
6583 This variable is initialized automatically from `auto-save-list-file-prefix'
6584 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6585 a non-nil value. */);
6586 Vauto_save_list_file_name
= Qnil
;
6588 defsubr (&Sfind_file_name_handler
);
6589 defsubr (&Sfile_name_directory
);
6590 defsubr (&Sfile_name_nondirectory
);
6591 defsubr (&Sunhandled_file_name_directory
);
6592 defsubr (&Sfile_name_as_directory
);
6593 defsubr (&Sdirectory_file_name
);
6594 defsubr (&Smake_temp_name
);
6595 defsubr (&Sexpand_file_name
);
6596 defsubr (&Ssubstitute_in_file_name
);
6597 defsubr (&Scopy_file
);
6598 defsubr (&Smake_directory_internal
);
6599 defsubr (&Sdelete_directory
);
6600 defsubr (&Sdelete_file
);
6601 defsubr (&Srename_file
);
6602 defsubr (&Sadd_name_to_file
);
6604 defsubr (&Smake_symbolic_link
);
6605 #endif /* S_IFLNK */
6607 defsubr (&Sdefine_logical_name
);
6610 defsubr (&Ssysnetunam
);
6611 #endif /* HPUX_NET */
6612 defsubr (&Sfile_name_absolute_p
);
6613 defsubr (&Sfile_exists_p
);
6614 defsubr (&Sfile_executable_p
);
6615 defsubr (&Sfile_readable_p
);
6616 defsubr (&Sfile_writable_p
);
6617 defsubr (&Saccess_file
);
6618 defsubr (&Sfile_symlink_p
);
6619 defsubr (&Sfile_directory_p
);
6620 defsubr (&Sfile_accessible_directory_p
);
6621 defsubr (&Sfile_regular_p
);
6622 defsubr (&Sfile_modes
);
6623 defsubr (&Sset_file_modes
);
6624 defsubr (&Sset_file_times
);
6625 defsubr (&Sset_default_file_modes
);
6626 defsubr (&Sdefault_file_modes
);
6627 defsubr (&Sfile_newer_than_file_p
);
6628 defsubr (&Sinsert_file_contents
);
6629 defsubr (&Swrite_region
);
6630 defsubr (&Scar_less_than_car
);
6631 defsubr (&Sverify_visited_file_modtime
);
6632 defsubr (&Sclear_visited_file_modtime
);
6633 defsubr (&Svisited_file_modtime
);
6634 defsubr (&Sset_visited_file_modtime
);
6635 defsubr (&Sdo_auto_save
);
6636 defsubr (&Sset_buffer_auto_saved
);
6637 defsubr (&Sclear_buffer_auto_save_failure
);
6638 defsubr (&Srecent_auto_save_p
);
6640 defsubr (&Sread_file_name_internal
);
6641 defsubr (&Sread_file_name
);
6642 defsubr (&Snext_read_file_uses_dialog_p
);
6645 defsubr (&Sunix_sync
);
6649 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6650 (do not change this comment) */