1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996, 1997, 1998,
3 1999, 2000, 2001, 2003, 2004 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
29 #include <sys/types.h>
36 #if !defined (S_ISLNK) && defined (S_IFLNK)
37 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
40 #if !defined (S_ISFIFO) && defined (S_IFIFO)
41 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
44 #if !defined (S_ISREG) && defined (S_IFREG)
45 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
76 #include "intervals.h"
82 #include "dispextern.h"
89 #endif /* not WINDOWSNT */
93 #include <sys/param.h>
101 #define CORRECT_DIR_SEPS(s) \
102 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
103 else unixtodos_filename (s); \
105 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
106 redirector allows the six letters between 'Z' and 'a' as well. */
108 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
111 #define IS_DRIVE(x) isalpha (x)
113 /* Need to lower-case the drive letter, or else expanded
114 filenames will sometimes compare inequal, because
115 `expand-file-name' doesn't always down-case the drive letter. */
116 #define DRIVE_LETTER(x) (tolower (x))
137 #include "commands.h"
138 extern int use_dialog_box
;
139 extern int use_file_dialog
;
153 /* Nonzero during writing of auto-save files */
156 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
157 a new file with the same mode as the original */
158 int auto_save_mode_bits
;
160 /* The symbol bound to coding-system-for-read when
161 insert-file-contents is called for recovering a file. This is not
162 an actual coding system name, but just an indicator to tell
163 insert-file-contents to use `emacs-mule' with a special flag for
164 auto saving and recovering a file. */
165 Lisp_Object Qauto_save_coding
;
167 /* Coding system for file names, or nil if none. */
168 Lisp_Object Vfile_name_coding_system
;
170 /* Coding system for file names used only when
171 Vfile_name_coding_system is nil. */
172 Lisp_Object Vdefault_file_name_coding_system
;
174 /* Alist of elements (REGEXP . HANDLER) for file names
175 whose I/O is done with a special handler. */
176 Lisp_Object Vfile_name_handler_alist
;
178 /* Lisp functions for translating file formats */
179 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
181 /* Function to be called to decide a coding system of a reading file. */
182 Lisp_Object Vset_auto_coding_function
;
184 /* Functions to be called to process text properties in inserted file. */
185 Lisp_Object Vafter_insert_file_functions
;
187 /* Lisp function for setting buffer-file-coding-system and the
188 multibyteness of the current buffer after inserting a file. */
189 Lisp_Object Qafter_insert_file_set_coding
;
191 /* Functions to be called to create text property annotations for file. */
192 Lisp_Object Vwrite_region_annotate_functions
;
193 Lisp_Object Qwrite_region_annotate_functions
;
195 /* During build_annotations, each time an annotation function is called,
196 this holds the annotations made by the previous functions. */
197 Lisp_Object Vwrite_region_annotations_so_far
;
199 /* File name in which we write a list of all our auto save files. */
200 Lisp_Object Vauto_save_list_file_name
;
202 /* Function to call to read a file name. */
203 Lisp_Object Vread_file_name_function
;
205 /* Current predicate used by read_file_name_internal. */
206 Lisp_Object Vread_file_name_predicate
;
208 /* Nonzero means completion ignores case when reading file name. */
209 int read_file_name_completion_ignore_case
;
211 /* Nonzero means, when reading a filename in the minibuffer,
212 start out by inserting the default directory into the minibuffer. */
213 int insert_default_directory
;
215 /* On VMS, nonzero means write new files with record format stmlf.
216 Zero means use var format. */
219 /* On NT, specifies the directory separator character, used (eg.) when
220 expanding file names. This can be bound to / or \. */
221 Lisp_Object Vdirectory_sep_char
;
223 extern Lisp_Object Vuser_login_name
;
226 extern Lisp_Object Vw32_get_true_file_attributes
;
229 extern int minibuf_level
;
231 extern int minibuffer_auto_raise
;
233 extern int history_delete_duplicates
;
235 /* These variables describe handlers that have "already" had a chance
236 to handle the current operation.
238 Vinhibit_file_name_handlers is a list of file name handlers.
239 Vinhibit_file_name_operation is the operation being handled.
240 If we try to handle that operation, we ignore those handlers. */
242 static Lisp_Object Vinhibit_file_name_handlers
;
243 static Lisp_Object Vinhibit_file_name_operation
;
245 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
247 Lisp_Object Qfile_name_history
;
249 Lisp_Object Qcar_less_than_car
;
251 static int a_write
P_ ((int, Lisp_Object
, int, int,
252 Lisp_Object
*, struct coding_system
*));
253 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
257 report_file_error (string
, data
)
261 Lisp_Object errstring
;
264 synchronize_system_messages_locale ();
265 errstring
= code_convert_string_norecord (build_string (strerror (errorno
)),
266 Vlocale_coding_system
, 0);
272 Fsignal (Qfile_already_exists
, Fcons (errstring
, data
));
275 /* System error messages are capitalized. Downcase the initial
276 unless it is followed by a slash. */
277 if (SREF (errstring
, 1) != '/')
278 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
280 Fsignal (Qfile_error
,
281 Fcons (build_string (string
), Fcons (errstring
, data
)));
286 close_file_unwind (fd
)
289 emacs_close (XFASTINT (fd
));
293 /* Restore point, having saved it as a marker. */
296 restore_point_unwind (location
)
297 Lisp_Object location
;
299 Fgoto_char (location
);
300 Fset_marker (location
, Qnil
, Qnil
);
304 Lisp_Object Qexpand_file_name
;
305 Lisp_Object Qsubstitute_in_file_name
;
306 Lisp_Object Qdirectory_file_name
;
307 Lisp_Object Qfile_name_directory
;
308 Lisp_Object Qfile_name_nondirectory
;
309 Lisp_Object Qunhandled_file_name_directory
;
310 Lisp_Object Qfile_name_as_directory
;
311 Lisp_Object Qcopy_file
;
312 Lisp_Object Qmake_directory_internal
;
313 Lisp_Object Qmake_directory
;
314 Lisp_Object Qdelete_directory
;
315 Lisp_Object Qdelete_file
;
316 Lisp_Object Qrename_file
;
317 Lisp_Object Qadd_name_to_file
;
318 Lisp_Object Qmake_symbolic_link
;
319 Lisp_Object Qfile_exists_p
;
320 Lisp_Object Qfile_executable_p
;
321 Lisp_Object Qfile_readable_p
;
322 Lisp_Object Qfile_writable_p
;
323 Lisp_Object Qfile_symlink_p
;
324 Lisp_Object Qaccess_file
;
325 Lisp_Object Qfile_directory_p
;
326 Lisp_Object Qfile_regular_p
;
327 Lisp_Object Qfile_accessible_directory_p
;
328 Lisp_Object Qfile_modes
;
329 Lisp_Object Qset_file_modes
;
330 Lisp_Object Qset_file_times
;
331 Lisp_Object Qfile_newer_than_file_p
;
332 Lisp_Object Qinsert_file_contents
;
333 Lisp_Object Qwrite_region
;
334 Lisp_Object Qverify_visited_file_modtime
;
335 Lisp_Object Qset_visited_file_modtime
;
337 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
338 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
339 Otherwise, return nil.
340 A file name is handled if one of the regular expressions in
341 `file-name-handler-alist' matches it.
343 If OPERATION equals `inhibit-file-name-operation', then we ignore
344 any handlers that are members of `inhibit-file-name-handlers',
345 but we still do run any other handlers. This lets handlers
346 use the standard functions without calling themselves recursively. */)
347 (filename
, operation
)
348 Lisp_Object filename
, operation
;
350 /* This function must not munge the match data. */
351 Lisp_Object chain
, inhibited_handlers
, result
;
355 CHECK_STRING (filename
);
357 if (EQ (operation
, Vinhibit_file_name_operation
))
358 inhibited_handlers
= Vinhibit_file_name_handlers
;
360 inhibited_handlers
= Qnil
;
362 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
363 chain
= XCDR (chain
))
373 && (match_pos
= fast_string_match (string
, filename
)) > pos
)
375 Lisp_Object handler
, tem
;
377 handler
= XCDR (elt
);
378 tem
= Fmemq (handler
, inhibited_handlers
);
392 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
394 doc
: /* Return the directory component in file name FILENAME.
395 Return nil if FILENAME does not include a directory.
396 Otherwise return a directory spec.
397 Given a Unix syntax file name, returns a string ending in slash;
398 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
400 Lisp_Object filename
;
403 register const unsigned char *beg
;
405 register unsigned char *beg
;
407 register const unsigned char *p
;
410 CHECK_STRING (filename
);
412 /* If the file name has special constructs in it,
413 call the corresponding file handler. */
414 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
416 return call2 (handler
, Qfile_name_directory
, filename
);
418 #ifdef FILE_SYSTEM_CASE
419 filename
= FILE_SYSTEM_CASE (filename
);
421 beg
= SDATA (filename
);
423 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
425 p
= beg
+ SBYTES (filename
);
427 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
429 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
432 /* only recognise drive specifier at the beginning */
434 /* handle the "/:d:foo" and "/:foo" cases correctly */
435 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
436 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
443 /* Expansion of "c:" to drive and default directory. */
446 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
447 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
448 unsigned char *r
= res
;
450 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
452 strncpy (res
, beg
, 2);
457 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
459 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
462 p
= beg
+ strlen (beg
);
465 CORRECT_DIR_SEPS (beg
);
468 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
471 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
472 Sfile_name_nondirectory
, 1, 1, 0,
473 doc
: /* Return file name FILENAME sans its directory.
474 For example, in a Unix-syntax file name,
475 this is everything after the last slash,
476 or the entire name if it contains no slash. */)
478 Lisp_Object filename
;
480 register const unsigned char *beg
, *p
, *end
;
483 CHECK_STRING (filename
);
485 /* If the file name has special constructs in it,
486 call the corresponding file handler. */
487 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
489 return call2 (handler
, Qfile_name_nondirectory
, filename
);
491 beg
= SDATA (filename
);
492 end
= p
= beg
+ SBYTES (filename
);
494 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
496 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
499 /* only recognise drive specifier at beginning */
501 /* handle the "/:d:foo" case correctly */
502 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
507 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
510 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
511 Sunhandled_file_name_directory
, 1, 1, 0,
512 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
513 A `directly usable' directory name is one that may be used without the
514 intervention of any file handler.
515 If FILENAME is a directly usable file itself, return
516 \(file-name-directory FILENAME).
517 The `call-process' and `start-process' functions use this function to
518 get a current directory to run processes in. */)
520 Lisp_Object filename
;
524 /* If the file name has special constructs in it,
525 call the corresponding file handler. */
526 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
528 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
530 return Ffile_name_directory (filename
);
535 file_name_as_directory (out
, in
)
538 int size
= strlen (in
) - 1;
551 /* Is it already a directory string? */
552 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
554 /* Is it a VMS directory file name? If so, hack VMS syntax. */
555 else if (! index (in
, '/')
556 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
557 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
558 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
559 || ! strncmp (&in
[size
- 5], ".dir", 4))
560 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
561 && in
[size
] == '1')))
563 register char *p
, *dot
;
567 dir:x.dir --> dir:[x]
568 dir:[x]y.dir --> dir:[x.y] */
570 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
573 strncpy (out
, in
, p
- in
);
592 dot
= index (p
, '.');
595 /* blindly remove any extension */
596 size
= strlen (out
) + (dot
- p
);
597 strncat (out
, p
, dot
- p
);
608 /* For Unix syntax, Append a slash if necessary */
609 if (!IS_DIRECTORY_SEP (out
[size
]))
611 /* Cannot use DIRECTORY_SEP, which could have any value */
613 out
[size
+ 2] = '\0';
616 CORRECT_DIR_SEPS (out
);
622 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
623 Sfile_name_as_directory
, 1, 1, 0,
624 doc
: /* Return a string representing the file name FILE interpreted as a directory.
625 This operation exists because a directory is also a file, but its name as
626 a directory is different from its name as a file.
627 The result can be used as the value of `default-directory'
628 or passed as second argument to `expand-file-name'.
629 For a Unix-syntax file name, just appends a slash.
630 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
641 /* If the file name has special constructs in it,
642 call the corresponding file handler. */
643 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
645 return call2 (handler
, Qfile_name_as_directory
, file
);
647 buf
= (char *) alloca (SBYTES (file
) + 10);
648 file_name_as_directory (buf
, SDATA (file
));
649 return make_specified_string (buf
, -1, strlen (buf
),
650 STRING_MULTIBYTE (file
));
654 * Convert from directory name to filename.
656 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
657 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
658 * On UNIX, it's simple: just make sure there isn't a terminating /
660 * Value is nonzero if the string output is different from the input.
664 directory_file_name (src
, dst
)
672 struct FAB fab
= cc$rms_fab
;
673 struct NAM nam
= cc$rms_nam
;
674 char esa
[NAM$C_MAXRSS
];
679 if (! index (src
, '/')
680 && (src
[slen
- 1] == ']'
681 || src
[slen
- 1] == ':'
682 || src
[slen
- 1] == '>'))
684 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
686 fab
.fab$b_fns
= slen
;
687 fab
.fab$l_nam
= &nam
;
688 fab
.fab$l_fop
= FAB$M_NAM
;
691 nam
.nam$b_ess
= sizeof esa
;
692 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
694 /* We call SYS$PARSE to handle such things as [--] for us. */
695 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
697 slen
= nam
.nam$b_esl
;
698 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
703 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
705 /* what about when we have logical_name:???? */
706 if (src
[slen
- 1] == ':')
707 { /* Xlate logical name and see what we get */
708 ptr
= strcpy (dst
, src
); /* upper case for getenv */
711 if ('a' <= *ptr
&& *ptr
<= 'z')
715 dst
[slen
- 1] = 0; /* remove colon */
716 if (!(src
= egetenv (dst
)))
718 /* should we jump to the beginning of this procedure?
719 Good points: allows us to use logical names that xlate
721 Bad points: can be a problem if we just translated to a device
723 For now, I'll punt and always expect VMS names, and hope for
726 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
727 { /* no recursion here! */
733 { /* not a directory spec */
738 bracket
= src
[slen
- 1];
740 /* If bracket is ']' or '>', bracket - 2 is the corresponding
742 ptr
= index (src
, bracket
- 2);
744 { /* no opening bracket */
748 if (!(rptr
= rindex (src
, '.')))
751 strncpy (dst
, src
, slen
);
755 dst
[slen
++] = bracket
;
760 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
761 then translate the device and recurse. */
762 if (dst
[slen
- 1] == ':'
763 && dst
[slen
- 2] != ':' /* skip decnet nodes */
764 && strcmp (src
+ slen
, "[000000]") == 0)
766 dst
[slen
- 1] = '\0';
767 if ((ptr
= egetenv (dst
))
768 && (rlen
= strlen (ptr
) - 1) > 0
769 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
770 && ptr
[rlen
- 1] == '.')
772 char * buf
= (char *) alloca (strlen (ptr
) + 1);
776 return directory_file_name (buf
, dst
);
781 strcat (dst
, "[000000]");
785 rlen
= strlen (rptr
) - 1;
786 strncat (dst
, rptr
, rlen
);
787 dst
[slen
+ rlen
] = '\0';
788 strcat (dst
, ".DIR.1");
792 /* Process as Unix format: just remove any final slash.
793 But leave "/" unchanged; do not change it to "". */
796 /* Handle // as root for apollo's. */
797 if ((slen
> 2 && dst
[slen
- 1] == '/')
798 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
802 && IS_DIRECTORY_SEP (dst
[slen
- 1])
804 && !IS_ANY_SEP (dst
[slen
- 2])
810 CORRECT_DIR_SEPS (dst
);
815 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
817 doc
: /* Returns the file name of the directory named DIRECTORY.
818 This is the name of the file that holds the data for the directory DIRECTORY.
819 This operation exists because a directory is also a file, but its name as
820 a directory is different from its name as a file.
821 In Unix-syntax, this function just removes the final slash.
822 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
823 it returns a file name such as \"[X]Y.DIR.1\". */)
825 Lisp_Object directory
;
830 CHECK_STRING (directory
);
832 if (NILP (directory
))
835 /* If the file name has special constructs in it,
836 call the corresponding file handler. */
837 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
839 return call2 (handler
, Qdirectory_file_name
, directory
);
842 /* 20 extra chars is insufficient for VMS, since we might perform a
843 logical name translation. an equivalence string can be up to 255
844 chars long, so grab that much extra space... - sss */
845 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
847 buf
= (char *) alloca (SBYTES (directory
) + 20);
849 directory_file_name (SDATA (directory
), buf
);
850 return make_specified_string (buf
, -1, strlen (buf
),
851 STRING_MULTIBYTE (directory
));
854 static char make_temp_name_tbl
[64] =
856 'A','B','C','D','E','F','G','H',
857 'I','J','K','L','M','N','O','P',
858 'Q','R','S','T','U','V','W','X',
859 'Y','Z','a','b','c','d','e','f',
860 'g','h','i','j','k','l','m','n',
861 'o','p','q','r','s','t','u','v',
862 'w','x','y','z','0','1','2','3',
863 '4','5','6','7','8','9','-','_'
866 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
868 /* Value is a temporary file name starting with PREFIX, a string.
870 The Emacs process number forms part of the result, so there is
871 no danger of generating a name being used by another process.
872 In addition, this function makes an attempt to choose a name
873 which has no existing file. To make this work, PREFIX should be
874 an absolute file name.
876 BASE64_P non-zero means add the pid as 3 characters in base64
877 encoding. In this case, 6 characters will be added to PREFIX to
878 form the file name. Otherwise, if Emacs is running on a system
879 with long file names, add the pid as a decimal number.
881 This function signals an error if no unique file name could be
885 make_temp_name (prefix
, base64_p
)
892 unsigned char *p
, *data
;
896 CHECK_STRING (prefix
);
898 /* VAL is created by adding 6 characters to PREFIX. The first
899 three are the PID of this process, in base 64, and the second
900 three are incremented if the file already exists. This ensures
901 262144 unique file names per PID per PREFIX. */
903 pid
= (int) getpid ();
907 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
908 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
909 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
914 #ifdef HAVE_LONG_FILE_NAMES
915 sprintf (pidbuf
, "%d", pid
);
916 pidlen
= strlen (pidbuf
);
918 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
919 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
920 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
925 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
926 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
927 if (!STRING_MULTIBYTE (prefix
))
928 STRING_SET_UNIBYTE (val
);
930 bcopy(SDATA (prefix
), data
, len
);
933 bcopy (pidbuf
, p
, pidlen
);
936 /* Here we try to minimize useless stat'ing when this function is
937 invoked many times successively with the same PREFIX. We achieve
938 this by initializing count to a random value, and incrementing it
941 We don't want make-temp-name to be called while dumping,
942 because then make_temp_name_count_initialized_p would get set
943 and then make_temp_name_count would not be set when Emacs starts. */
945 if (!make_temp_name_count_initialized_p
)
947 make_temp_name_count
= (unsigned) time (NULL
);
948 make_temp_name_count_initialized_p
= 1;
954 unsigned num
= make_temp_name_count
;
956 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
957 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
958 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
960 /* Poor man's congruential RN generator. Replace with
961 ++make_temp_name_count for debugging. */
962 make_temp_name_count
+= 25229;
963 make_temp_name_count
%= 225307;
965 if (stat (data
, &ignored
) < 0)
967 /* We want to return only if errno is ENOENT. */
971 /* The error here is dubious, but there is little else we
972 can do. The alternatives are to return nil, which is
973 as bad as (and in many cases worse than) throwing the
974 error, or to ignore the error, which will likely result
975 in looping through 225307 stat's, which is not only
976 dog-slow, but also useless since it will fallback to
977 the errow below, anyway. */
978 report_file_error ("Cannot create temporary name for prefix",
979 Fcons (prefix
, Qnil
));
984 error ("Cannot create temporary name for prefix `%s'",
990 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
991 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
992 The Emacs process number forms part of the result,
993 so there is no danger of generating a name being used by another process.
995 In addition, this function makes an attempt to choose a name
996 which has no existing file. To make this work,
997 PREFIX should be an absolute file name.
999 There is a race condition between calling `make-temp-name' and creating the
1000 file which opens all kinds of security holes. For that reason, you should
1001 probably use `make-temp-file' instead, except in three circumstances:
1003 * If you are creating the file in the user's home directory.
1004 * If you are creating a directory rather than an ordinary file.
1005 * If you are taking special precautions as `make-temp-file' does. */)
1009 return make_temp_name (prefix
, 0);
1014 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1015 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1016 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1017 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
1018 the current buffer's value of default-directory is used.
1019 File name components that are `.' are removed, and
1020 so are file name components followed by `..', along with the `..' itself;
1021 note that these simplifications are done without checking the resulting
1022 file names in the file system.
1023 An initial `~/' expands to your home directory.
1024 An initial `~USER/' expands to USER's home directory.
1025 See also the function `substitute-in-file-name'. */)
1026 (name
, default_directory
)
1027 Lisp_Object name
, default_directory
;
1031 register unsigned char *newdir
, *p
, *o
;
1033 unsigned char *target
;
1036 unsigned char * colon
= 0;
1037 unsigned char * close
= 0;
1038 unsigned char * slash
= 0;
1039 unsigned char * brack
= 0;
1040 int lbrack
= 0, rbrack
= 0;
1045 int collapse_newdir
= 1;
1049 Lisp_Object handler
, result
;
1051 CHECK_STRING (name
);
1053 /* If the file name has special constructs in it,
1054 call the corresponding file handler. */
1055 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1056 if (!NILP (handler
))
1057 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1059 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1060 if (NILP (default_directory
))
1061 default_directory
= current_buffer
->directory
;
1062 if (! STRINGP (default_directory
))
1065 /* "/" is not considered a root directory on DOS_NT, so using "/"
1066 here causes an infinite recursion in, e.g., the following:
1068 (let (default-directory)
1069 (expand-file-name "a"))
1071 To avoid this, we set default_directory to the root of the
1073 extern char *emacs_root_dir (void);
1075 default_directory
= build_string (emacs_root_dir ());
1077 default_directory
= build_string ("/");
1081 if (!NILP (default_directory
))
1083 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1084 if (!NILP (handler
))
1085 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1088 o
= SDATA (default_directory
);
1090 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1091 It would be better to do this down below where we actually use
1092 default_directory. Unfortunately, calling Fexpand_file_name recursively
1093 could invoke GC, and the strings might be relocated. This would
1094 be annoying because we have pointers into strings lying around
1095 that would need adjusting, and people would add new pointers to
1096 the code and forget to adjust them, resulting in intermittent bugs.
1097 Putting this call here avoids all that crud.
1099 The EQ test avoids infinite recursion. */
1100 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1101 /* Save time in some common cases - as long as default_directory
1102 is not relative, it can be canonicalized with name below (if it
1103 is needed at all) without requiring it to be expanded now. */
1105 /* Detect MSDOS file names with drive specifiers. */
1106 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1108 /* Detect Windows file names in UNC format. */
1109 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1111 #else /* not DOS_NT */
1112 /* Detect Unix absolute file names (/... alone is not absolute on
1114 && ! (IS_DIRECTORY_SEP (o
[0]))
1115 #endif /* not DOS_NT */
1118 struct gcpro gcpro1
;
1121 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1126 /* Filenames on VMS are always upper case. */
1127 name
= Fupcase (name
);
1129 #ifdef FILE_SYSTEM_CASE
1130 name
= FILE_SYSTEM_CASE (name
);
1136 /* We will force directory separators to be either all \ or /, so make
1137 a local copy to modify, even if there ends up being no change. */
1138 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1140 /* Note if special escape prefix is present, but remove for now. */
1141 if (nm
[0] == '/' && nm
[1] == ':')
1147 /* Find and remove drive specifier if present; this makes nm absolute
1148 even if the rest of the name appears to be relative. Only look for
1149 drive specifier at the beginning. */
1150 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1157 /* If we see "c://somedir", we want to strip the first slash after the
1158 colon when stripping the drive letter. Otherwise, this expands to
1160 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1162 #endif /* WINDOWSNT */
1166 /* Discard any previous drive specifier if nm is now in UNC format. */
1167 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1173 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1174 none are found, we can probably return right away. We will avoid
1175 allocating a new string if name is already fully expanded. */
1177 IS_DIRECTORY_SEP (nm
[0])
1179 && drive
&& !is_escaped
1182 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1189 /* If it turns out that the filename we want to return is just a
1190 suffix of FILENAME, we don't need to go through and edit
1191 things; we just need to construct a new string using data
1192 starting at the middle of FILENAME. If we set lose to a
1193 non-zero value, that means we've discovered that we can't do
1200 /* Since we know the name is absolute, we can assume that each
1201 element starts with a "/". */
1203 /* "." and ".." are hairy. */
1204 if (IS_DIRECTORY_SEP (p
[0])
1206 && (IS_DIRECTORY_SEP (p
[2])
1208 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1211 /* We want to replace multiple `/' in a row with a single
1214 && IS_DIRECTORY_SEP (p
[0])
1215 && IS_DIRECTORY_SEP (p
[1]))
1222 /* if dev:[dir]/, move nm to / */
1223 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1224 nm
= (brack
? brack
+ 1 : colon
+ 1);
1225 lbrack
= rbrack
= 0;
1233 /* VMS pre V4.4,convert '-'s in filenames. */
1234 if (lbrack
== rbrack
)
1236 if (dots
< 2) /* this is to allow negative version numbers */
1241 if (lbrack
> rbrack
&&
1242 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1243 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1249 /* count open brackets, reset close bracket pointer */
1250 if (p
[0] == '[' || p
[0] == '<')
1251 lbrack
++, brack
= 0;
1252 /* count close brackets, set close bracket pointer */
1253 if (p
[0] == ']' || p
[0] == '>')
1254 rbrack
++, brack
= p
;
1255 /* detect ][ or >< */
1256 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1258 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1259 nm
= p
+ 1, lose
= 1;
1260 if (p
[0] == ':' && (colon
|| slash
))
1261 /* if dev1:[dir]dev2:, move nm to dev2: */
1267 /* if /name/dev:, move nm to dev: */
1270 /* if node::dev:, move colon following dev */
1271 else if (colon
&& colon
[-1] == ':')
1273 /* if dev1:dev2:, move nm to dev2: */
1274 else if (colon
&& colon
[-1] != ':')
1279 if (p
[0] == ':' && !colon
)
1285 if (lbrack
== rbrack
)
1288 else if (p
[0] == '.')
1296 if (index (nm
, '/'))
1298 nm
= sys_translate_unix (nm
);
1299 return make_specified_string (nm
, -1, strlen (nm
),
1300 STRING_MULTIBYTE (name
));
1304 /* Make sure directories are all separated with / or \ as
1305 desired, but avoid allocation of a new string when not
1307 CORRECT_DIR_SEPS (nm
);
1309 if (IS_DIRECTORY_SEP (nm
[1]))
1311 if (strcmp (nm
, SDATA (name
)) != 0)
1312 name
= make_specified_string (nm
, -1, strlen (nm
),
1313 STRING_MULTIBYTE (name
));
1317 /* drive must be set, so this is okay */
1318 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1322 name
= make_specified_string (nm
, -1, p
- nm
,
1323 STRING_MULTIBYTE (name
));
1324 temp
[0] = DRIVE_LETTER (drive
);
1325 name
= concat2 (build_string (temp
), name
);
1328 #else /* not DOS_NT */
1329 if (nm
== SDATA (name
))
1331 return make_specified_string (nm
, -1, strlen (nm
),
1332 STRING_MULTIBYTE (name
));
1333 #endif /* not DOS_NT */
1337 /* At this point, nm might or might not be an absolute file name. We
1338 need to expand ~ or ~user if present, otherwise prefix nm with
1339 default_directory if nm is not absolute, and finally collapse /./
1340 and /foo/../ sequences.
1342 We set newdir to be the appropriate prefix if one is needed:
1343 - the relevant user directory if nm starts with ~ or ~user
1344 - the specified drive's working dir (DOS/NT only) if nm does not
1346 - the value of default_directory.
1348 Note that these prefixes are not guaranteed to be absolute (except
1349 for the working dir of a drive). Therefore, to ensure we always
1350 return an absolute name, if the final prefix is not absolute we
1351 append it to the current working directory. */
1355 if (nm
[0] == '~') /* prefix ~ */
1357 if (IS_DIRECTORY_SEP (nm
[1])
1361 || nm
[1] == 0) /* ~ by itself */
1363 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1364 newdir
= (unsigned char *) "";
1367 collapse_newdir
= 0;
1370 nm
++; /* Don't leave the slash in nm. */
1373 else /* ~user/filename */
1375 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1380 o
= (unsigned char *) alloca (p
- nm
+ 1);
1381 bcopy ((char *) nm
, o
, p
- nm
);
1384 pw
= (struct passwd
*) getpwnam (o
+ 1);
1387 newdir
= (unsigned char *) pw
-> pw_dir
;
1389 nm
= p
+ 1; /* skip the terminator */
1393 collapse_newdir
= 0;
1398 /* If we don't find a user of that name, leave the name
1399 unchanged; don't move nm forward to p. */
1404 /* On DOS and Windows, nm is absolute if a drive name was specified;
1405 use the drive's current directory as the prefix if needed. */
1406 if (!newdir
&& drive
)
1408 /* Get default directory if needed to make nm absolute. */
1409 if (!IS_DIRECTORY_SEP (nm
[0]))
1411 newdir
= alloca (MAXPATHLEN
+ 1);
1412 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1417 /* Either nm starts with /, or drive isn't mounted. */
1418 newdir
= alloca (4);
1419 newdir
[0] = DRIVE_LETTER (drive
);
1427 /* Finally, if no prefix has been specified and nm is not absolute,
1428 then it must be expanded relative to default_directory. */
1432 /* /... alone is not absolute on DOS and Windows. */
1433 && !IS_DIRECTORY_SEP (nm
[0])
1436 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1443 newdir
= SDATA (default_directory
);
1445 /* Note if special escape prefix is present, but remove for now. */
1446 if (newdir
[0] == '/' && newdir
[1] == ':')
1457 /* First ensure newdir is an absolute name. */
1459 /* Detect MSDOS file names with drive specifiers. */
1460 ! (IS_DRIVE (newdir
[0])
1461 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1463 /* Detect Windows file names in UNC format. */
1464 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1468 /* Effectively, let newdir be (expand-file-name newdir cwd).
1469 Because of the admonition against calling expand-file-name
1470 when we have pointers into lisp strings, we accomplish this
1471 indirectly by prepending newdir to nm if necessary, and using
1472 cwd (or the wd of newdir's drive) as the new newdir. */
1474 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1479 if (!IS_DIRECTORY_SEP (nm
[0]))
1481 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1482 file_name_as_directory (tmp
, newdir
);
1486 newdir
= alloca (MAXPATHLEN
+ 1);
1489 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1496 /* Strip off drive name from prefix, if present. */
1497 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1503 /* Keep only a prefix from newdir if nm starts with slash
1504 (//server/share for UNC, nothing otherwise). */
1505 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1508 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1510 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1512 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1514 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1526 /* Get rid of any slash at the end of newdir, unless newdir is
1527 just / or // (an incomplete UNC name). */
1528 length
= strlen (newdir
);
1529 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1531 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1535 unsigned char *temp
= (unsigned char *) alloca (length
);
1536 bcopy (newdir
, temp
, length
- 1);
1537 temp
[length
- 1] = 0;
1545 /* Now concatenate the directory and name to new space in the stack frame */
1546 tlen
+= strlen (nm
) + 1;
1548 /* Reserve space for drive specifier and escape prefix, since either
1549 or both may need to be inserted. (The Microsoft x86 compiler
1550 produces incorrect code if the following two lines are combined.) */
1551 target
= (unsigned char *) alloca (tlen
+ 4);
1553 #else /* not DOS_NT */
1554 target
= (unsigned char *) alloca (tlen
);
1555 #endif /* not DOS_NT */
1561 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1564 /* If newdir is effectively "C:/", then the drive letter will have
1565 been stripped and newdir will be "/". Concatenating with an
1566 absolute directory in nm produces "//", which will then be
1567 incorrectly treated as a network share. Ignore newdir in
1568 this case (keeping the drive letter). */
1569 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1570 && newdir
[1] == '\0'))
1572 strcpy (target
, newdir
);
1576 file_name_as_directory (target
, newdir
);
1579 strcat (target
, nm
);
1581 if (index (target
, '/'))
1582 strcpy (target
, sys_translate_unix (target
));
1585 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1587 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1596 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1602 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1603 /* brackets are offset from each other by 2 */
1606 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1607 /* convert [foo][bar] to [bar] */
1608 while (o
[-1] != '[' && o
[-1] != '<')
1610 else if (*p
== '-' && *o
!= '.')
1613 else if (p
[0] == '-' && o
[-1] == '.' &&
1614 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1615 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1619 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1620 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1622 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1624 /* else [foo.-] ==> [-] */
1630 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1631 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1637 if (!IS_DIRECTORY_SEP (*p
))
1641 else if (IS_DIRECTORY_SEP (p
[0])
1643 && (IS_DIRECTORY_SEP (p
[2])
1646 /* If "/." is the entire filename, keep the "/". Otherwise,
1647 just delete the whole "/.". */
1648 if (o
== target
&& p
[2] == '\0')
1652 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1653 /* `/../' is the "superroot" on certain file systems. */
1655 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1657 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1659 /* Keep initial / only if this is the whole name. */
1660 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1665 && IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1]))
1667 /* Collapse multiple `/' in a row. */
1669 while (IS_DIRECTORY_SEP (*p
))
1676 #endif /* not VMS */
1680 /* At last, set drive name. */
1682 /* Except for network file name. */
1683 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1684 #endif /* WINDOWSNT */
1686 if (!drive
) abort ();
1688 target
[0] = DRIVE_LETTER (drive
);
1691 /* Reinsert the escape prefix if required. */
1698 CORRECT_DIR_SEPS (target
);
1701 result
= make_specified_string (target
, -1, o
- target
,
1702 STRING_MULTIBYTE (name
));
1704 /* Again look to see if the file name has special constructs in it
1705 and perhaps call the corresponding file handler. This is needed
1706 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1707 the ".." component gives us "/user@host:/bar/../baz" which needs
1708 to be expanded again. */
1709 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1710 if (!NILP (handler
))
1711 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1717 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1718 This is the old version of expand-file-name, before it was thoroughly
1719 rewritten for Emacs 10.31. We leave this version here commented-out,
1720 because the code is very complex and likely to have subtle bugs. If
1721 bugs _are_ found, it might be of interest to look at the old code and
1722 see what did it do in the relevant situation.
1724 Don't remove this code: it's true that it will be accessible via CVS,
1725 but a few years from deletion, people will forget it is there. */
1727 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1728 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1729 "Convert FILENAME to absolute, and canonicalize it.\n\
1730 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1731 (does not start with slash); if DEFAULT is nil or missing,\n\
1732 the current buffer's value of default-directory is used.\n\
1733 Filenames containing `.' or `..' as components are simplified;\n\
1734 initial `~/' expands to your home directory.\n\
1735 See also the function `substitute-in-file-name'.")
1737 Lisp_Object name
, defalt
;
1741 register unsigned char *newdir
, *p
, *o
;
1743 unsigned char *target
;
1747 unsigned char * colon
= 0;
1748 unsigned char * close
= 0;
1749 unsigned char * slash
= 0;
1750 unsigned char * brack
= 0;
1751 int lbrack
= 0, rbrack
= 0;
1755 CHECK_STRING (name
);
1758 /* Filenames on VMS are always upper case. */
1759 name
= Fupcase (name
);
1764 /* If nm is absolute, flush ...// and detect /./ and /../.
1765 If no /./ or /../ we can return right away. */
1777 if (p
[0] == '/' && p
[1] == '/'
1779 /* // at start of filename is meaningful on Apollo system. */
1784 if (p
[0] == '/' && p
[1] == '~')
1785 nm
= p
+ 1, lose
= 1;
1786 if (p
[0] == '/' && p
[1] == '.'
1787 && (p
[2] == '/' || p
[2] == 0
1788 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1794 /* if dev:[dir]/, move nm to / */
1795 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1796 nm
= (brack
? brack
+ 1 : colon
+ 1);
1797 lbrack
= rbrack
= 0;
1805 /* VMS pre V4.4,convert '-'s in filenames. */
1806 if (lbrack
== rbrack
)
1808 if (dots
< 2) /* this is to allow negative version numbers */
1813 if (lbrack
> rbrack
&&
1814 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1815 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1821 /* count open brackets, reset close bracket pointer */
1822 if (p
[0] == '[' || p
[0] == '<')
1823 lbrack
++, brack
= 0;
1824 /* count close brackets, set close bracket pointer */
1825 if (p
[0] == ']' || p
[0] == '>')
1826 rbrack
++, brack
= p
;
1827 /* detect ][ or >< */
1828 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1830 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1831 nm
= p
+ 1, lose
= 1;
1832 if (p
[0] == ':' && (colon
|| slash
))
1833 /* if dev1:[dir]dev2:, move nm to dev2: */
1839 /* If /name/dev:, move nm to dev: */
1842 /* If node::dev:, move colon following dev */
1843 else if (colon
&& colon
[-1] == ':')
1845 /* If dev1:dev2:, move nm to dev2: */
1846 else if (colon
&& colon
[-1] != ':')
1851 if (p
[0] == ':' && !colon
)
1857 if (lbrack
== rbrack
)
1860 else if (p
[0] == '.')
1868 if (index (nm
, '/'))
1869 return build_string (sys_translate_unix (nm
));
1871 if (nm
== SDATA (name
))
1873 return build_string (nm
);
1877 /* Now determine directory to start with and put it in NEWDIR */
1881 if (nm
[0] == '~') /* prefix ~ */
1886 || nm
[1] == 0)/* ~/filename */
1888 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1889 newdir
= (unsigned char *) "";
1892 nm
++; /* Don't leave the slash in nm. */
1895 else /* ~user/filename */
1897 /* Get past ~ to user */
1898 unsigned char *user
= nm
+ 1;
1899 /* Find end of name. */
1900 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1901 int len
= ptr
? ptr
- user
: strlen (user
);
1903 unsigned char *ptr1
= index (user
, ':');
1904 if (ptr1
!= 0 && ptr1
- user
< len
)
1907 /* Copy the user name into temp storage. */
1908 o
= (unsigned char *) alloca (len
+ 1);
1909 bcopy ((char *) user
, o
, len
);
1912 /* Look up the user name. */
1913 pw
= (struct passwd
*) getpwnam (o
+ 1);
1915 error ("\"%s\" isn't a registered user", o
+ 1);
1917 newdir
= (unsigned char *) pw
->pw_dir
;
1919 /* Discard the user name from NM. */
1926 #endif /* not VMS */
1930 defalt
= current_buffer
->directory
;
1931 CHECK_STRING (defalt
);
1932 newdir
= SDATA (defalt
);
1935 /* Now concatenate the directory and name to new space in the stack frame */
1937 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1938 target
= (unsigned char *) alloca (tlen
);
1944 if (nm
[0] == 0 || nm
[0] == '/')
1945 strcpy (target
, newdir
);
1948 file_name_as_directory (target
, newdir
);
1951 strcat (target
, nm
);
1953 if (index (target
, '/'))
1954 strcpy (target
, sys_translate_unix (target
));
1957 /* Now canonicalize by removing /. and /foo/.. if they appear */
1965 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1971 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1972 /* brackets are offset from each other by 2 */
1975 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1976 /* convert [foo][bar] to [bar] */
1977 while (o
[-1] != '[' && o
[-1] != '<')
1979 else if (*p
== '-' && *o
!= '.')
1982 else if (p
[0] == '-' && o
[-1] == '.' &&
1983 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1984 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1988 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1989 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1991 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1993 /* else [foo.-] ==> [-] */
1999 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
2000 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2010 else if (!strncmp (p
, "//", 2)
2012 /* // at start of filename is meaningful in Apollo system. */
2020 else if (p
[0] == '/' && p
[1] == '.' &&
2021 (p
[2] == '/' || p
[2] == 0))
2023 else if (!strncmp (p
, "/..", 3)
2024 /* `/../' is the "superroot" on certain file systems. */
2026 && (p
[3] == '/' || p
[3] == 0))
2028 while (o
!= target
&& *--o
!= '/')
2031 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2035 if (o
== target
&& *o
== '/')
2043 #endif /* not VMS */
2046 return make_string (target
, o
- target
);
2050 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2051 Ssubstitute_in_file_name
, 1, 1, 0,
2052 doc
: /* Substitute environment variables referred to in FILENAME.
2053 `$FOO' where FOO is an environment variable name means to substitute
2054 the value of that variable. The variable name should be terminated
2055 with a character not a letter, digit or underscore; otherwise, enclose
2056 the entire variable name in braces.
2057 If `/~' appears, all of FILENAME through that `/' is discarded.
2059 On VMS, `$' substitution is not done; this function does little and only
2060 duplicates what `expand-file-name' does. */)
2062 Lisp_Object filename
;
2066 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2067 unsigned char *target
= NULL
;
2069 int substituted
= 0;
2072 Lisp_Object handler
;
2074 CHECK_STRING (filename
);
2076 /* If the file name has special constructs in it,
2077 call the corresponding file handler. */
2078 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2079 if (!NILP (handler
))
2080 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2082 nm
= SDATA (filename
);
2084 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2085 CORRECT_DIR_SEPS (nm
);
2086 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2088 endp
= nm
+ SBYTES (filename
);
2090 /* If /~ or // appears, discard everything through first slash. */
2092 for (p
= nm
; p
!= endp
; p
++)
2095 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2096 /* // at start of file name is meaningful in Apollo,
2097 WindowsNT and Cygwin systems. */
2098 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
2099 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2100 || IS_DIRECTORY_SEP (p
[0])
2101 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2106 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2108 || IS_DIRECTORY_SEP (p
[-1])))
2110 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2115 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2117 o
= (unsigned char *) alloca (s
- p
+ 1);
2118 bcopy ((char *) p
, o
, s
- p
);
2121 pw
= (struct passwd
*) getpwnam (o
+ 1);
2123 /* If we have ~/ or ~user and `user' exists, discard
2124 everything up to ~. But if `user' does not exist, leave
2125 ~user alone, it might be a literal file name. */
2126 if (IS_DIRECTORY_SEP (p
[0]) || s
== p
+ 1 || pw
)
2133 /* see comment in expand-file-name about drive specifiers */
2134 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2135 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
2144 return make_specified_string (nm
, -1, strlen (nm
),
2145 STRING_MULTIBYTE (filename
));
2148 /* See if any variables are substituted into the string
2149 and find the total length of their values in `total' */
2151 for (p
= nm
; p
!= endp
;)
2161 /* "$$" means a single "$" */
2170 while (p
!= endp
&& *p
!= '}') p
++;
2171 if (*p
!= '}') goto missingclose
;
2177 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2181 /* Copy out the variable name */
2182 target
= (unsigned char *) alloca (s
- o
+ 1);
2183 strncpy (target
, o
, s
- o
);
2186 strupr (target
); /* $home == $HOME etc. */
2189 /* Get variable value */
2190 o
= (unsigned char *) egetenv (target
);
2193 total
+= strlen (o
);
2203 /* If substitution required, recopy the string and do it */
2204 /* Make space in stack frame for the new copy */
2205 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2208 /* Copy the rest of the name through, replacing $ constructs with values */
2225 while (p
!= endp
&& *p
!= '}') p
++;
2226 if (*p
!= '}') goto missingclose
;
2232 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2236 /* Copy out the variable name */
2237 target
= (unsigned char *) alloca (s
- o
+ 1);
2238 strncpy (target
, o
, s
- o
);
2241 strupr (target
); /* $home == $HOME etc. */
2244 /* Get variable value */
2245 o
= (unsigned char *) egetenv (target
);
2249 strcpy (x
, target
); x
+= strlen (target
);
2251 else if (STRING_MULTIBYTE (filename
))
2253 /* If the original string is multibyte,
2254 convert what we substitute into multibyte. */
2257 int c
= unibyte_char_to_multibyte (*o
++);
2258 x
+= CHAR_STRING (c
, x
);
2270 /* If /~ or // appears, discard everything through first slash. */
2272 for (p
= xnm
; p
!= x
; p
++)
2274 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2275 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2276 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2277 || IS_DIRECTORY_SEP (p
[0])
2278 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2280 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2283 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2284 && p
> xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2288 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2291 error ("Bad format environment-variable substitution");
2293 error ("Missing \"}\" in environment-variable substitution");
2295 error ("Substituting nonexistent environment variable \"%s\"", target
);
2298 #endif /* not VMS */
2302 /* A slightly faster and more convenient way to get
2303 (directory-file-name (expand-file-name FOO)). */
2306 expand_and_dir_to_file (filename
, defdir
)
2307 Lisp_Object filename
, defdir
;
2309 register Lisp_Object absname
;
2311 absname
= Fexpand_file_name (filename
, defdir
);
2314 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2315 if (c
== ':' || c
== ']' || c
== '>')
2316 absname
= Fdirectory_file_name (absname
);
2319 /* Remove final slash, if any (unless this is the root dir).
2320 stat behaves differently depending! */
2321 if (SCHARS (absname
) > 1
2322 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2323 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2324 /* We cannot take shortcuts; they might be wrong for magic file names. */
2325 absname
= Fdirectory_file_name (absname
);
2330 /* Signal an error if the file ABSNAME already exists.
2331 If INTERACTIVE is nonzero, ask the user whether to proceed,
2332 and bypass the error if the user says to go ahead.
2333 QUERYSTRING is a name for the action that is being considered
2336 *STATPTR is used to store the stat information if the file exists.
2337 If the file does not exist, STATPTR->st_mode is set to 0.
2338 If STATPTR is null, we don't store into it.
2340 If QUICK is nonzero, we ask for y or n, not yes or no. */
2343 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2344 Lisp_Object absname
;
2345 unsigned char *querystring
;
2347 struct stat
*statptr
;
2350 register Lisp_Object tem
, encoded_filename
;
2351 struct stat statbuf
;
2352 struct gcpro gcpro1
;
2354 encoded_filename
= ENCODE_FILE (absname
);
2356 /* stat is a good way to tell whether the file exists,
2357 regardless of what access permissions it has. */
2358 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
2361 Fsignal (Qfile_already_exists
,
2362 Fcons (build_string ("File already exists"),
2363 Fcons (absname
, Qnil
)));
2365 tem
= format2 ("File %s already exists; %s anyway? ",
2366 absname
, build_string (querystring
));
2368 tem
= Fy_or_n_p (tem
);
2370 tem
= do_yes_or_no_p (tem
);
2373 Fsignal (Qfile_already_exists
,
2374 Fcons (build_string ("File already exists"),
2375 Fcons (absname
, Qnil
)));
2382 statptr
->st_mode
= 0;
2387 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2388 "fCopy file: \nFCopy %s to file: \np\nP",
2389 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2390 If NEWNAME names a directory, copy FILE there.
2391 Signals a `file-already-exists' error if file NEWNAME already exists,
2392 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
2393 A number as third arg means request confirmation if NEWNAME already exists.
2394 This is what happens in interactive use with M-x.
2395 Fourth arg KEEP-TIME non-nil means give the new file the same
2396 last-modified time as the old one. (This works on only some systems.)
2397 A prefix arg makes KEEP-TIME non-nil.
2398 Also set the file modes of the target file to match the source file. */)
2399 (file
, newname
, ok_if_already_exists
, keep_time
)
2400 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2403 char buf
[16 * 1024];
2404 struct stat st
, out_st
;
2405 Lisp_Object handler
;
2406 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2407 int count
= SPECPDL_INDEX ();
2408 int input_file_statable_p
;
2409 Lisp_Object encoded_file
, encoded_newname
;
2411 encoded_file
= encoded_newname
= Qnil
;
2412 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2413 CHECK_STRING (file
);
2414 CHECK_STRING (newname
);
2416 if (!NILP (Ffile_directory_p (newname
)))
2417 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2419 newname
= Fexpand_file_name (newname
, Qnil
);
2421 file
= Fexpand_file_name (file
, Qnil
);
2423 /* If the input file name has special constructs in it,
2424 call the corresponding file handler. */
2425 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2426 /* Likewise for output file name. */
2428 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2429 if (!NILP (handler
))
2430 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2431 ok_if_already_exists
, keep_time
));
2433 encoded_file
= ENCODE_FILE (file
);
2434 encoded_newname
= ENCODE_FILE (newname
);
2436 if (NILP (ok_if_already_exists
)
2437 || INTEGERP (ok_if_already_exists
))
2438 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2439 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2440 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2444 if (!CopyFile (SDATA (encoded_file
),
2445 SDATA (encoded_newname
),
2447 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2448 /* CopyFile retains the timestamp by default. */
2449 else if (NILP (keep_time
))
2455 EMACS_GET_TIME (now
);
2456 filename
= SDATA (encoded_newname
);
2458 /* Ensure file is writable while its modified time is set. */
2459 attributes
= GetFileAttributes (filename
);
2460 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2461 if (set_file_times (filename
, now
, now
))
2463 /* Restore original attributes. */
2464 SetFileAttributes (filename
, attributes
);
2465 Fsignal (Qfile_date_error
,
2466 Fcons (build_string ("Cannot set file date"),
2467 Fcons (newname
, Qnil
)));
2469 /* Restore original attributes. */
2470 SetFileAttributes (filename
, attributes
);
2472 #else /* not WINDOWSNT */
2474 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2478 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2480 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2482 /* We can only copy regular files and symbolic links. Other files are not
2484 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2486 #if !defined (DOS_NT) || __DJGPP__ > 1
2487 if (out_st
.st_mode
!= 0
2488 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2491 report_file_error ("Input and output files are the same",
2492 Fcons (file
, Fcons (newname
, Qnil
)));
2496 #if defined (S_ISREG) && defined (S_ISLNK)
2497 if (input_file_statable_p
)
2499 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2501 #if defined (EISDIR)
2502 /* Get a better looking error message. */
2505 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2508 #endif /* S_ISREG && S_ISLNK */
2511 /* Create the copy file with the same record format as the input file */
2512 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2515 /* System's default file type was set to binary by _fmode in emacs.c. */
2516 ofd
= creat (SDATA (encoded_newname
), S_IREAD
| S_IWRITE
);
2517 #else /* not MSDOS */
2518 ofd
= creat (SDATA (encoded_newname
), 0666);
2519 #endif /* not MSDOS */
2522 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2524 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2528 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2529 if (emacs_write (ofd
, buf
, n
) != n
)
2530 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2533 /* Closing the output clobbers the file times on some systems. */
2534 if (emacs_close (ofd
) < 0)
2535 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2537 if (input_file_statable_p
)
2539 if (!NILP (keep_time
))
2541 EMACS_TIME atime
, mtime
;
2542 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2543 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2544 if (set_file_times (SDATA (encoded_newname
),
2546 Fsignal (Qfile_date_error
,
2547 Fcons (build_string ("Cannot set file date"),
2548 Fcons (newname
, Qnil
)));
2551 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2553 #if defined (__DJGPP__) && __DJGPP__ > 1
2554 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2555 and if it can't, it tells so. Otherwise, under MSDOS we usually
2556 get only the READ bit, which will make the copied file read-only,
2557 so it's better not to chmod at all. */
2558 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2559 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2560 #endif /* DJGPP version 2 or newer */
2565 #endif /* WINDOWSNT */
2567 /* Discard the unwind protects. */
2568 specpdl_ptr
= specpdl
+ count
;
2574 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2575 Smake_directory_internal
, 1, 1, 0,
2576 doc
: /* Create a new directory named DIRECTORY. */)
2578 Lisp_Object directory
;
2580 const unsigned char *dir
;
2581 Lisp_Object handler
;
2582 Lisp_Object encoded_dir
;
2584 CHECK_STRING (directory
);
2585 directory
= Fexpand_file_name (directory
, Qnil
);
2587 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2588 if (!NILP (handler
))
2589 return call2 (handler
, Qmake_directory_internal
, directory
);
2591 encoded_dir
= ENCODE_FILE (directory
);
2593 dir
= SDATA (encoded_dir
);
2596 if (mkdir (dir
) != 0)
2598 if (mkdir (dir
, 0777) != 0)
2600 report_file_error ("Creating directory", Flist (1, &directory
));
2605 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2606 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2608 Lisp_Object directory
;
2610 const unsigned char *dir
;
2611 Lisp_Object handler
;
2612 Lisp_Object encoded_dir
;
2614 CHECK_STRING (directory
);
2615 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2617 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2618 if (!NILP (handler
))
2619 return call2 (handler
, Qdelete_directory
, directory
);
2621 encoded_dir
= ENCODE_FILE (directory
);
2623 dir
= SDATA (encoded_dir
);
2625 if (rmdir (dir
) != 0)
2626 report_file_error ("Removing directory", Flist (1, &directory
));
2631 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2632 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2633 If file has multiple names, it continues to exist with the other names. */)
2635 Lisp_Object filename
;
2637 Lisp_Object handler
;
2638 Lisp_Object encoded_file
;
2639 struct gcpro gcpro1
;
2642 if (!NILP (Ffile_directory_p (filename
))
2643 && NILP (Ffile_symlink_p (filename
)))
2644 Fsignal (Qfile_error
,
2645 Fcons (build_string ("Removing old name: is a directory"),
2646 Fcons (filename
, Qnil
)));
2648 filename
= Fexpand_file_name (filename
, Qnil
);
2650 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2651 if (!NILP (handler
))
2652 return call2 (handler
, Qdelete_file
, filename
);
2654 encoded_file
= ENCODE_FILE (filename
);
2656 if (0 > unlink (SDATA (encoded_file
)))
2657 report_file_error ("Removing old name", Flist (1, &filename
));
2662 internal_delete_file_1 (ignore
)
2668 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2671 internal_delete_file (filename
)
2672 Lisp_Object filename
;
2674 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2675 Qt
, internal_delete_file_1
));
2678 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2679 "fRename file: \nFRename %s to file: \np",
2680 doc
: /* Rename FILE as NEWNAME. Both args strings.
2681 If file has names other than FILE, it continues to have those names.
2682 Signals a `file-already-exists' error if a file NEWNAME already exists
2683 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2684 A number as third arg means request confirmation if NEWNAME already exists.
2685 This is what happens in interactive use with M-x. */)
2686 (file
, newname
, ok_if_already_exists
)
2687 Lisp_Object file
, newname
, ok_if_already_exists
;
2690 Lisp_Object args
[2];
2692 Lisp_Object handler
;
2693 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2694 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2696 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2697 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2698 CHECK_STRING (file
);
2699 CHECK_STRING (newname
);
2700 file
= Fexpand_file_name (file
, Qnil
);
2701 newname
= Fexpand_file_name (newname
, Qnil
);
2703 /* If the file name has special constructs in it,
2704 call the corresponding file handler. */
2705 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2707 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2708 if (!NILP (handler
))
2709 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2710 file
, newname
, ok_if_already_exists
));
2712 encoded_file
= ENCODE_FILE (file
);
2713 encoded_newname
= ENCODE_FILE (newname
);
2716 /* If the file names are identical but for the case, don't ask for
2717 confirmation: they simply want to change the letter-case of the
2719 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2721 if (NILP (ok_if_already_exists
)
2722 || INTEGERP (ok_if_already_exists
))
2723 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2724 INTEGERP (ok_if_already_exists
), 0, 0);
2726 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2728 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2729 || 0 > unlink (SDATA (encoded_file
)))
2735 symlink_target
= Ffile_symlink_p (file
);
2736 if (! NILP (symlink_target
))
2737 Fmake_symbolic_link (symlink_target
, newname
,
2738 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2741 Fcopy_file (file
, newname
,
2742 /* We have already prompted if it was an integer,
2743 so don't have copy-file prompt again. */
2744 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2745 Fdelete_file (file
);
2752 report_file_error ("Renaming", Flist (2, args
));
2755 report_file_error ("Renaming", Flist (2, &file
));
2762 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2763 "fAdd name to file: \nFName to add to %s: \np",
2764 doc
: /* Give FILE additional name NEWNAME. Both args strings.
2765 Signals a `file-already-exists' error if a file NEWNAME already exists
2766 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2767 A number as third arg means request confirmation if NEWNAME already exists.
2768 This is what happens in interactive use with M-x. */)
2769 (file
, newname
, ok_if_already_exists
)
2770 Lisp_Object file
, newname
, ok_if_already_exists
;
2773 Lisp_Object args
[2];
2775 Lisp_Object handler
;
2776 Lisp_Object encoded_file
, encoded_newname
;
2777 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2779 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2780 encoded_file
= encoded_newname
= Qnil
;
2781 CHECK_STRING (file
);
2782 CHECK_STRING (newname
);
2783 file
= Fexpand_file_name (file
, Qnil
);
2784 newname
= Fexpand_file_name (newname
, Qnil
);
2786 /* If the file name has special constructs in it,
2787 call the corresponding file handler. */
2788 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2789 if (!NILP (handler
))
2790 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2791 newname
, ok_if_already_exists
));
2793 /* If the new name has special constructs in it,
2794 call the corresponding file handler. */
2795 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2796 if (!NILP (handler
))
2797 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2798 newname
, ok_if_already_exists
));
2800 encoded_file
= ENCODE_FILE (file
);
2801 encoded_newname
= ENCODE_FILE (newname
);
2803 if (NILP (ok_if_already_exists
)
2804 || INTEGERP (ok_if_already_exists
))
2805 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2806 INTEGERP (ok_if_already_exists
), 0, 0);
2808 unlink (SDATA (newname
));
2809 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2814 report_file_error ("Adding new name", Flist (2, args
));
2816 report_file_error ("Adding new name", Flist (2, &file
));
2825 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2826 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2827 doc
: /* Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2828 Signals a `file-already-exists' error if a file LINKNAME already exists
2829 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2830 A number as third arg means request confirmation if LINKNAME already exists.
2831 This happens for interactive use with M-x. */)
2832 (filename
, linkname
, ok_if_already_exists
)
2833 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2836 Lisp_Object args
[2];
2838 Lisp_Object handler
;
2839 Lisp_Object encoded_filename
, encoded_linkname
;
2840 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2842 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2843 encoded_filename
= encoded_linkname
= Qnil
;
2844 CHECK_STRING (filename
);
2845 CHECK_STRING (linkname
);
2846 /* If the link target has a ~, we must expand it to get
2847 a truly valid file name. Otherwise, do not expand;
2848 we want to permit links to relative file names. */
2849 if (SREF (filename
, 0) == '~')
2850 filename
= Fexpand_file_name (filename
, Qnil
);
2851 linkname
= Fexpand_file_name (linkname
, Qnil
);
2853 /* If the file name has special constructs in it,
2854 call the corresponding file handler. */
2855 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2856 if (!NILP (handler
))
2857 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2858 linkname
, ok_if_already_exists
));
2860 /* If the new link name has special constructs in it,
2861 call the corresponding file handler. */
2862 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2863 if (!NILP (handler
))
2864 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2865 linkname
, ok_if_already_exists
));
2867 encoded_filename
= ENCODE_FILE (filename
);
2868 encoded_linkname
= ENCODE_FILE (linkname
);
2870 if (NILP (ok_if_already_exists
)
2871 || INTEGERP (ok_if_already_exists
))
2872 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2873 INTEGERP (ok_if_already_exists
), 0, 0);
2874 if (0 > symlink (SDATA (encoded_filename
),
2875 SDATA (encoded_linkname
)))
2877 /* If we didn't complain already, silently delete existing file. */
2878 if (errno
== EEXIST
)
2880 unlink (SDATA (encoded_linkname
));
2881 if (0 <= symlink (SDATA (encoded_filename
),
2882 SDATA (encoded_linkname
)))
2892 report_file_error ("Making symbolic link", Flist (2, args
));
2894 report_file_error ("Making symbolic link", Flist (2, &filename
));
2900 #endif /* S_IFLNK */
2904 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2905 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2906 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2907 If STRING is nil or a null string, the logical name NAME is deleted. */)
2912 CHECK_STRING (name
);
2914 delete_logical_name (SDATA (name
));
2917 CHECK_STRING (string
);
2919 if (SCHARS (string
) == 0)
2920 delete_logical_name (SDATA (name
));
2922 define_logical_name (SDATA (name
), SDATA (string
));
2931 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2932 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2934 Lisp_Object path
, login
;
2938 CHECK_STRING (path
);
2939 CHECK_STRING (login
);
2941 netresult
= netunam (SDATA (path
), SDATA (login
));
2943 if (netresult
== -1)
2948 #endif /* HPUX_NET */
2950 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2952 doc
: /* Return t if file FILENAME specifies an absolute file name.
2953 On Unix, this is a name starting with a `/' or a `~'. */)
2955 Lisp_Object filename
;
2957 const unsigned char *ptr
;
2959 CHECK_STRING (filename
);
2960 ptr
= SDATA (filename
);
2961 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2963 /* ??? This criterion is probably wrong for '<'. */
2964 || index (ptr
, ':') || index (ptr
, '<')
2965 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2969 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2977 /* Return nonzero if file FILENAME exists and can be executed. */
2980 check_executable (filename
)
2984 int len
= strlen (filename
);
2987 if (stat (filename
, &st
) < 0)
2989 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2990 return ((st
.st_mode
& S_IEXEC
) != 0);
2992 return (S_ISREG (st
.st_mode
)
2994 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2995 || stricmp (suffix
, ".exe") == 0
2996 || stricmp (suffix
, ".bat") == 0)
2997 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2998 #endif /* not WINDOWSNT */
2999 #else /* not DOS_NT */
3000 #ifdef HAVE_EUIDACCESS
3001 return (euidaccess (filename
, 1) >= 0);
3003 /* Access isn't quite right because it uses the real uid
3004 and we really want to test with the effective uid.
3005 But Unix doesn't give us a right way to do it. */
3006 return (access (filename
, 1) >= 0);
3008 #endif /* not DOS_NT */
3011 /* Return nonzero if file FILENAME exists and can be written. */
3014 check_writable (filename
)
3019 if (stat (filename
, &st
) < 0)
3021 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3022 #else /* not MSDOS */
3023 #ifdef HAVE_EUIDACCESS
3024 return (euidaccess (filename
, 2) >= 0);
3026 /* Access isn't quite right because it uses the real uid
3027 and we really want to test with the effective uid.
3028 But Unix doesn't give us a right way to do it.
3029 Opening with O_WRONLY could work for an ordinary file,
3030 but would lose for directories. */
3031 return (access (filename
, 2) >= 0);
3033 #endif /* not MSDOS */
3036 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3037 doc
: /* Return t if file FILENAME exists. (This does not mean you can read it.)
3038 See also `file-readable-p' and `file-attributes'. */)
3040 Lisp_Object filename
;
3042 Lisp_Object absname
;
3043 Lisp_Object handler
;
3044 struct stat statbuf
;
3046 CHECK_STRING (filename
);
3047 absname
= Fexpand_file_name (filename
, Qnil
);
3049 /* If the file name has special constructs in it,
3050 call the corresponding file handler. */
3051 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3052 if (!NILP (handler
))
3053 return call2 (handler
, Qfile_exists_p
, absname
);
3055 absname
= ENCODE_FILE (absname
);
3057 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3060 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3061 doc
: /* Return t if FILENAME can be executed by you.
3062 For a directory, this means you can access files in that directory. */)
3064 Lisp_Object filename
;
3066 Lisp_Object absname
;
3067 Lisp_Object handler
;
3069 CHECK_STRING (filename
);
3070 absname
= Fexpand_file_name (filename
, Qnil
);
3072 /* If the file name has special constructs in it,
3073 call the corresponding file handler. */
3074 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3075 if (!NILP (handler
))
3076 return call2 (handler
, Qfile_executable_p
, absname
);
3078 absname
= ENCODE_FILE (absname
);
3080 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3083 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3084 doc
: /* Return t if file FILENAME exists and you can read it.
3085 See also `file-exists-p' and `file-attributes'. */)
3087 Lisp_Object filename
;
3089 Lisp_Object absname
;
3090 Lisp_Object handler
;
3093 struct stat statbuf
;
3095 CHECK_STRING (filename
);
3096 absname
= Fexpand_file_name (filename
, Qnil
);
3098 /* If the file name has special constructs in it,
3099 call the corresponding file handler. */
3100 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3101 if (!NILP (handler
))
3102 return call2 (handler
, Qfile_readable_p
, absname
);
3104 absname
= ENCODE_FILE (absname
);
3106 #if defined(DOS_NT) || defined(macintosh)
3107 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3109 if (access (SDATA (absname
), 0) == 0)
3112 #else /* not DOS_NT and not macintosh */
3114 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3115 /* Opening a fifo without O_NONBLOCK can wait.
3116 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3117 except in the case of a fifo, on a system which handles it. */
3118 desc
= stat (SDATA (absname
), &statbuf
);
3121 if (S_ISFIFO (statbuf
.st_mode
))
3122 flags
|= O_NONBLOCK
;
3124 desc
= emacs_open (SDATA (absname
), flags
, 0);
3129 #endif /* not DOS_NT and not macintosh */
3132 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3134 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3135 doc
: /* Return t if file FILENAME can be written or created by you. */)
3137 Lisp_Object filename
;
3139 Lisp_Object absname
, dir
, encoded
;
3140 Lisp_Object handler
;
3141 struct stat statbuf
;
3143 CHECK_STRING (filename
);
3144 absname
= Fexpand_file_name (filename
, Qnil
);
3146 /* If the file name has special constructs in it,
3147 call the corresponding file handler. */
3148 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3149 if (!NILP (handler
))
3150 return call2 (handler
, Qfile_writable_p
, absname
);
3152 encoded
= ENCODE_FILE (absname
);
3153 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3154 return (check_writable (SDATA (encoded
))
3157 dir
= Ffile_name_directory (absname
);
3160 dir
= Fdirectory_file_name (dir
);
3164 dir
= Fdirectory_file_name (dir
);
3167 dir
= ENCODE_FILE (dir
);
3169 /* The read-only attribute of the parent directory doesn't affect
3170 whether a file or directory can be created within it. Some day we
3171 should check ACLs though, which do affect this. */
3172 if (stat (SDATA (dir
), &statbuf
) < 0)
3174 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3176 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3181 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3182 doc
: /* Access file FILENAME, and get an error if that does not work.
3183 The second argument STRING is used in the error message.
3184 If there is no error, we return nil. */)
3186 Lisp_Object filename
, string
;
3188 Lisp_Object handler
, encoded_filename
, absname
;
3191 CHECK_STRING (filename
);
3192 absname
= Fexpand_file_name (filename
, Qnil
);
3194 CHECK_STRING (string
);
3196 /* If the file name has special constructs in it,
3197 call the corresponding file handler. */
3198 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3199 if (!NILP (handler
))
3200 return call3 (handler
, Qaccess_file
, absname
, string
);
3202 encoded_filename
= ENCODE_FILE (absname
);
3204 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3206 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3212 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3213 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3214 The value is the link target, as a string.
3215 Otherwise returns nil. */)
3217 Lisp_Object filename
;
3219 Lisp_Object handler
;
3221 CHECK_STRING (filename
);
3222 filename
= Fexpand_file_name (filename
, Qnil
);
3224 /* If the file name has special constructs in it,
3225 call the corresponding file handler. */
3226 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3227 if (!NILP (handler
))
3228 return call2 (handler
, Qfile_symlink_p
, filename
);
3237 filename
= ENCODE_FILE (filename
);
3244 buf
= (char *) xrealloc (buf
, bufsize
);
3245 bzero (buf
, bufsize
);
3248 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3252 /* HP-UX reports ERANGE if buffer is too small. */
3253 if (errno
== ERANGE
)
3263 while (valsize
>= bufsize
);
3265 val
= make_string (buf
, valsize
);
3266 if (buf
[0] == '/' && index (buf
, ':'))
3267 val
= concat2 (build_string ("/:"), val
);
3269 val
= DECODE_FILE (val
);
3272 #else /* not S_IFLNK */
3274 #endif /* not S_IFLNK */
3277 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3278 doc
: /* Return t if FILENAME names an existing directory.
3279 Symbolic links to directories count as directories.
3280 See `file-symlink-p' to distinguish symlinks. */)
3282 Lisp_Object filename
;
3284 register Lisp_Object absname
;
3286 Lisp_Object handler
;
3288 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3290 /* If the file name has special constructs in it,
3291 call the corresponding file handler. */
3292 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3293 if (!NILP (handler
))
3294 return call2 (handler
, Qfile_directory_p
, absname
);
3296 absname
= ENCODE_FILE (absname
);
3298 if (stat (SDATA (absname
), &st
) < 0)
3300 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3303 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3304 doc
: /* Return t if file FILENAME names a directory you can open.
3305 For the value to be t, FILENAME must specify the name of a directory as a file,
3306 and the directory must allow you to open files in it. In order to use a
3307 directory as a buffer's current directory, this predicate must return true.
3308 A directory name spec may be given instead; then the value is t
3309 if the directory so specified exists and really is a readable and
3310 searchable directory. */)
3312 Lisp_Object filename
;
3314 Lisp_Object handler
;
3316 struct gcpro gcpro1
;
3318 /* If the file name has special constructs in it,
3319 call the corresponding file handler. */
3320 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3321 if (!NILP (handler
))
3322 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3325 tem
= (NILP (Ffile_directory_p (filename
))
3326 || NILP (Ffile_executable_p (filename
)));
3328 return tem
? Qnil
: Qt
;
3331 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3332 doc
: /* Return t if file FILENAME is the name of a regular file.
3333 This is the sort of file that holds an ordinary stream of data bytes. */)
3335 Lisp_Object filename
;
3337 register Lisp_Object absname
;
3339 Lisp_Object handler
;
3341 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3343 /* If the file name has special constructs in it,
3344 call the corresponding file handler. */
3345 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3346 if (!NILP (handler
))
3347 return call2 (handler
, Qfile_regular_p
, absname
);
3349 absname
= ENCODE_FILE (absname
);
3354 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3356 /* Tell stat to use expensive method to get accurate info. */
3357 Vw32_get_true_file_attributes
= Qt
;
3358 result
= stat (SDATA (absname
), &st
);
3359 Vw32_get_true_file_attributes
= tem
;
3363 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3366 if (stat (SDATA (absname
), &st
) < 0)
3368 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3372 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3373 doc
: /* Return mode bits of file named FILENAME, as an integer.
3374 Return nil, if file does not exist or is not accessible. */)
3376 Lisp_Object filename
;
3378 Lisp_Object absname
;
3380 Lisp_Object handler
;
3382 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3384 /* If the file name has special constructs in it,
3385 call the corresponding file handler. */
3386 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3387 if (!NILP (handler
))
3388 return call2 (handler
, Qfile_modes
, absname
);
3390 absname
= ENCODE_FILE (absname
);
3392 if (stat (SDATA (absname
), &st
) < 0)
3394 #if defined (MSDOS) && __DJGPP__ < 2
3395 if (check_executable (SDATA (absname
)))
3396 st
.st_mode
|= S_IEXEC
;
3397 #endif /* MSDOS && __DJGPP__ < 2 */
3399 return make_number (st
.st_mode
& 07777);
3402 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3403 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3404 Only the 12 low bits of MODE are used. */)
3406 Lisp_Object filename
, mode
;
3408 Lisp_Object absname
, encoded_absname
;
3409 Lisp_Object handler
;
3411 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3412 CHECK_NUMBER (mode
);
3414 /* If the file name has special constructs in it,
3415 call the corresponding file handler. */
3416 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3417 if (!NILP (handler
))
3418 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3420 encoded_absname
= ENCODE_FILE (absname
);
3422 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3423 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3428 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3429 doc
: /* Set the file permission bits for newly created files.
3430 The argument MODE should be an integer; only the low 9 bits are used.
3431 This setting is inherited by subprocesses. */)
3435 CHECK_NUMBER (mode
);
3437 umask ((~ XINT (mode
)) & 0777);
3442 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3443 doc
: /* Return the default file protection for created files.
3444 The value is an integer. */)
3450 realmask
= umask (0);
3453 XSETINT (value
, (~ realmask
) & 0777);
3457 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3459 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3460 doc
: /* Set times of file FILENAME to TIME.
3461 Set both access and modification times.
3462 Return t on success, else nil.
3463 Use the current time if TIME is nil. TIME is in the format of
3466 Lisp_Object filename
, time
;
3468 Lisp_Object absname
, encoded_absname
;
3469 Lisp_Object handler
;
3473 if (! lisp_time_argument (time
, &sec
, &usec
))
3474 error ("Invalid time specification");
3476 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3478 /* If the file name has special constructs in it,
3479 call the corresponding file handler. */
3480 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3481 if (!NILP (handler
))
3482 return call3 (handler
, Qset_file_times
, absname
, time
);
3484 encoded_absname
= ENCODE_FILE (absname
);
3489 EMACS_SET_SECS (t
, sec
);
3490 EMACS_SET_USECS (t
, usec
);
3492 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3497 /* Setting times on a directory always fails. */
3498 if (stat (SDATA (encoded_absname
), &st
) == 0
3499 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3502 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3515 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3516 doc
: /* Tell Unix to finish all pending disk updates. */)
3525 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3526 doc
: /* Return t if file FILE1 is newer than file FILE2.
3527 If FILE1 does not exist, the answer is nil;
3528 otherwise, if FILE2 does not exist, the answer is t. */)
3530 Lisp_Object file1
, file2
;
3532 Lisp_Object absname1
, absname2
;
3535 Lisp_Object handler
;
3536 struct gcpro gcpro1
, gcpro2
;
3538 CHECK_STRING (file1
);
3539 CHECK_STRING (file2
);
3542 GCPRO2 (absname1
, file2
);
3543 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3544 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3547 /* If the file name has special constructs in it,
3548 call the corresponding file handler. */
3549 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3551 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3552 if (!NILP (handler
))
3553 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3555 GCPRO2 (absname1
, absname2
);
3556 absname1
= ENCODE_FILE (absname1
);
3557 absname2
= ENCODE_FILE (absname2
);
3560 if (stat (SDATA (absname1
), &st
) < 0)
3563 mtime1
= st
.st_mtime
;
3565 if (stat (SDATA (absname2
), &st
) < 0)
3568 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3572 Lisp_Object Qfind_buffer_file_type
;
3575 #ifndef READ_BUF_SIZE
3576 #define READ_BUF_SIZE (64 << 10)
3579 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3581 /* This function is called after Lisp functions to decide a coding
3582 system are called, or when they cause an error. Before they are
3583 called, the current buffer is set unibyte and it contains only a
3584 newly inserted text (thus the buffer was empty before the
3587 The functions may set markers, overlays, text properties, or even
3588 alter the buffer contents, change the current buffer.
3590 Here, we reset all those changes by:
3591 o set back the current buffer.
3592 o move all markers and overlays to BEG.
3593 o remove all text properties.
3594 o set back the buffer multibyteness. */
3597 decide_coding_unwind (unwind_data
)
3598 Lisp_Object unwind_data
;
3600 Lisp_Object multibyte
, undo_list
, buffer
;
3602 multibyte
= XCAR (unwind_data
);
3603 unwind_data
= XCDR (unwind_data
);
3604 undo_list
= XCAR (unwind_data
);
3605 buffer
= XCDR (unwind_data
);
3607 if (current_buffer
!= XBUFFER (buffer
))
3608 set_buffer_internal (XBUFFER (buffer
));
3609 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3610 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3611 BUF_INTERVALS (current_buffer
) = 0;
3612 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3614 /* Now we are safe to change the buffer's multibyteness directly. */
3615 current_buffer
->enable_multibyte_characters
= multibyte
;
3616 current_buffer
->undo_list
= undo_list
;
3622 /* Used to pass values from insert-file-contents to read_non_regular. */
3624 static int non_regular_fd
;
3625 static int non_regular_inserted
;
3626 static int non_regular_nbytes
;
3629 /* Read from a non-regular file.
3630 Read non_regular_trytry bytes max from non_regular_fd.
3631 Non_regular_inserted specifies where to put the read bytes.
3632 Value is the number of bytes read. */
3641 nbytes
= emacs_read (non_regular_fd
,
3642 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3643 non_regular_nbytes
);
3645 return make_number (nbytes
);
3649 /* Condition-case handler used when reading from non-regular files
3650 in insert-file-contents. */
3653 read_non_regular_quit ()
3659 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3661 doc
: /* Insert contents of file FILENAME after point.
3662 Returns list of absolute file name and number of characters inserted.
3663 If second argument VISIT is non-nil, the buffer's visited filename
3664 and last save file modtime are set, and it is marked unmodified.
3665 If visiting and the file does not exist, visiting is completed
3666 before the error is signaled.
3667 The optional third and fourth arguments BEG and END
3668 specify what portion of the file to insert.
3669 These arguments count bytes in the file, not characters in the buffer.
3670 If VISIT is non-nil, BEG and END must be nil.
3672 If optional fifth argument REPLACE is non-nil,
3673 it means replace the current buffer contents (in the accessible portion)
3674 with the file contents. This is better than simply deleting and inserting
3675 the whole thing because (1) it preserves some marker positions
3676 and (2) it puts less data in the undo list.
3677 When REPLACE is non-nil, the value is the number of characters actually read,
3678 which is often less than the number of characters to be read.
3680 This does code conversion according to the value of
3681 `coding-system-for-read' or `file-coding-system-alist',
3682 and sets the variable `last-coding-system-used' to the coding system
3684 (filename
, visit
, beg
, end
, replace
)
3685 Lisp_Object filename
, visit
, beg
, end
, replace
;
3690 register int how_much
;
3691 register int unprocessed
;
3692 int count
= SPECPDL_INDEX ();
3693 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3694 Lisp_Object handler
, val
, insval
, orig_filename
;
3697 int not_regular
= 0;
3698 unsigned char read_buf
[READ_BUF_SIZE
];
3699 struct coding_system coding
;
3700 unsigned char buffer
[1 << 14];
3701 int replace_handled
= 0;
3702 int set_coding_system
= 0;
3703 int coding_system_decided
= 0;
3706 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3707 error ("Cannot do file visiting in an indirect buffer");
3709 if (!NILP (current_buffer
->read_only
))
3710 Fbarf_if_buffer_read_only ();
3714 orig_filename
= Qnil
;
3716 GCPRO4 (filename
, val
, p
, orig_filename
);
3718 CHECK_STRING (filename
);
3719 filename
= Fexpand_file_name (filename
, Qnil
);
3721 /* If the file name has special constructs in it,
3722 call the corresponding file handler. */
3723 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3724 if (!NILP (handler
))
3726 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3727 visit
, beg
, end
, replace
);
3728 if (CONSP (val
) && CONSP (XCDR (val
)))
3729 inserted
= XINT (XCAR (XCDR (val
)));
3733 orig_filename
= filename
;
3734 filename
= ENCODE_FILE (filename
);
3740 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3742 /* Tell stat to use expensive method to get accurate info. */
3743 Vw32_get_true_file_attributes
= Qt
;
3744 total
= stat (SDATA (filename
), &st
);
3745 Vw32_get_true_file_attributes
= tem
;
3750 if (stat (SDATA (filename
), &st
) < 0)
3752 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3753 || fstat (fd
, &st
) < 0)
3754 #endif /* not APOLLO */
3755 #endif /* WINDOWSNT */
3757 if (fd
>= 0) emacs_close (fd
);
3760 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3763 if (!NILP (Vcoding_system_for_read
))
3764 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3769 /* This code will need to be changed in order to work on named
3770 pipes, and it's probably just not worth it. So we should at
3771 least signal an error. */
3772 if (!S_ISREG (st
.st_mode
))
3779 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3780 Fsignal (Qfile_error
,
3781 Fcons (build_string ("not a regular file"),
3782 Fcons (orig_filename
, Qnil
)));
3787 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3790 /* Replacement should preserve point as it preserves markers. */
3791 if (!NILP (replace
))
3792 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3794 record_unwind_protect (close_file_unwind
, make_number (fd
));
3796 /* Supposedly happens on VMS. */
3797 /* Can happen on any platform that uses long as type of off_t, but allows
3798 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3799 give a message suitable for the latter case. */
3800 if (! not_regular
&& st
.st_size
< 0)
3801 error ("Maximum buffer size exceeded");
3803 /* Prevent redisplay optimizations. */
3804 current_buffer
->clip_changed
= 1;
3808 if (!NILP (beg
) || !NILP (end
))
3809 error ("Attempt to visit less than an entire file");
3810 if (BEG
< Z
&& NILP (replace
))
3811 error ("Cannot do file visiting in a non-empty buffer");
3817 XSETFASTINT (beg
, 0);
3825 XSETINT (end
, st
.st_size
);
3827 /* Arithmetic overflow can occur if an Emacs integer cannot
3828 represent the file size, or if the calculations below
3829 overflow. The calculations below double the file size
3830 twice, so check that it can be multiplied by 4 safely. */
3831 if (XINT (end
) != st
.st_size
3832 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3833 error ("Maximum buffer size exceeded");
3835 /* The file size returned from stat may be zero, but data
3836 may be readable nonetheless, for example when this is a
3837 file in the /proc filesystem. */
3838 if (st
.st_size
== 0)
3839 XSETINT (end
, READ_BUF_SIZE
);
3843 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3845 /* We use emacs-mule for auto saving... */
3846 setup_coding_system (Qemacs_mule
, &coding
);
3847 /* ... but with the special flag to indicate to read in a
3848 multibyte sequence for eight-bit-control char as is. */
3850 coding
.src_multibyte
= 0;
3851 coding
.dst_multibyte
3852 = !NILP (current_buffer
->enable_multibyte_characters
);
3853 coding
.eol_type
= CODING_EOL_LF
;
3854 coding_system_decided
= 1;
3858 /* Decide the coding system to use for reading the file now
3859 because we can't use an optimized method for handling
3860 `coding:' tag if the current buffer is not empty. */
3864 if (!NILP (Vcoding_system_for_read
))
3865 val
= Vcoding_system_for_read
;
3866 else if (! NILP (replace
))
3867 /* In REPLACE mode, we can use the same coding system
3868 that was used to visit the file. */
3869 val
= current_buffer
->buffer_file_coding_system
;
3872 /* Don't try looking inside a file for a coding system
3873 specification if it is not seekable. */
3874 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3876 /* Find a coding system specified in the heading two
3877 lines or in the tailing several lines of the file.
3878 We assume that the 1K-byte and 3K-byte for heading
3879 and tailing respectively are sufficient for this
3883 if (st
.st_size
<= (1024 * 4))
3884 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3887 nread
= emacs_read (fd
, read_buf
, 1024);
3890 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3891 report_file_error ("Setting file position",
3892 Fcons (orig_filename
, Qnil
));
3893 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3898 error ("IO error reading %s: %s",
3899 SDATA (orig_filename
), emacs_strerror (errno
));
3902 struct buffer
*prev
= current_buffer
;
3906 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3908 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3909 buf
= XBUFFER (buffer
);
3911 delete_all_overlays (buf
);
3912 buf
->directory
= current_buffer
->directory
;
3913 buf
->read_only
= Qnil
;
3914 buf
->filename
= Qnil
;
3915 buf
->undo_list
= Qt
;
3916 eassert (buf
->overlays_before
== NULL
);
3917 eassert (buf
->overlays_after
== NULL
);
3919 set_buffer_internal (buf
);
3921 buf
->enable_multibyte_characters
= Qnil
;
3923 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3924 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3925 val
= call2 (Vset_auto_coding_function
,
3926 filename
, make_number (nread
));
3927 set_buffer_internal (prev
);
3929 /* Discard the unwind protect for recovering the
3933 /* Rewind the file for the actual read done later. */
3934 if (lseek (fd
, 0, 0) < 0)
3935 report_file_error ("Setting file position",
3936 Fcons (orig_filename
, Qnil
));
3942 /* If we have not yet decided a coding system, check
3943 file-coding-system-alist. */
3944 Lisp_Object args
[6], coding_systems
;
3946 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3947 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3948 coding_systems
= Ffind_operation_coding_system (6, args
);
3949 if (CONSP (coding_systems
))
3950 val
= XCAR (coding_systems
);
3954 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3955 /* Ensure we set Vlast_coding_system_used. */
3956 set_coding_system
= 1;
3958 if (NILP (current_buffer
->enable_multibyte_characters
)
3960 /* We must suppress all character code conversion except for
3961 end-of-line conversion. */
3962 setup_raw_text_coding_system (&coding
);
3964 coding
.src_multibyte
= 0;
3965 coding
.dst_multibyte
3966 = !NILP (current_buffer
->enable_multibyte_characters
);
3967 coding_system_decided
= 1;
3970 /* If requested, replace the accessible part of the buffer
3971 with the file contents. Avoid replacing text at the
3972 beginning or end of the buffer that matches the file contents;
3973 that preserves markers pointing to the unchanged parts.
3975 Here we implement this feature in an optimized way
3976 for the case where code conversion is NOT needed.
3977 The following if-statement handles the case of conversion
3978 in a less optimal way.
3980 If the code conversion is "automatic" then we try using this
3981 method and hope for the best.
3982 But if we discover the need for conversion, we give up on this method
3983 and let the following if-statement handle the replace job. */
3986 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
3988 /* same_at_start and same_at_end count bytes,
3989 because file access counts bytes
3990 and BEG and END count bytes. */
3991 int same_at_start
= BEGV_BYTE
;
3992 int same_at_end
= ZV_BYTE
;
3994 /* There is still a possibility we will find the need to do code
3995 conversion. If that happens, we set this variable to 1 to
3996 give up on handling REPLACE in the optimized way. */
3997 int giveup_match_end
= 0;
3999 if (XINT (beg
) != 0)
4001 if (lseek (fd
, XINT (beg
), 0) < 0)
4002 report_file_error ("Setting file position",
4003 Fcons (orig_filename
, Qnil
));
4008 /* Count how many chars at the start of the file
4009 match the text at the beginning of the buffer. */
4014 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4016 error ("IO error reading %s: %s",
4017 SDATA (orig_filename
), emacs_strerror (errno
));
4018 else if (nread
== 0)
4021 if (coding
.type
== coding_type_undecided
)
4022 detect_coding (&coding
, buffer
, nread
);
4023 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
4024 /* We found that the file should be decoded somehow.
4025 Let's give up here. */
4027 giveup_match_end
= 1;
4031 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
4032 detect_eol (&coding
, buffer
, nread
);
4033 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
4034 && coding
.eol_type
!= CODING_EOL_LF
)
4035 /* We found that the format of eol should be decoded.
4036 Let's give up here. */
4038 giveup_match_end
= 1;
4043 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4044 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4045 same_at_start
++, bufpos
++;
4046 /* If we found a discrepancy, stop the scan.
4047 Otherwise loop around and scan the next bufferful. */
4048 if (bufpos
!= nread
)
4052 /* If the file matches the buffer completely,
4053 there's no need to replace anything. */
4054 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4058 /* Truncate the buffer to the size of the file. */
4059 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4064 /* Count how many chars at the end of the file
4065 match the text at the end of the buffer. But, if we have
4066 already found that decoding is necessary, don't waste time. */
4067 while (!giveup_match_end
)
4069 int total_read
, nread
, bufpos
, curpos
, trial
;
4071 /* At what file position are we now scanning? */
4072 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4073 /* If the entire file matches the buffer tail, stop the scan. */
4076 /* How much can we scan in the next step? */
4077 trial
= min (curpos
, sizeof buffer
);
4078 if (lseek (fd
, curpos
- trial
, 0) < 0)
4079 report_file_error ("Setting file position",
4080 Fcons (orig_filename
, Qnil
));
4082 total_read
= nread
= 0;
4083 while (total_read
< trial
)
4085 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4087 error ("IO error reading %s: %s",
4088 SDATA (orig_filename
), emacs_strerror (errno
));
4089 else if (nread
== 0)
4091 total_read
+= nread
;
4094 /* Scan this bufferful from the end, comparing with
4095 the Emacs buffer. */
4096 bufpos
= total_read
;
4098 /* Compare with same_at_start to avoid counting some buffer text
4099 as matching both at the file's beginning and at the end. */
4100 while (bufpos
> 0 && same_at_end
> same_at_start
4101 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4102 same_at_end
--, bufpos
--;
4104 /* If we found a discrepancy, stop the scan.
4105 Otherwise loop around and scan the preceding bufferful. */
4108 /* If this discrepancy is because of code conversion,
4109 we cannot use this method; giveup and try the other. */
4110 if (same_at_end
> same_at_start
4111 && FETCH_BYTE (same_at_end
- 1) >= 0200
4112 && ! NILP (current_buffer
->enable_multibyte_characters
)
4113 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4114 giveup_match_end
= 1;
4123 if (! giveup_match_end
)
4127 /* We win! We can handle REPLACE the optimized way. */
4129 /* Extend the start of non-matching text area to multibyte
4130 character boundary. */
4131 if (! NILP (current_buffer
->enable_multibyte_characters
))
4132 while (same_at_start
> BEGV_BYTE
4133 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4136 /* Extend the end of non-matching text area to multibyte
4137 character boundary. */
4138 if (! NILP (current_buffer
->enable_multibyte_characters
))
4139 while (same_at_end
< ZV_BYTE
4140 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4143 /* Don't try to reuse the same piece of text twice. */
4144 overlap
= (same_at_start
- BEGV_BYTE
4145 - (same_at_end
+ st
.st_size
- ZV
));
4147 same_at_end
+= overlap
;
4149 /* Arrange to read only the nonmatching middle part of the file. */
4150 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4151 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4153 del_range_byte (same_at_start
, same_at_end
, 0);
4154 /* Insert from the file at the proper position. */
4155 temp
= BYTE_TO_CHAR (same_at_start
);
4156 SET_PT_BOTH (temp
, same_at_start
);
4158 /* If display currently starts at beginning of line,
4159 keep it that way. */
4160 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4161 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4163 replace_handled
= 1;
4167 /* If requested, replace the accessible part of the buffer
4168 with the file contents. Avoid replacing text at the
4169 beginning or end of the buffer that matches the file contents;
4170 that preserves markers pointing to the unchanged parts.
4172 Here we implement this feature for the case where code conversion
4173 is needed, in a simple way that needs a lot of memory.
4174 The preceding if-statement handles the case of no conversion
4175 in a more optimized way. */
4176 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4178 int same_at_start
= BEGV_BYTE
;
4179 int same_at_end
= ZV_BYTE
;
4182 /* Make sure that the gap is large enough. */
4183 int bufsize
= 2 * st
.st_size
;
4184 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4187 /* First read the whole file, performing code conversion into
4188 CONVERSION_BUFFER. */
4190 if (lseek (fd
, XINT (beg
), 0) < 0)
4192 xfree (conversion_buffer
);
4193 report_file_error ("Setting file position",
4194 Fcons (orig_filename
, Qnil
));
4197 total
= st
.st_size
; /* Total bytes in the file. */
4198 how_much
= 0; /* Bytes read from file so far. */
4199 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4200 unprocessed
= 0; /* Bytes not processed in previous loop. */
4202 while (how_much
< total
)
4204 /* try is reserved in some compilers (Microsoft C) */
4205 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4206 unsigned char *destination
= read_buf
+ unprocessed
;
4209 /* Allow quitting out of the actual I/O. */
4212 this = emacs_read (fd
, destination
, trytry
);
4215 if (this < 0 || this + unprocessed
== 0)
4223 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4225 int require
, result
;
4227 this += unprocessed
;
4229 /* If we are using more space than estimated,
4230 make CONVERSION_BUFFER bigger. */
4231 require
= decoding_buffer_size (&coding
, this);
4232 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4234 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4235 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4238 /* Convert this batch with results in CONVERSION_BUFFER. */
4239 if (how_much
>= total
) /* This is the last block. */
4240 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4241 if (coding
.composing
!= COMPOSITION_DISABLED
)
4242 coding_allocate_composition_data (&coding
, BEGV
);
4243 result
= decode_coding (&coding
, read_buf
,
4244 conversion_buffer
+ inserted
,
4245 this, bufsize
- inserted
);
4247 /* Save for next iteration whatever we didn't convert. */
4248 unprocessed
= this - coding
.consumed
;
4249 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4250 if (!NILP (current_buffer
->enable_multibyte_characters
))
4251 this = coding
.produced
;
4253 this = str_as_unibyte (conversion_buffer
+ inserted
,
4260 /* At this point, INSERTED is how many characters (i.e. bytes)
4261 are present in CONVERSION_BUFFER.
4262 HOW_MUCH should equal TOTAL,
4263 or should be <= 0 if we couldn't read the file. */
4267 xfree (conversion_buffer
);
4268 coding_free_composition_data (&coding
);
4270 error ("IO error reading %s: %s",
4271 SDATA (orig_filename
), emacs_strerror (errno
));
4272 else if (how_much
== -2)
4273 error ("maximum buffer size exceeded");
4276 /* Compare the beginning of the converted file
4277 with the buffer text. */
4280 while (bufpos
< inserted
&& same_at_start
< same_at_end
4281 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4282 same_at_start
++, bufpos
++;
4284 /* If the file matches the buffer completely,
4285 there's no need to replace anything. */
4287 if (bufpos
== inserted
)
4289 xfree (conversion_buffer
);
4290 coding_free_composition_data (&coding
);
4293 /* Truncate the buffer to the size of the file. */
4294 del_range_byte (same_at_start
, same_at_end
, 0);
4299 /* Extend the start of non-matching text area to multibyte
4300 character boundary. */
4301 if (! NILP (current_buffer
->enable_multibyte_characters
))
4302 while (same_at_start
> BEGV_BYTE
4303 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4306 /* Scan this bufferful from the end, comparing with
4307 the Emacs buffer. */
4310 /* Compare with same_at_start to avoid counting some buffer text
4311 as matching both at the file's beginning and at the end. */
4312 while (bufpos
> 0 && same_at_end
> same_at_start
4313 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4314 same_at_end
--, bufpos
--;
4316 /* Extend the end of non-matching text area to multibyte
4317 character boundary. */
4318 if (! NILP (current_buffer
->enable_multibyte_characters
))
4319 while (same_at_end
< ZV_BYTE
4320 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4323 /* Don't try to reuse the same piece of text twice. */
4324 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4326 same_at_end
+= overlap
;
4328 /* If display currently starts at beginning of line,
4329 keep it that way. */
4330 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4331 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4333 /* Replace the chars that we need to replace,
4334 and update INSERTED to equal the number of bytes
4335 we are taking from the file. */
4336 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4338 if (same_at_end
!= same_at_start
)
4340 del_range_byte (same_at_start
, same_at_end
, 0);
4342 same_at_start
= GPT_BYTE
;
4346 temp
= BYTE_TO_CHAR (same_at_start
);
4348 /* Insert from the file at the proper position. */
4349 SET_PT_BOTH (temp
, same_at_start
);
4350 insert_1 (conversion_buffer
+ same_at_start
- BEGV_BYTE
, inserted
,
4352 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4353 coding_restore_composition (&coding
, Fcurrent_buffer ());
4354 coding_free_composition_data (&coding
);
4356 /* Set `inserted' to the number of inserted characters. */
4357 inserted
= PT
- temp
;
4359 xfree (conversion_buffer
);
4368 register Lisp_Object temp
;
4370 total
= XINT (end
) - XINT (beg
);
4372 /* Make sure point-max won't overflow after this insertion. */
4373 XSETINT (temp
, total
);
4374 if (total
!= XINT (temp
))
4375 error ("Maximum buffer size exceeded");
4378 /* For a special file, all we can do is guess. */
4379 total
= READ_BUF_SIZE
;
4381 if (NILP (visit
) && total
> 0)
4382 prepare_to_modify_buffer (PT
, PT
, NULL
);
4385 if (GAP_SIZE
< total
)
4386 make_gap (total
- GAP_SIZE
);
4388 if (XINT (beg
) != 0 || !NILP (replace
))
4390 if (lseek (fd
, XINT (beg
), 0) < 0)
4391 report_file_error ("Setting file position",
4392 Fcons (orig_filename
, Qnil
));
4395 /* In the following loop, HOW_MUCH contains the total bytes read so
4396 far for a regular file, and not changed for a special file. But,
4397 before exiting the loop, it is set to a negative value if I/O
4401 /* Total bytes inserted. */
4404 /* Here, we don't do code conversion in the loop. It is done by
4405 code_convert_region after all data are read into the buffer. */
4407 int gap_size
= GAP_SIZE
;
4409 while (how_much
< total
)
4411 /* try is reserved in some compilers (Microsoft C) */
4412 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4419 /* Maybe make more room. */
4420 if (gap_size
< trytry
)
4422 make_gap (total
- gap_size
);
4423 gap_size
= GAP_SIZE
;
4426 /* Read from the file, capturing `quit'. When an
4427 error occurs, end the loop, and arrange for a quit
4428 to be signaled after decoding the text we read. */
4429 non_regular_fd
= fd
;
4430 non_regular_inserted
= inserted
;
4431 non_regular_nbytes
= trytry
;
4432 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4433 read_non_regular_quit
);
4444 /* Allow quitting out of the actual I/O. We don't make text
4445 part of the buffer until all the reading is done, so a C-g
4446 here doesn't do any harm. */
4449 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4461 /* For a regular file, where TOTAL is the real size,
4462 count HOW_MUCH to compare with it.
4463 For a special file, where TOTAL is just a buffer size,
4464 so don't bother counting in HOW_MUCH.
4465 (INSERTED is where we count the number of characters inserted.) */
4472 /* Make the text read part of the buffer. */
4473 GAP_SIZE
-= inserted
;
4475 GPT_BYTE
+= inserted
;
4477 ZV_BYTE
+= inserted
;
4482 /* Put an anchor to ensure multi-byte form ends at gap. */
4487 /* Discard the unwind protect for closing the file. */
4491 error ("IO error reading %s: %s",
4492 SDATA (orig_filename
), emacs_strerror (errno
));
4496 if (! coding_system_decided
)
4498 /* The coding system is not yet decided. Decide it by an
4499 optimized method for handling `coding:' tag.
4501 Note that we can get here only if the buffer was empty
4502 before the insertion. */
4506 if (!NILP (Vcoding_system_for_read
))
4507 val
= Vcoding_system_for_read
;
4510 /* Since we are sure that the current buffer was empty
4511 before the insertion, we can toggle
4512 enable-multibyte-characters directly here without taking
4513 care of marker adjustment and byte combining problem. By
4514 this way, we can run Lisp program safely before decoding
4515 the inserted text. */
4516 Lisp_Object unwind_data
;
4517 int count
= SPECPDL_INDEX ();
4519 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4520 Fcons (current_buffer
->undo_list
,
4521 Fcurrent_buffer ()));
4522 current_buffer
->enable_multibyte_characters
= Qnil
;
4523 current_buffer
->undo_list
= Qt
;
4524 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4526 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4528 val
= call2 (Vset_auto_coding_function
,
4529 filename
, make_number (inserted
));
4534 /* If the coding system is not yet decided, check
4535 file-coding-system-alist. */
4536 Lisp_Object args
[6], coding_systems
;
4538 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4539 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4540 coding_systems
= Ffind_operation_coding_system (6, args
);
4541 if (CONSP (coding_systems
))
4542 val
= XCAR (coding_systems
);
4545 unbind_to (count
, Qnil
);
4546 inserted
= Z_BYTE
- BEG_BYTE
;
4549 /* The following kludgy code is to avoid some compiler bug.
4551 setup_coding_system (val, &coding);
4554 struct coding_system temp_coding
;
4555 setup_coding_system (val
, &temp_coding
);
4556 bcopy (&temp_coding
, &coding
, sizeof coding
);
4558 /* Ensure we set Vlast_coding_system_used. */
4559 set_coding_system
= 1;
4561 if (NILP (current_buffer
->enable_multibyte_characters
)
4563 /* We must suppress all character code conversion except for
4564 end-of-line conversion. */
4565 setup_raw_text_coding_system (&coding
);
4566 coding
.src_multibyte
= 0;
4567 coding
.dst_multibyte
4568 = !NILP (current_buffer
->enable_multibyte_characters
);
4572 /* Can't do this if part of the buffer might be preserved. */
4574 && (coding
.type
== coding_type_no_conversion
4575 || coding
.type
== coding_type_raw_text
))
4577 /* Visiting a file with these coding system makes the buffer
4579 current_buffer
->enable_multibyte_characters
= Qnil
;
4580 coding
.dst_multibyte
= 0;
4583 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4585 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4587 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4589 inserted
= coding
.produced_char
;
4592 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4596 /* Now INSERTED is measured in characters. */
4599 /* Use the conversion type to determine buffer-file-type
4600 (find-buffer-file-type is now used to help determine the
4602 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4603 || coding
.eol_type
== CODING_EOL_LF
)
4604 && ! CODING_REQUIRE_DECODING (&coding
))
4605 current_buffer
->buffer_file_type
= Qt
;
4607 current_buffer
->buffer_file_type
= Qnil
;
4614 if (!EQ (current_buffer
->undo_list
, Qt
))
4615 current_buffer
->undo_list
= Qnil
;
4617 stat (SDATA (filename
), &st
);
4622 current_buffer
->modtime
= st
.st_mtime
;
4623 current_buffer
->filename
= orig_filename
;
4626 SAVE_MODIFF
= MODIFF
;
4627 current_buffer
->auto_save_modified
= MODIFF
;
4628 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4629 #ifdef CLASH_DETECTION
4632 if (!NILP (current_buffer
->file_truename
))
4633 unlock_file (current_buffer
->file_truename
);
4634 unlock_file (filename
);
4636 #endif /* CLASH_DETECTION */
4638 Fsignal (Qfile_error
,
4639 Fcons (build_string ("not a regular file"),
4640 Fcons (orig_filename
, Qnil
)));
4643 if (set_coding_system
)
4644 Vlast_coding_system_used
= coding
.symbol
;
4646 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4648 insval
= call1 (Qafter_insert_file_set_coding
, make_number (inserted
));
4649 if (! NILP (insval
))
4651 CHECK_NUMBER (insval
);
4652 inserted
= XFASTINT (insval
);
4656 /* Decode file format */
4659 int empty_undo_list_p
= 0;
4661 /* If we're anyway going to discard undo information, don't
4662 record it in the first place. The buffer's undo list at this
4663 point is either nil or t when visiting a file. */
4666 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4667 current_buffer
->undo_list
= Qt
;
4670 insval
= call3 (Qformat_decode
,
4671 Qnil
, make_number (inserted
), visit
);
4672 CHECK_NUMBER (insval
);
4673 inserted
= XFASTINT (insval
);
4676 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4679 /* Call after-change hooks for the inserted text, aside from the case
4680 of normal visiting (not with REPLACE), which is done in a new buffer
4681 "before" the buffer is changed. */
4682 if (inserted
> 0 && total
> 0
4683 && (NILP (visit
) || !NILP (replace
)))
4685 signal_after_change (PT
, 0, inserted
);
4686 update_compositions (PT
, PT
, CHECK_BORDER
);
4689 p
= Vafter_insert_file_functions
;
4692 insval
= call1 (XCAR (p
), make_number (inserted
));
4695 CHECK_NUMBER (insval
);
4696 inserted
= XFASTINT (insval
);
4703 && current_buffer
->modtime
== -1)
4705 /* If visiting nonexistent file, return nil. */
4706 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4710 Fsignal (Qquit
, Qnil
);
4712 /* ??? Retval needs to be dealt with in all cases consistently. */
4714 val
= Fcons (orig_filename
,
4715 Fcons (make_number (inserted
),
4718 RETURN_UNGCPRO (unbind_to (count
, val
));
4721 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4722 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4723 Lisp_Object
, Lisp_Object
));
4725 /* If build_annotations switched buffers, switch back to BUF.
4726 Kill the temporary buffer that was selected in the meantime.
4728 Since this kill only the last temporary buffer, some buffers remain
4729 not killed if build_annotations switched buffers more than once.
4733 build_annotations_unwind (buf
)
4738 if (XBUFFER (buf
) == current_buffer
)
4740 tembuf
= Fcurrent_buffer ();
4742 Fkill_buffer (tembuf
);
4746 /* Decide the coding-system to encode the data with. */
4749 choose_write_coding_system (start
, end
, filename
,
4750 append
, visit
, lockname
, coding
)
4751 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4752 struct coding_system
*coding
;
4757 && NILP (Fstring_equal (current_buffer
->filename
,
4758 current_buffer
->auto_save_file_name
)))
4760 /* We use emacs-mule for auto saving... */
4761 setup_coding_system (Qemacs_mule
, coding
);
4762 /* ... but with the special flag to indicate not to strip off
4763 leading code of eight-bit-control chars. */
4765 goto done_setup_coding
;
4767 else if (!NILP (Vcoding_system_for_write
))
4769 val
= Vcoding_system_for_write
;
4770 if (coding_system_require_warning
4771 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4772 /* Confirm that VAL can surely encode the current region. */
4773 val
= call5 (Vselect_safe_coding_system_function
,
4774 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4779 /* If the variable `buffer-file-coding-system' is set locally,
4780 it means that the file was read with some kind of code
4781 conversion or the variable is explicitly set by users. We
4782 had better write it out with the same coding system even if
4783 `enable-multibyte-characters' is nil.
4785 If it is not set locally, we anyway have to convert EOL
4786 format if the default value of `buffer-file-coding-system'
4787 tells that it is not Unix-like (LF only) format. */
4788 int using_default_coding
= 0;
4789 int force_raw_text
= 0;
4791 val
= current_buffer
->buffer_file_coding_system
;
4793 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4796 if (NILP (current_buffer
->enable_multibyte_characters
))
4802 /* Check file-coding-system-alist. */
4803 Lisp_Object args
[7], coding_systems
;
4805 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4806 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4808 coding_systems
= Ffind_operation_coding_system (7, args
);
4809 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4810 val
= XCDR (coding_systems
);
4814 && !NILP (current_buffer
->buffer_file_coding_system
))
4816 /* If we still have not decided a coding system, use the
4817 default value of buffer-file-coding-system. */
4818 val
= current_buffer
->buffer_file_coding_system
;
4819 using_default_coding
= 1;
4823 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4824 /* Confirm that VAL can surely encode the current region. */
4825 val
= call5 (Vselect_safe_coding_system_function
,
4826 start
, end
, val
, Qnil
, filename
);
4828 setup_coding_system (Fcheck_coding_system (val
), coding
);
4829 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4830 && !using_default_coding
)
4832 if (! EQ (default_buffer_file_coding
.symbol
,
4833 buffer_defaults
.buffer_file_coding_system
))
4834 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4835 &default_buffer_file_coding
);
4836 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4838 Lisp_Object subsidiaries
;
4840 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4841 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4842 if (VECTORP (subsidiaries
)
4843 && XVECTOR (subsidiaries
)->size
== 3)
4845 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4850 setup_raw_text_coding_system (coding
);
4851 goto done_setup_coding
;
4854 setup_coding_system (Fcheck_coding_system (val
), coding
);
4857 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4858 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4861 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4862 "r\nFWrite region to file: \ni\ni\ni\np",
4863 doc
: /* Write current region into specified file.
4864 When called from a program, requires three arguments:
4865 START, END and FILENAME. START and END are normally buffer positions
4866 specifying the part of the buffer to write.
4867 If START is nil, that means to use the entire buffer contents.
4868 If START is a string, then output that string to the file
4869 instead of any buffer contents; END is ignored.
4871 Optional fourth argument APPEND if non-nil means
4872 append to existing file contents (if any). If it is an integer,
4873 seek to that offset in the file before writing.
4874 Optional fifth argument VISIT, if t or a string, means
4875 set the last-save-file-modtime of buffer to this file's modtime
4876 and mark buffer not modified.
4877 If VISIT is a string, it is a second file name;
4878 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4879 VISIT is also the file name to lock and unlock for clash detection.
4880 If VISIT is neither t nor nil nor a string,
4881 that means do not display the \"Wrote file\" message.
4882 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4883 use for locking and unlocking, overriding FILENAME and VISIT.
4884 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4885 for an existing file with the same name. If MUSTBENEW is `excl',
4886 that means to get an error if the file already exists; never overwrite.
4887 If MUSTBENEW is neither nil nor `excl', that means ask for
4888 confirmation before overwriting, but do go ahead and overwrite the file
4889 if the user confirms.
4891 This does code conversion according to the value of
4892 `coding-system-for-write', `buffer-file-coding-system', or
4893 `file-coding-system-alist', and sets the variable
4894 `last-coding-system-used' to the coding system actually used. */)
4895 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4896 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4901 const unsigned char *fn
;
4904 int count
= SPECPDL_INDEX ();
4907 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4909 Lisp_Object handler
;
4910 Lisp_Object visit_file
;
4911 Lisp_Object annotations
;
4912 Lisp_Object encoded_filename
;
4913 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4914 int quietly
= !NILP (visit
);
4915 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4916 struct buffer
*given_buffer
;
4918 int buffer_file_type
= O_BINARY
;
4920 struct coding_system coding
;
4922 if (current_buffer
->base_buffer
&& visiting
)
4923 error ("Cannot do file visiting in an indirect buffer");
4925 if (!NILP (start
) && !STRINGP (start
))
4926 validate_region (&start
, &end
);
4928 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4930 filename
= Fexpand_file_name (filename
, Qnil
);
4932 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4933 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4935 if (STRINGP (visit
))
4936 visit_file
= Fexpand_file_name (visit
, Qnil
);
4938 visit_file
= filename
;
4940 if (NILP (lockname
))
4941 lockname
= visit_file
;
4945 /* If the file name has special constructs in it,
4946 call the corresponding file handler. */
4947 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4948 /* If FILENAME has no handler, see if VISIT has one. */
4949 if (NILP (handler
) && STRINGP (visit
))
4950 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4952 if (!NILP (handler
))
4955 val
= call6 (handler
, Qwrite_region
, start
, end
,
4956 filename
, append
, visit
);
4960 SAVE_MODIFF
= MODIFF
;
4961 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4962 current_buffer
->filename
= visit_file
;
4968 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4970 /* Special kludge to simplify auto-saving. */
4973 XSETFASTINT (start
, BEG
);
4974 XSETFASTINT (end
, Z
);
4978 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4979 count1
= SPECPDL_INDEX ();
4981 given_buffer
= current_buffer
;
4983 if (!STRINGP (start
))
4985 annotations
= build_annotations (start
, end
);
4987 if (current_buffer
!= given_buffer
)
4989 XSETFASTINT (start
, BEGV
);
4990 XSETFASTINT (end
, ZV
);
4996 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4998 /* Decide the coding-system to encode the data with.
4999 We used to make this choice before calling build_annotations, but that
5000 leads to problems when a write-annotate-function takes care of
5001 unsavable chars (as was the case with X-Symbol). */
5002 choose_write_coding_system (start
, end
, filename
,
5003 append
, visit
, lockname
, &coding
);
5004 Vlast_coding_system_used
= coding
.symbol
;
5006 given_buffer
= current_buffer
;
5007 if (! STRINGP (start
))
5009 annotations
= build_annotations_2 (start
, end
,
5010 coding
.pre_write_conversion
, annotations
);
5011 if (current_buffer
!= given_buffer
)
5013 XSETFASTINT (start
, BEGV
);
5014 XSETFASTINT (end
, ZV
);
5018 #ifdef CLASH_DETECTION
5021 #if 0 /* This causes trouble for GNUS. */
5022 /* If we've locked this file for some other buffer,
5023 query before proceeding. */
5024 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5025 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5028 lock_file (lockname
);
5030 #endif /* CLASH_DETECTION */
5032 encoded_filename
= ENCODE_FILE (filename
);
5034 fn
= SDATA (encoded_filename
);
5038 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5039 #else /* not DOS_NT */
5040 desc
= emacs_open (fn
, O_WRONLY
, 0);
5041 #endif /* not DOS_NT */
5043 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5045 if (auto_saving
) /* Overwrite any previous version of autosave file */
5047 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5048 desc
= emacs_open (fn
, O_RDWR
, 0);
5050 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5051 ? SDATA (current_buffer
->filename
) : 0,
5054 else /* Write to temporary name and rename if no errors */
5056 Lisp_Object temp_name
;
5057 temp_name
= Ffile_name_directory (filename
);
5059 if (!NILP (temp_name
))
5061 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5062 build_string ("$$SAVE$$")));
5063 fname
= SDATA (filename
);
5064 fn
= SDATA (temp_name
);
5065 desc
= creat_copy_attrs (fname
, fn
);
5068 /* If we can't open the temporary file, try creating a new
5069 version of the original file. VMS "creat" creates a
5070 new version rather than truncating an existing file. */
5073 desc
= creat (fn
, 0666);
5074 #if 0 /* This can clobber an existing file and fail to replace it,
5075 if the user runs out of space. */
5078 /* We can't make a new version;
5079 try to truncate and rewrite existing version if any. */
5081 desc
= emacs_open (fn
, O_RDWR
, 0);
5087 desc
= creat (fn
, 0666);
5091 desc
= emacs_open (fn
,
5092 O_WRONLY
| O_CREAT
| buffer_file_type
5093 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5094 S_IREAD
| S_IWRITE
);
5095 #else /* not DOS_NT */
5096 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5097 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5098 auto_saving
? auto_save_mode_bits
: 0666);
5099 #endif /* not DOS_NT */
5100 #endif /* not VMS */
5104 #ifdef CLASH_DETECTION
5106 if (!auto_saving
) unlock_file (lockname
);
5108 #endif /* CLASH_DETECTION */
5110 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5113 record_unwind_protect (close_file_unwind
, make_number (desc
));
5115 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5119 if (NUMBERP (append
))
5120 ret
= lseek (desc
, XINT (append
), 1);
5122 ret
= lseek (desc
, 0, 2);
5125 #ifdef CLASH_DETECTION
5126 if (!auto_saving
) unlock_file (lockname
);
5127 #endif /* CLASH_DETECTION */
5129 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5137 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5138 * if we do writes that don't end with a carriage return. Furthermore
5139 * it cannot handle writes of more then 16K. The modified
5140 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5141 * this EXCEPT for the last record (iff it doesn't end with a carriage
5142 * return). This implies that if your buffer doesn't end with a carriage
5143 * return, you get one free... tough. However it also means that if
5144 * we make two calls to sys_write (a la the following code) you can
5145 * get one at the gap as well. The easiest way to fix this (honest)
5146 * is to move the gap to the next newline (or the end of the buffer).
5151 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5152 move_gap (find_next_newline (GPT
, 1));
5154 /* Whether VMS or not, we must move the gap to the next of newline
5155 when we must put designation sequences at beginning of line. */
5156 if (INTEGERP (start
)
5157 && coding
.type
== coding_type_iso2022
5158 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5159 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5161 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5162 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5163 move_gap_both (PT
, PT_BYTE
);
5164 SET_PT_BOTH (opoint
, opoint_byte
);
5171 if (STRINGP (start
))
5173 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5174 &annotations
, &coding
);
5177 else if (XINT (start
) != XINT (end
))
5179 tem
= CHAR_TO_BYTE (XINT (start
));
5181 if (XINT (start
) < GPT
)
5183 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5184 min (GPT
, XINT (end
)) - XINT (start
),
5185 &annotations
, &coding
);
5189 if (XINT (end
) > GPT
&& !failure
)
5191 tem
= max (XINT (start
), GPT
);
5192 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5193 &annotations
, &coding
);
5199 /* If file was empty, still need to write the annotations */
5200 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5201 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5205 if (CODING_REQUIRE_FLUSHING (&coding
)
5206 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5209 /* We have to flush out a data. */
5210 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5211 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5218 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5219 Disk full in NFS may be reported here. */
5220 /* mib says that closing the file will try to write as fast as NFS can do
5221 it, and that means the fsync here is not crucial for autosave files. */
5222 if (!auto_saving
&& fsync (desc
) < 0)
5224 /* If fsync fails with EINTR, don't treat that as serious. */
5226 failure
= 1, save_errno
= errno
;
5230 /* Spurious "file has changed on disk" warnings have been
5231 observed on Suns as well.
5232 It seems that `close' can change the modtime, under nfs.
5234 (This has supposedly been fixed in Sunos 4,
5235 but who knows about all the other machines with NFS?) */
5238 /* On VMS and APOLLO, must do the stat after the close
5239 since closing changes the modtime. */
5242 /* Recall that #if defined does not work on VMS. */
5249 /* NFS can report a write failure now. */
5250 if (emacs_close (desc
) < 0)
5251 failure
= 1, save_errno
= errno
;
5254 /* If we wrote to a temporary name and had no errors, rename to real name. */
5258 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5266 /* Discard the unwind protect for close_file_unwind. */
5267 specpdl_ptr
= specpdl
+ count1
;
5268 /* Restore the original current buffer. */
5269 visit_file
= unbind_to (count
, visit_file
);
5271 #ifdef CLASH_DETECTION
5273 unlock_file (lockname
);
5274 #endif /* CLASH_DETECTION */
5276 /* Do this before reporting IO error
5277 to avoid a "file has changed on disk" warning on
5278 next attempt to save. */
5280 current_buffer
->modtime
= st
.st_mtime
;
5283 error ("IO error writing %s: %s", SDATA (filename
),
5284 emacs_strerror (save_errno
));
5288 SAVE_MODIFF
= MODIFF
;
5289 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5290 current_buffer
->filename
= visit_file
;
5291 update_mode_lines
++;
5296 && ! NILP (Fstring_equal (current_buffer
->filename
,
5297 current_buffer
->auto_save_file_name
)))
5298 SAVE_MODIFF
= MODIFF
;
5304 message_with_string ((INTEGERP (append
)
5314 Lisp_Object
merge ();
5316 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5317 doc
: /* Return t if (car A) is numerically less than (car B). */)
5321 return Flss (Fcar (a
), Fcar (b
));
5324 /* Build the complete list of annotations appropriate for writing out
5325 the text between START and END, by calling all the functions in
5326 write-region-annotate-functions and merging the lists they return.
5327 If one of these functions switches to a different buffer, we assume
5328 that buffer contains altered text. Therefore, the caller must
5329 make sure to restore the current buffer in all cases,
5330 as save-excursion would do. */
5333 build_annotations (start
, end
)
5334 Lisp_Object start
, end
;
5336 Lisp_Object annotations
;
5338 struct gcpro gcpro1
, gcpro2
;
5339 Lisp_Object original_buffer
;
5340 int i
, used_global
= 0;
5342 XSETBUFFER (original_buffer
, current_buffer
);
5345 p
= Vwrite_region_annotate_functions
;
5346 GCPRO2 (annotations
, p
);
5349 struct buffer
*given_buffer
= current_buffer
;
5350 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5351 { /* Use the global value of the hook. */
5354 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5356 p
= Fappend (2, arg
);
5359 Vwrite_region_annotations_so_far
= annotations
;
5360 res
= call2 (XCAR (p
), start
, end
);
5361 /* If the function makes a different buffer current,
5362 assume that means this buffer contains altered text to be output.
5363 Reset START and END from the buffer bounds
5364 and discard all previous annotations because they should have
5365 been dealt with by this function. */
5366 if (current_buffer
!= given_buffer
)
5368 XSETFASTINT (start
, BEGV
);
5369 XSETFASTINT (end
, ZV
);
5372 Flength (res
); /* Check basic validity of return value */
5373 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5377 /* Now do the same for annotation functions implied by the file-format */
5378 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
5379 p
= current_buffer
->auto_save_file_format
;
5381 p
= current_buffer
->file_format
;
5382 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5384 struct buffer
*given_buffer
= current_buffer
;
5386 Vwrite_region_annotations_so_far
= annotations
;
5388 /* Value is either a list of annotations or nil if the function
5389 has written annotations to a temporary buffer, which is now
5391 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5392 original_buffer
, make_number (i
));
5393 if (current_buffer
!= given_buffer
)
5395 XSETFASTINT (start
, BEGV
);
5396 XSETFASTINT (end
, ZV
);
5401 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5409 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5410 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5412 struct gcpro gcpro1
;
5415 GCPRO1 (annotations
);
5416 /* At last, do the same for the function PRE_WRITE_CONVERSION
5417 implied by the current coding-system. */
5418 if (!NILP (pre_write_conversion
))
5420 struct buffer
*given_buffer
= current_buffer
;
5421 Vwrite_region_annotations_so_far
= annotations
;
5422 res
= call2 (pre_write_conversion
, start
, end
);
5424 annotations
= (current_buffer
!= given_buffer
5426 : merge (annotations
, res
, Qcar_less_than_car
));
5433 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5434 If STRING is nil, POS is the character position in the current buffer.
5435 Intersperse with them the annotations from *ANNOT
5436 which fall within the range of POS to POS + NCHARS,
5437 each at its appropriate position.
5439 We modify *ANNOT by discarding elements as we use them up.
5441 The return value is negative in case of system call failure. */
5444 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5447 register int nchars
;
5450 struct coding_system
*coding
;
5454 int lastpos
= pos
+ nchars
;
5456 while (NILP (*annot
) || CONSP (*annot
))
5458 tem
= Fcar_safe (Fcar (*annot
));
5461 nextpos
= XFASTINT (tem
);
5463 /* If there are no more annotations in this range,
5464 output the rest of the range all at once. */
5465 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5466 return e_write (desc
, string
, pos
, lastpos
, coding
);
5468 /* Output buffer text up to the next annotation's position. */
5471 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5475 /* Output the annotation. */
5476 tem
= Fcdr (Fcar (*annot
));
5479 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5482 *annot
= Fcdr (*annot
);
5487 #ifndef WRITE_BUF_SIZE
5488 #define WRITE_BUF_SIZE (16 * 1024)
5491 /* Write text in the range START and END into descriptor DESC,
5492 encoding them with coding system CODING. If STRING is nil, START
5493 and END are character positions of the current buffer, else they
5494 are indexes to the string STRING. */
5497 e_write (desc
, string
, start
, end
, coding
)
5501 struct coding_system
*coding
;
5503 register char *addr
;
5504 register int nbytes
;
5505 char buf
[WRITE_BUF_SIZE
];
5509 coding
->composing
= COMPOSITION_DISABLED
;
5510 if (coding
->composing
!= COMPOSITION_DISABLED
)
5511 coding_save_composition (coding
, start
, end
, string
);
5513 if (STRINGP (string
))
5515 addr
= SDATA (string
);
5516 nbytes
= SBYTES (string
);
5517 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5519 else if (start
< end
)
5521 /* It is assured that the gap is not in the range START and END-1. */
5522 addr
= CHAR_POS_ADDR (start
);
5523 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5524 coding
->src_multibyte
5525 = !NILP (current_buffer
->enable_multibyte_characters
);
5531 coding
->src_multibyte
= 1;
5534 /* We used to have a code for handling selective display here. But,
5535 now it is handled within encode_coding. */
5540 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5541 if (coding
->produced
> 0)
5543 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5544 if (coding
->produced
)
5550 nbytes
-= coding
->consumed
;
5551 addr
+= coding
->consumed
;
5552 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5555 /* The source text ends by an incomplete multibyte form.
5556 There's no way other than write it out as is. */
5557 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5566 start
+= coding
->consumed_char
;
5567 if (coding
->cmp_data
)
5568 coding_adjust_composition_offset (coding
, start
);
5571 if (coding
->cmp_data
)
5572 coding_free_composition_data (coding
);
5577 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5578 Sverify_visited_file_modtime
, 1, 1, 0,
5579 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5580 This means that the file has not been changed since it was visited or saved.
5581 See Info node `(elisp)Modification Time' for more details. */)
5587 Lisp_Object handler
;
5588 Lisp_Object filename
;
5593 if (!STRINGP (b
->filename
)) return Qt
;
5594 if (b
->modtime
== 0) return Qt
;
5596 /* If the file name has special constructs in it,
5597 call the corresponding file handler. */
5598 handler
= Ffind_file_name_handler (b
->filename
,
5599 Qverify_visited_file_modtime
);
5600 if (!NILP (handler
))
5601 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5603 filename
= ENCODE_FILE (b
->filename
);
5605 if (stat (SDATA (filename
), &st
) < 0)
5607 /* If the file doesn't exist now and didn't exist before,
5608 we say that it isn't modified, provided the error is a tame one. */
5609 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5614 if (st
.st_mtime
== b
->modtime
5615 /* If both are positive, accept them if they are off by one second. */
5616 || (st
.st_mtime
> 0 && b
->modtime
> 0
5617 && (st
.st_mtime
== b
->modtime
+ 1
5618 || st
.st_mtime
== b
->modtime
- 1)))
5623 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5624 Sclear_visited_file_modtime
, 0, 0, 0,
5625 doc
: /* Clear out records of last mod time of visited file.
5626 Next attempt to save will certainly not complain of a discrepancy. */)
5629 current_buffer
->modtime
= 0;
5633 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5634 Svisited_file_modtime
, 0, 0, 0,
5635 doc
: /* Return the current buffer's recorded visited file modification time.
5636 The value is a list of the form (HIGH LOW), like the time values
5637 that `file-attributes' returns. If the current buffer has no recorded
5638 file modification time, this function returns 0.
5639 See Info node `(elisp)Modification Time' for more details. */)
5643 tcons
= long_to_cons ((unsigned long) current_buffer
->modtime
);
5645 return list2 (XCAR (tcons
), XCDR (tcons
));
5649 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5650 Sset_visited_file_modtime
, 0, 1, 0,
5651 doc
: /* Update buffer's recorded modification time from the visited file's time.
5652 Useful if the buffer was not read from the file normally
5653 or if the file itself has been changed for some known benign reason.
5654 An argument specifies the modification time value to use
5655 \(instead of that of the visited file), in the form of a list
5656 \(HIGH . LOW) or (HIGH LOW). */)
5658 Lisp_Object time_list
;
5660 if (!NILP (time_list
))
5661 current_buffer
->modtime
= cons_to_long (time_list
);
5664 register Lisp_Object filename
;
5666 Lisp_Object handler
;
5668 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5670 /* If the file name has special constructs in it,
5671 call the corresponding file handler. */
5672 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5673 if (!NILP (handler
))
5674 /* The handler can find the file name the same way we did. */
5675 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5677 filename
= ENCODE_FILE (filename
);
5679 if (stat (SDATA (filename
), &st
) >= 0)
5680 current_buffer
->modtime
= st
.st_mtime
;
5687 auto_save_error (error
)
5690 Lisp_Object args
[3], msg
;
5692 struct gcpro gcpro1
;
5694 ring_bell (XFRAME (selected_frame
));
5696 args
[0] = build_string ("Auto-saving %s: %s");
5697 args
[1] = current_buffer
->name
;
5698 args
[2] = Ferror_message_string (error
);
5699 msg
= Fformat (3, args
);
5701 nbytes
= SBYTES (msg
);
5703 for (i
= 0; i
< 3; ++i
)
5706 message2 (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5708 message2_nolog (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5709 Fsleep_for (make_number (1), Qnil
);
5722 auto_save_mode_bits
= 0666;
5724 /* Get visited file's mode to become the auto save file's mode. */
5725 if (! NILP (current_buffer
->filename
))
5727 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5728 /* But make sure we can overwrite it later! */
5729 auto_save_mode_bits
= st
.st_mode
| 0600;
5730 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5732 /* Remote files don't cooperate with stat. */
5733 auto_save_mode_bits
= XINT (modes
) | 0600;
5737 Fwrite_region (Qnil
, Qnil
,
5738 current_buffer
->auto_save_file_name
,
5739 Qnil
, Qlambda
, Qnil
, Qnil
);
5743 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5748 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5749 | XFASTINT (XCDR (stream
))));
5754 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5757 minibuffer_auto_raise
= XINT (value
);
5762 do_auto_save_make_dir (dir
)
5765 return call2 (Qmake_directory
, dir
, Qt
);
5769 do_auto_save_eh (ignore
)
5775 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5776 doc
: /* Auto-save all buffers that need it.
5777 This is all buffers that have auto-saving enabled
5778 and are changed since last auto-saved.
5779 Auto-saving writes the buffer into a file
5780 so that your editing is not lost if the system crashes.
5781 This file is not the file you visited; that changes only when you save.
5782 Normally we run the normal hook `auto-save-hook' before saving.
5784 A non-nil NO-MESSAGE argument means do not print any message if successful.
5785 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5786 (no_message
, current_only
)
5787 Lisp_Object no_message
, current_only
;
5789 struct buffer
*old
= current_buffer
, *b
;
5790 Lisp_Object tail
, buf
;
5792 int do_handled_files
;
5795 Lisp_Object lispstream
;
5796 int count
= SPECPDL_INDEX ();
5797 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5798 int old_message_p
= 0;
5799 struct gcpro gcpro1
, gcpro2
;
5801 if (max_specpdl_size
< specpdl_size
+ 40)
5802 max_specpdl_size
= specpdl_size
+ 40;
5807 if (NILP (no_message
))
5809 old_message_p
= push_message ();
5810 record_unwind_protect (pop_message_unwind
, Qnil
);
5813 /* Ordinarily don't quit within this function,
5814 but don't make it impossible to quit (in case we get hung in I/O). */
5818 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5819 point to non-strings reached from Vbuffer_alist. */
5821 if (!NILP (Vrun_hooks
))
5822 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5824 if (STRINGP (Vauto_save_list_file_name
))
5826 Lisp_Object listfile
;
5828 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5830 /* Don't try to create the directory when shutting down Emacs,
5831 because creating the directory might signal an error, and
5832 that would leave Emacs in a strange state. */
5833 if (!NILP (Vrun_hooks
))
5837 GCPRO2 (dir
, listfile
);
5838 dir
= Ffile_name_directory (listfile
);
5839 if (NILP (Ffile_directory_p (dir
)))
5840 internal_condition_case_1 (do_auto_save_make_dir
,
5841 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5846 stream
= fopen (SDATA (listfile
), "w");
5849 /* Arrange to close that file whether or not we get an error.
5850 Also reset auto_saving to 0. */
5851 lispstream
= Fcons (Qnil
, Qnil
);
5852 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
5853 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
5864 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5865 record_unwind_protect (do_auto_save_unwind_1
,
5866 make_number (minibuffer_auto_raise
));
5867 minibuffer_auto_raise
= 0;
5870 /* On first pass, save all files that don't have handlers.
5871 On second pass, save all files that do have handlers.
5873 If Emacs is crashing, the handlers may tweak what is causing
5874 Emacs to crash in the first place, and it would be a shame if
5875 Emacs failed to autosave perfectly ordinary files because it
5876 couldn't handle some ange-ftp'd file. */
5878 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5879 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5881 buf
= XCDR (XCAR (tail
));
5884 /* Record all the buffers that have auto save mode
5885 in the special file that lists them. For each of these buffers,
5886 Record visited name (if any) and auto save name. */
5887 if (STRINGP (b
->auto_save_file_name
)
5888 && stream
!= NULL
&& do_handled_files
== 0)
5890 if (!NILP (b
->filename
))
5892 fwrite (SDATA (b
->filename
), 1,
5893 SBYTES (b
->filename
), stream
);
5895 putc ('\n', stream
);
5896 fwrite (SDATA (b
->auto_save_file_name
), 1,
5897 SBYTES (b
->auto_save_file_name
), stream
);
5898 putc ('\n', stream
);
5901 if (!NILP (current_only
)
5902 && b
!= current_buffer
)
5905 /* Don't auto-save indirect buffers.
5906 The base buffer takes care of it. */
5910 /* Check for auto save enabled
5911 and file changed since last auto save
5912 and file changed since last real save. */
5913 if (STRINGP (b
->auto_save_file_name
)
5914 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5915 && b
->auto_save_modified
< BUF_MODIFF (b
)
5916 /* -1 means we've turned off autosaving for a while--see below. */
5917 && XINT (b
->save_length
) >= 0
5918 && (do_handled_files
5919 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5922 EMACS_TIME before_time
, after_time
;
5924 EMACS_GET_TIME (before_time
);
5926 /* If we had a failure, don't try again for 20 minutes. */
5927 if (b
->auto_save_failure_time
>= 0
5928 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5931 if ((XFASTINT (b
->save_length
) * 10
5932 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5933 /* A short file is likely to change a large fraction;
5934 spare the user annoying messages. */
5935 && XFASTINT (b
->save_length
) > 5000
5936 /* These messages are frequent and annoying for `*mail*'. */
5937 && !EQ (b
->filename
, Qnil
)
5938 && NILP (no_message
))
5940 /* It has shrunk too much; turn off auto-saving here. */
5941 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5942 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5944 minibuffer_auto_raise
= 0;
5945 /* Turn off auto-saving until there's a real save,
5946 and prevent any more warnings. */
5947 XSETINT (b
->save_length
, -1);
5948 Fsleep_for (make_number (1), Qnil
);
5951 set_buffer_internal (b
);
5952 if (!auto_saved
&& NILP (no_message
))
5953 message1 ("Auto-saving...");
5954 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5956 b
->auto_save_modified
= BUF_MODIFF (b
);
5957 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5958 set_buffer_internal (old
);
5960 EMACS_GET_TIME (after_time
);
5962 /* If auto-save took more than 60 seconds,
5963 assume it was an NFS failure that got a timeout. */
5964 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5965 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5969 /* Prevent another auto save till enough input events come in. */
5970 record_auto_save ();
5972 if (auto_saved
&& NILP (no_message
))
5976 /* If we are going to restore an old message,
5977 give time to read ours. */
5978 sit_for (1, 0, 0, 0, 0);
5982 /* If we displayed a message and then restored a state
5983 with no message, leave a "done" message on the screen. */
5984 message1 ("Auto-saving...done");
5989 /* This restores the message-stack status. */
5990 unbind_to (count
, Qnil
);
5994 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5995 Sset_buffer_auto_saved
, 0, 0, 0,
5996 doc
: /* Mark current buffer as auto-saved with its current text.
5997 No auto-save file will be written until the buffer changes again. */)
6000 current_buffer
->auto_save_modified
= MODIFF
;
6001 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6002 current_buffer
->auto_save_failure_time
= -1;
6006 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
6007 Sclear_buffer_auto_save_failure
, 0, 0, 0,
6008 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
6011 current_buffer
->auto_save_failure_time
= -1;
6015 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6017 doc
: /* Return t if buffer has been auto-saved since last read in or saved. */)
6020 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6023 /* Reading and completing file names */
6024 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
6026 /* In the string VAL, change each $ to $$ and return the result. */
6029 double_dollars (val
)
6032 register const unsigned char *old
;
6033 register unsigned char *new;
6037 osize
= SBYTES (val
);
6039 /* Count the number of $ characters. */
6040 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
6041 if (*old
++ == '$') count
++;
6045 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
6048 for (n
= osize
; n
> 0; n
--)
6062 read_file_name_cleanup (arg
)
6065 return (current_buffer
->directory
= arg
);
6068 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
6070 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
6071 (string
, dir
, action
)
6072 Lisp_Object string
, dir
, action
;
6073 /* action is nil for complete, t for return list of completions,
6074 lambda for verify final value */
6076 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
6078 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
6080 CHECK_STRING (string
);
6087 /* No need to protect ACTION--we only compare it with t and nil. */
6088 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6090 if (SCHARS (string
) == 0)
6092 if (EQ (action
, Qlambda
))
6100 orig_string
= string
;
6101 string
= Fsubstitute_in_file_name (string
);
6102 changed
= NILP (Fstring_equal (string
, orig_string
));
6103 name
= Ffile_name_nondirectory (string
);
6104 val
= Ffile_name_directory (string
);
6106 realdir
= Fexpand_file_name (val
, realdir
);
6111 specdir
= Ffile_name_directory (string
);
6112 val
= Ffile_name_completion (name
, realdir
);
6117 return double_dollars (string
);
6121 if (!NILP (specdir
))
6122 val
= concat2 (specdir
, val
);
6124 return double_dollars (val
);
6127 #endif /* not VMS */
6131 if (EQ (action
, Qt
))
6133 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6137 if (NILP (Vread_file_name_predicate
)
6138 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6142 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6144 /* Brute-force speed up for directory checking:
6145 Discard strings which don't end in a slash. */
6146 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6148 Lisp_Object tem
= XCAR (all
);
6150 if (STRINGP (tem
) &&
6151 (len
= SCHARS (tem
), len
> 0) &&
6152 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6153 comp
= Fcons (tem
, comp
);
6159 /* Must do it the hard (and slow) way. */
6160 GCPRO3 (all
, comp
, specdir
);
6161 count
= SPECPDL_INDEX ();
6162 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6163 current_buffer
->directory
= realdir
;
6164 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6165 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
6166 comp
= Fcons (XCAR (all
), comp
);
6167 unbind_to (count
, Qnil
);
6170 return Fnreverse (comp
);
6173 /* Only other case actually used is ACTION = lambda */
6175 /* Supposedly this helps commands such as `cd' that read directory names,
6176 but can someone explain how it helps them? -- RMS */
6177 if (SCHARS (name
) == 0)
6180 string
= Fexpand_file_name (string
, dir
);
6181 if (!NILP (Vread_file_name_predicate
))
6182 return call1 (Vread_file_name_predicate
, string
);
6183 return Ffile_exists_p (string
);
6186 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
6187 Snext_read_file_uses_dialog_p
, 0, 0, 0,
6188 doc
: /* Return t if a call to `read-file-name' will use a dialog.
6189 The return value is only relevant for a call to `read-file-name' that happens
6190 before any other event (mouse or keypress) is handeled. */)
6193 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (TARGET_API_MAC_CARBON)
6194 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6203 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6204 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6205 Value is not expanded---you must call `expand-file-name' yourself.
6206 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6207 the same non-empty string that was inserted by this function.
6208 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6209 except that if INITIAL is specified, that combined with DIR is used.)
6210 If the user exits with an empty minibuffer, this function returns
6211 an empty string. (This can only happen if the user erased the
6212 pre-inserted contents or if `insert-default-directory' is nil.)
6213 Fourth arg MUSTMATCH non-nil means require existing file's name.
6214 Non-nil and non-t means also require confirmation after completion.
6215 Fifth arg INITIAL specifies text to start with.
6216 If optional sixth arg PREDICATE is non-nil, possible completions and
6217 the resulting file name must satisfy (funcall PREDICATE NAME).
6218 DIR should be an absolute directory name. It defaults to the value of
6219 `default-directory'.
6221 If this command was invoked with the mouse, use a file dialog box if
6222 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6223 provides a file dialog box.
6225 See also `read-file-name-completion-ignore-case'
6226 and `read-file-name-function'. */)
6227 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6228 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6230 Lisp_Object val
, insdef
, tem
;
6231 struct gcpro gcpro1
, gcpro2
;
6232 register char *homedir
;
6233 Lisp_Object decoded_homedir
;
6234 int replace_in_history
= 0;
6235 int add_to_history
= 0;
6239 dir
= current_buffer
->directory
;
6240 if (NILP (Ffile_name_absolute_p (dir
)))
6241 dir
= Fexpand_file_name (dir
, Qnil
);
6242 if (NILP (default_filename
))
6245 ? Fexpand_file_name (initial
, dir
)
6246 : current_buffer
->filename
);
6248 /* If dir starts with user's homedir, change that to ~. */
6249 homedir
= (char *) egetenv ("HOME");
6251 /* homedir can be NULL in temacs, since Vprocess_environment is not
6252 yet set up. We shouldn't crash in that case. */
6255 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6256 CORRECT_DIR_SEPS (homedir
);
6261 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6264 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6265 SBYTES (decoded_homedir
))
6266 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6268 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6269 dir
= concat2 (build_string ("~"), dir
);
6271 /* Likewise for default_filename. */
6273 && STRINGP (default_filename
)
6274 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6275 SBYTES (decoded_homedir
))
6276 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6279 = Fsubstring (default_filename
,
6280 make_number (SCHARS (decoded_homedir
)), Qnil
);
6281 default_filename
= concat2 (build_string ("~"), default_filename
);
6283 if (!NILP (default_filename
))
6285 CHECK_STRING (default_filename
);
6286 default_filename
= double_dollars (default_filename
);
6289 if (insert_default_directory
&& STRINGP (dir
))
6292 if (!NILP (initial
))
6294 Lisp_Object args
[2], pos
;
6298 insdef
= Fconcat (2, args
);
6299 pos
= make_number (SCHARS (double_dollars (dir
)));
6300 insdef
= Fcons (double_dollars (insdef
), pos
);
6303 insdef
= double_dollars (insdef
);
6305 else if (STRINGP (initial
))
6306 insdef
= Fcons (double_dollars (initial
), make_number (0));
6310 if (!NILP (Vread_file_name_function
))
6312 Lisp_Object args
[7];
6314 GCPRO2 (insdef
, default_filename
);
6315 args
[0] = Vread_file_name_function
;
6318 args
[3] = default_filename
;
6319 args
[4] = mustmatch
;
6321 args
[6] = predicate
;
6322 RETURN_UNGCPRO (Ffuncall (7, args
));
6325 count
= SPECPDL_INDEX ();
6326 specbind (intern ("completion-ignore-case"),
6327 read_file_name_completion_ignore_case
? Qt
: Qnil
);
6328 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6329 specbind (intern ("read-file-name-predicate"),
6330 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6332 GCPRO2 (insdef
, default_filename
);
6334 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (TARGET_API_MAC_CARBON)
6335 if (! NILP (Fnext_read_file_uses_dialog_p ()))
6337 /* If DIR contains a file name, split it. */
6339 file
= Ffile_name_nondirectory (dir
);
6340 if (SCHARS (file
) && NILP (default_filename
))
6342 default_filename
= file
;
6343 dir
= Ffile_name_directory (dir
);
6345 if (!NILP(default_filename
))
6346 default_filename
= Fexpand_file_name (default_filename
, dir
);
6347 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
,
6348 EQ (predicate
, Qfile_directory_p
) ? Qt
: Qnil
);
6353 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6354 dir
, mustmatch
, insdef
,
6355 Qfile_name_history
, default_filename
, Qnil
);
6357 tem
= Fsymbol_value (Qfile_name_history
);
6358 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6359 replace_in_history
= 1;
6361 /* If Fcompleting_read returned the inserted default string itself
6362 (rather than a new string with the same contents),
6363 it has to mean that the user typed RET with the minibuffer empty.
6364 In that case, we really want to return ""
6365 so that commands such as set-visited-file-name can distinguish. */
6366 if (EQ (val
, default_filename
))
6368 /* In this case, Fcompleting_read has not added an element
6369 to the history. Maybe we should. */
6370 if (! replace_in_history
)
6376 unbind_to (count
, Qnil
);
6379 error ("No file name specified");
6381 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6383 if (!NILP (tem
) && !NILP (default_filename
))
6384 val
= default_filename
;
6385 val
= Fsubstitute_in_file_name (val
);
6387 if (replace_in_history
)
6388 /* Replace what Fcompleting_read added to the history
6389 with what we will actually return. */
6391 Lisp_Object val1
= double_dollars (val
);
6392 tem
= Fsymbol_value (Qfile_name_history
);
6393 if (history_delete_duplicates
)
6394 XSETCDR (tem
, Fdelete (val1
, XCDR(tem
)));
6395 XSETCAR (tem
, val1
);
6397 else if (add_to_history
)
6399 /* Add the value to the history--but not if it matches
6400 the last value already there. */
6401 Lisp_Object val1
= double_dollars (val
);
6402 tem
= Fsymbol_value (Qfile_name_history
);
6403 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6405 if (history_delete_duplicates
) tem
= Fdelete (val1
, tem
);
6406 Fset (Qfile_name_history
, Fcons (val1
, tem
));
6417 /* Must be set before any path manipulation is performed. */
6418 XSETFASTINT (Vdirectory_sep_char
, '/');
6425 Qexpand_file_name
= intern ("expand-file-name");
6426 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6427 Qdirectory_file_name
= intern ("directory-file-name");
6428 Qfile_name_directory
= intern ("file-name-directory");
6429 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6430 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6431 Qfile_name_as_directory
= intern ("file-name-as-directory");
6432 Qcopy_file
= intern ("copy-file");
6433 Qmake_directory_internal
= intern ("make-directory-internal");
6434 Qmake_directory
= intern ("make-directory");
6435 Qdelete_directory
= intern ("delete-directory");
6436 Qdelete_file
= intern ("delete-file");
6437 Qrename_file
= intern ("rename-file");
6438 Qadd_name_to_file
= intern ("add-name-to-file");
6439 Qmake_symbolic_link
= intern ("make-symbolic-link");
6440 Qfile_exists_p
= intern ("file-exists-p");
6441 Qfile_executable_p
= intern ("file-executable-p");
6442 Qfile_readable_p
= intern ("file-readable-p");
6443 Qfile_writable_p
= intern ("file-writable-p");
6444 Qfile_symlink_p
= intern ("file-symlink-p");
6445 Qaccess_file
= intern ("access-file");
6446 Qfile_directory_p
= intern ("file-directory-p");
6447 Qfile_regular_p
= intern ("file-regular-p");
6448 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6449 Qfile_modes
= intern ("file-modes");
6450 Qset_file_modes
= intern ("set-file-modes");
6451 Qset_file_times
= intern ("set-file-times");
6452 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6453 Qinsert_file_contents
= intern ("insert-file-contents");
6454 Qwrite_region
= intern ("write-region");
6455 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6456 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6457 Qauto_save_coding
= intern ("auto-save-coding");
6459 staticpro (&Qexpand_file_name
);
6460 staticpro (&Qsubstitute_in_file_name
);
6461 staticpro (&Qdirectory_file_name
);
6462 staticpro (&Qfile_name_directory
);
6463 staticpro (&Qfile_name_nondirectory
);
6464 staticpro (&Qunhandled_file_name_directory
);
6465 staticpro (&Qfile_name_as_directory
);
6466 staticpro (&Qcopy_file
);
6467 staticpro (&Qmake_directory_internal
);
6468 staticpro (&Qmake_directory
);
6469 staticpro (&Qdelete_directory
);
6470 staticpro (&Qdelete_file
);
6471 staticpro (&Qrename_file
);
6472 staticpro (&Qadd_name_to_file
);
6473 staticpro (&Qmake_symbolic_link
);
6474 staticpro (&Qfile_exists_p
);
6475 staticpro (&Qfile_executable_p
);
6476 staticpro (&Qfile_readable_p
);
6477 staticpro (&Qfile_writable_p
);
6478 staticpro (&Qaccess_file
);
6479 staticpro (&Qfile_symlink_p
);
6480 staticpro (&Qfile_directory_p
);
6481 staticpro (&Qfile_regular_p
);
6482 staticpro (&Qfile_accessible_directory_p
);
6483 staticpro (&Qfile_modes
);
6484 staticpro (&Qset_file_modes
);
6485 staticpro (&Qset_file_times
);
6486 staticpro (&Qfile_newer_than_file_p
);
6487 staticpro (&Qinsert_file_contents
);
6488 staticpro (&Qwrite_region
);
6489 staticpro (&Qverify_visited_file_modtime
);
6490 staticpro (&Qset_visited_file_modtime
);
6491 staticpro (&Qauto_save_coding
);
6493 Qfile_name_history
= intern ("file-name-history");
6494 Fset (Qfile_name_history
, Qnil
);
6495 staticpro (&Qfile_name_history
);
6497 Qfile_error
= intern ("file-error");
6498 staticpro (&Qfile_error
);
6499 Qfile_already_exists
= intern ("file-already-exists");
6500 staticpro (&Qfile_already_exists
);
6501 Qfile_date_error
= intern ("file-date-error");
6502 staticpro (&Qfile_date_error
);
6503 Qexcl
= intern ("excl");
6507 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6508 staticpro (&Qfind_buffer_file_type
);
6511 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6512 doc
: /* *Coding system for encoding file names.
6513 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6514 Vfile_name_coding_system
= Qnil
;
6516 DEFVAR_LISP ("default-file-name-coding-system",
6517 &Vdefault_file_name_coding_system
,
6518 doc
: /* Default coding system for encoding file names.
6519 This variable is used only when `file-name-coding-system' is nil.
6521 This variable is set/changed by the command `set-language-environment'.
6522 User should not set this variable manually,
6523 instead use `file-name-coding-system' to get a constant encoding
6524 of file names regardless of the current language environment. */);
6525 Vdefault_file_name_coding_system
= Qnil
;
6527 Qformat_decode
= intern ("format-decode");
6528 staticpro (&Qformat_decode
);
6529 Qformat_annotate_function
= intern ("format-annotate-function");
6530 staticpro (&Qformat_annotate_function
);
6531 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6532 staticpro (&Qafter_insert_file_set_coding
);
6534 Qcar_less_than_car
= intern ("car-less-than-car");
6535 staticpro (&Qcar_less_than_car
);
6537 Fput (Qfile_error
, Qerror_conditions
,
6538 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6539 Fput (Qfile_error
, Qerror_message
,
6540 build_string ("File error"));
6542 Fput (Qfile_already_exists
, Qerror_conditions
,
6543 Fcons (Qfile_already_exists
,
6544 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6545 Fput (Qfile_already_exists
, Qerror_message
,
6546 build_string ("File already exists"));
6548 Fput (Qfile_date_error
, Qerror_conditions
,
6549 Fcons (Qfile_date_error
,
6550 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6551 Fput (Qfile_date_error
, Qerror_message
,
6552 build_string ("Cannot set file date"));
6554 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6555 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6556 Vread_file_name_function
= Qnil
;
6558 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6559 doc
: /* Current predicate used by `read-file-name-internal'. */);
6560 Vread_file_name_predicate
= Qnil
;
6562 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case
,
6563 doc
: /* *Non-nil means when reading a file name completion ignores case. */);
6564 #if defined VMS || defined DOS_NT || defined MAC_OS
6565 read_file_name_completion_ignore_case
= 1;
6567 read_file_name_completion_ignore_case
= 0;
6570 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6571 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6572 If the initial minibuffer contents are non-empty, you can usually
6573 request a default filename by typing RETURN without editing. For some
6574 commands, exiting with an empty minibuffer has a special meaning,
6575 such as making the current buffer visit no file in the case of
6576 `set-visited-file-name'.
6577 If this variable is non-nil, the minibuffer contents are always
6578 initially non-empty and typing RETURN without editing will fetch the
6579 default name, if one is provided. Note however that this default name
6580 is not necessarily the name originally inserted in the minibuffer, if
6581 that is just the default directory.
6582 If this variable is nil, the minibuffer often starts out empty. In
6583 that case you may have to explicitly fetch the next history element to
6584 request the default name. */);
6585 insert_default_directory
= 1;
6587 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6588 doc
: /* *Non-nil means write new files with record format `stmlf'.
6589 nil means use format `var'. This variable is meaningful only on VMS. */);
6590 vms_stmlf_recfm
= 0;
6592 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6593 doc
: /* Directory separator character for built-in functions that return file names.
6594 The value is always ?/. Don't use this variable, just use `/'. */);
6596 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6597 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6598 If a file name matches REGEXP, then all I/O on that file is done by calling
6601 The first argument given to HANDLER is the name of the I/O primitive
6602 to be handled; the remaining arguments are the arguments that were
6603 passed to that primitive. For example, if you do
6604 (file-exists-p FILENAME)
6605 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6606 (funcall HANDLER 'file-exists-p FILENAME)
6607 The function `find-file-name-handler' checks this list for a handler
6608 for its argument. */);
6609 Vfile_name_handler_alist
= Qnil
;
6611 DEFVAR_LISP ("set-auto-coding-function",
6612 &Vset_auto_coding_function
,
6613 doc
: /* If non-nil, a function to call to decide a coding system of file.
6614 Two arguments are passed to this function: the file name
6615 and the length of a file contents following the point.
6616 This function should return a coding system to decode the file contents.
6617 It should check the file name against `auto-coding-alist'.
6618 If no coding system is decided, it should check a coding system
6619 specified in the heading lines with the format:
6620 -*- ... coding: CODING-SYSTEM; ... -*-
6621 or local variable spec of the tailing lines with `coding:' tag. */);
6622 Vset_auto_coding_function
= Qnil
;
6624 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6625 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6626 Each is passed one argument, the number of characters inserted.
6627 It should return the new character count, and leave point the same.
6628 If `insert-file-contents' is intercepted by a handler from
6629 `file-name-handler-alist', that handler is responsible for calling the
6630 functions in `after-insert-file-functions' if appropriate. */);
6631 Vafter_insert_file_functions
= Qnil
;
6633 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6634 doc
: /* A list of functions to be called at the start of `write-region'.
6635 Each is passed two arguments, START and END as for `write-region'.
6636 These are usually two numbers but not always; see the documentation
6637 for `write-region'. The function should return a list of pairs
6638 of the form (POSITION . STRING), consisting of strings to be effectively
6639 inserted at the specified positions of the file being written (1 means to
6640 insert before the first byte written). The POSITIONs must be sorted into
6641 increasing order. If there are several functions in the list, the several
6642 lists are merged destructively. Alternatively, the function can return
6643 with a different buffer current; in that case it should pay attention
6644 to the annotations returned by previous functions and listed in
6645 `write-region-annotations-so-far'.*/);
6646 Vwrite_region_annotate_functions
= Qnil
;
6647 staticpro (&Qwrite_region_annotate_functions
);
6648 Qwrite_region_annotate_functions
6649 = intern ("write-region-annotate-functions");
6651 DEFVAR_LISP ("write-region-annotations-so-far",
6652 &Vwrite_region_annotations_so_far
,
6653 doc
: /* When an annotation function is called, this holds the previous annotations.
6654 These are the annotations made by other annotation functions
6655 that were already called. See also `write-region-annotate-functions'. */);
6656 Vwrite_region_annotations_so_far
= Qnil
;
6658 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6659 doc
: /* A list of file name handlers that temporarily should not be used.
6660 This applies only to the operation `inhibit-file-name-operation'. */);
6661 Vinhibit_file_name_handlers
= Qnil
;
6663 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6664 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6665 Vinhibit_file_name_operation
= Qnil
;
6667 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6668 doc
: /* File name in which we write a list of all auto save file names.
6669 This variable is initialized automatically from `auto-save-list-file-prefix'
6670 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6671 a non-nil value. */);
6672 Vauto_save_list_file_name
= Qnil
;
6674 defsubr (&Sfind_file_name_handler
);
6675 defsubr (&Sfile_name_directory
);
6676 defsubr (&Sfile_name_nondirectory
);
6677 defsubr (&Sunhandled_file_name_directory
);
6678 defsubr (&Sfile_name_as_directory
);
6679 defsubr (&Sdirectory_file_name
);
6680 defsubr (&Smake_temp_name
);
6681 defsubr (&Sexpand_file_name
);
6682 defsubr (&Ssubstitute_in_file_name
);
6683 defsubr (&Scopy_file
);
6684 defsubr (&Smake_directory_internal
);
6685 defsubr (&Sdelete_directory
);
6686 defsubr (&Sdelete_file
);
6687 defsubr (&Srename_file
);
6688 defsubr (&Sadd_name_to_file
);
6690 defsubr (&Smake_symbolic_link
);
6691 #endif /* S_IFLNK */
6693 defsubr (&Sdefine_logical_name
);
6696 defsubr (&Ssysnetunam
);
6697 #endif /* HPUX_NET */
6698 defsubr (&Sfile_name_absolute_p
);
6699 defsubr (&Sfile_exists_p
);
6700 defsubr (&Sfile_executable_p
);
6701 defsubr (&Sfile_readable_p
);
6702 defsubr (&Sfile_writable_p
);
6703 defsubr (&Saccess_file
);
6704 defsubr (&Sfile_symlink_p
);
6705 defsubr (&Sfile_directory_p
);
6706 defsubr (&Sfile_accessible_directory_p
);
6707 defsubr (&Sfile_regular_p
);
6708 defsubr (&Sfile_modes
);
6709 defsubr (&Sset_file_modes
);
6710 defsubr (&Sset_file_times
);
6711 defsubr (&Sset_default_file_modes
);
6712 defsubr (&Sdefault_file_modes
);
6713 defsubr (&Sfile_newer_than_file_p
);
6714 defsubr (&Sinsert_file_contents
);
6715 defsubr (&Swrite_region
);
6716 defsubr (&Scar_less_than_car
);
6717 defsubr (&Sverify_visited_file_modtime
);
6718 defsubr (&Sclear_visited_file_modtime
);
6719 defsubr (&Svisited_file_modtime
);
6720 defsubr (&Sset_visited_file_modtime
);
6721 defsubr (&Sdo_auto_save
);
6722 defsubr (&Sset_buffer_auto_saved
);
6723 defsubr (&Sclear_buffer_auto_save_failure
);
6724 defsubr (&Srecent_auto_save_p
);
6726 defsubr (&Sread_file_name_internal
);
6727 defsubr (&Sread_file_name
);
6728 defsubr (&Snext_read_file_uses_dialog_p
);
6731 defsubr (&Sunix_sync
);
6735 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6736 (do not change this comment) */