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"
78 #include "character.h"
87 #endif /* not WINDOWSNT */
91 #include <sys/param.h>
99 #define CORRECT_DIR_SEPS(s) \
100 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
101 else unixtodos_filename (s); \
103 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
104 redirector allows the six letters between 'Z' and 'a' as well. */
106 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
109 #define IS_DRIVE(x) isalpha (x)
111 /* Need to lower-case the drive letter, or else expanded
112 filenames will sometimes compare inequal, because
113 `expand-file-name' doesn't always down-case the drive letter. */
114 #define DRIVE_LETTER(x) (tolower (x))
135 #include "commands.h"
136 extern int use_dialog_box
;
137 extern int use_file_dialog
;
151 /* Nonzero during writing of auto-save files */
154 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
155 a new file with the same mode as the original */
156 int auto_save_mode_bits
;
158 /* The symbol bound to coding-system-for-read when
159 insert-file-contents is called for recovering a file. This is not
160 an actual coding system name, but just an indicator to tell
161 insert-file-contents to use `emacs-mule' with a special flag for
162 auto saving and recovering a file. */
163 Lisp_Object Qauto_save_coding
;
165 /* Coding system for file names, or nil if none. */
166 Lisp_Object Vfile_name_coding_system
;
168 /* Coding system for file names used only when
169 Vfile_name_coding_system is nil. */
170 Lisp_Object Vdefault_file_name_coding_system
;
172 /* Alist of elements (REGEXP . HANDLER) for file names
173 whose I/O is done with a special handler. */
174 Lisp_Object Vfile_name_handler_alist
;
176 /* Lisp functions for translating file formats */
177 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
179 /* Function to be called to decide a coding system of a reading file. */
180 Lisp_Object Vset_auto_coding_function
;
182 /* Functions to be called to process text properties in inserted file. */
183 Lisp_Object Vafter_insert_file_functions
;
185 /* Lisp function for setting buffer-file-coding-system and the
186 multibyteness of the current buffer after inserting a file. */
187 Lisp_Object Qafter_insert_file_set_coding
;
189 /* Functions to be called to create text property annotations for file. */
190 Lisp_Object Vwrite_region_annotate_functions
;
191 Lisp_Object Qwrite_region_annotate_functions
;
193 /* During build_annotations, each time an annotation function is called,
194 this holds the annotations made by the previous functions. */
195 Lisp_Object Vwrite_region_annotations_so_far
;
197 /* File name in which we write a list of all our auto save files. */
198 Lisp_Object Vauto_save_list_file_name
;
200 /* Function to call to read a file name. */
201 Lisp_Object Vread_file_name_function
;
203 /* Current predicate used by read_file_name_internal. */
204 Lisp_Object Vread_file_name_predicate
;
206 /* Nonzero means completion ignores case when reading file name. */
207 int read_file_name_completion_ignore_case
;
209 /* Nonzero means, when reading a filename in the minibuffer,
210 start out by inserting the default directory into the minibuffer. */
211 int insert_default_directory
;
213 /* On VMS, nonzero means write new files with record format stmlf.
214 Zero means use var format. */
217 /* On NT, specifies the directory separator character, used (eg.) when
218 expanding file names. This can be bound to / or \. */
219 Lisp_Object Vdirectory_sep_char
;
221 extern Lisp_Object Vuser_login_name
;
224 extern Lisp_Object Vw32_get_true_file_attributes
;
227 extern int minibuf_level
;
229 extern int minibuffer_auto_raise
;
231 /* These variables describe handlers that have "already" had a chance
232 to handle the current operation.
234 Vinhibit_file_name_handlers is a list of file name handlers.
235 Vinhibit_file_name_operation is the operation being handled.
236 If we try to handle that operation, we ignore those handlers. */
238 static Lisp_Object Vinhibit_file_name_handlers
;
239 static Lisp_Object Vinhibit_file_name_operation
;
241 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
243 Lisp_Object Qfile_name_history
;
245 Lisp_Object Qcar_less_than_car
;
247 static int a_write
P_ ((int, Lisp_Object
, int, int,
248 Lisp_Object
*, struct coding_system
*));
249 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
253 report_file_error (string
, data
)
257 Lisp_Object errstring
;
261 synchronize_system_messages_locale ();
262 str
= strerror (errorno
);
263 errstring
= code_convert_string_norecord (make_unibyte_string (str
,
265 Vlocale_coding_system
, 0);
271 Fsignal (Qfile_already_exists
, Fcons (errstring
, data
));
274 /* System error messages are capitalized. Downcase the initial
275 unless it is followed by a slash. */
276 if (SREF (errstring
, 1) != '/')
277 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
279 Fsignal (Qfile_error
,
280 Fcons (build_string (string
), Fcons (errstring
, data
)));
285 close_file_unwind (fd
)
288 emacs_close (XFASTINT (fd
));
292 /* Restore point, having saved it as a marker. */
295 restore_point_unwind (location
)
296 Lisp_Object location
;
298 Fgoto_char (location
);
299 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. */
2258 c
= unibyte_char_to_multibyte (c
);
2259 x
+= CHAR_STRING (c
, x
);
2271 /* If /~ or // appears, discard everything through first slash. */
2273 for (p
= xnm
; p
!= x
; p
++)
2275 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2276 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2277 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2278 || IS_DIRECTORY_SEP (p
[0])
2279 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2281 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2284 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2285 && p
> xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2289 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2292 error ("Bad format environment-variable substitution");
2294 error ("Missing \"}\" in environment-variable substitution");
2296 error ("Substituting nonexistent environment variable \"%s\"", target
);
2299 #endif /* not VMS */
2303 /* A slightly faster and more convenient way to get
2304 (directory-file-name (expand-file-name FOO)). */
2307 expand_and_dir_to_file (filename
, defdir
)
2308 Lisp_Object filename
, defdir
;
2310 register Lisp_Object absname
;
2312 absname
= Fexpand_file_name (filename
, defdir
);
2315 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2316 if (c
== ':' || c
== ']' || c
== '>')
2317 absname
= Fdirectory_file_name (absname
);
2320 /* Remove final slash, if any (unless this is the root dir).
2321 stat behaves differently depending! */
2322 if (SCHARS (absname
) > 1
2323 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2324 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2325 /* We cannot take shortcuts; they might be wrong for magic file names. */
2326 absname
= Fdirectory_file_name (absname
);
2331 /* Signal an error if the file ABSNAME already exists.
2332 If INTERACTIVE is nonzero, ask the user whether to proceed,
2333 and bypass the error if the user says to go ahead.
2334 QUERYSTRING is a name for the action that is being considered
2337 *STATPTR is used to store the stat information if the file exists.
2338 If the file does not exist, STATPTR->st_mode is set to 0.
2339 If STATPTR is null, we don't store into it.
2341 If QUICK is nonzero, we ask for y or n, not yes or no. */
2344 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2345 Lisp_Object absname
;
2346 unsigned char *querystring
;
2348 struct stat
*statptr
;
2351 register Lisp_Object tem
, encoded_filename
;
2352 struct stat statbuf
;
2353 struct gcpro gcpro1
;
2355 encoded_filename
= ENCODE_FILE (absname
);
2357 /* stat is a good way to tell whether the file exists,
2358 regardless of what access permissions it has. */
2359 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
2362 Fsignal (Qfile_already_exists
,
2363 Fcons (build_string ("File already exists"),
2364 Fcons (absname
, Qnil
)));
2366 tem
= format2 ("File %s already exists; %s anyway? ",
2367 absname
, build_string (querystring
));
2369 tem
= Fy_or_n_p (tem
);
2371 tem
= do_yes_or_no_p (tem
);
2374 Fsignal (Qfile_already_exists
,
2375 Fcons (build_string ("File already exists"),
2376 Fcons (absname
, Qnil
)));
2383 statptr
->st_mode
= 0;
2388 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2389 "fCopy file: \nFCopy %s to file: \np\nP",
2390 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2391 If NEWNAME names a directory, copy FILE there.
2392 Signals a `file-already-exists' error if file NEWNAME already exists,
2393 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
2394 A number as third arg means request confirmation if NEWNAME already exists.
2395 This is what happens in interactive use with M-x.
2396 Fourth arg KEEP-TIME non-nil means give the new file the same
2397 last-modified time as the old one. (This works on only some systems.)
2398 A prefix arg makes KEEP-TIME non-nil.
2399 Also set the file modes of the target file to match the source file. */)
2400 (file
, newname
, ok_if_already_exists
, keep_time
)
2401 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2404 char buf
[16 * 1024];
2405 struct stat st
, out_st
;
2406 Lisp_Object handler
;
2407 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2408 int count
= SPECPDL_INDEX ();
2409 int input_file_statable_p
;
2410 Lisp_Object encoded_file
, encoded_newname
;
2412 encoded_file
= encoded_newname
= Qnil
;
2413 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2414 CHECK_STRING (file
);
2415 CHECK_STRING (newname
);
2417 if (!NILP (Ffile_directory_p (newname
)))
2418 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2420 newname
= Fexpand_file_name (newname
, Qnil
);
2422 file
= Fexpand_file_name (file
, Qnil
);
2424 /* If the input file name has special constructs in it,
2425 call the corresponding file handler. */
2426 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2427 /* Likewise for output file name. */
2429 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2430 if (!NILP (handler
))
2431 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2432 ok_if_already_exists
, keep_time
));
2434 encoded_file
= ENCODE_FILE (file
);
2435 encoded_newname
= ENCODE_FILE (newname
);
2437 if (NILP (ok_if_already_exists
)
2438 || INTEGERP (ok_if_already_exists
))
2439 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2440 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2441 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2445 if (!CopyFile (SDATA (encoded_file
),
2446 SDATA (encoded_newname
),
2448 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2449 /* CopyFile retains the timestamp by default. */
2450 else if (NILP (keep_time
))
2456 EMACS_GET_TIME (now
);
2457 filename
= SDATA (encoded_newname
);
2459 /* Ensure file is writable while its modified time is set. */
2460 attributes
= GetFileAttributes (filename
);
2461 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2462 if (set_file_times (filename
, now
, now
))
2464 /* Restore original attributes. */
2465 SetFileAttributes (filename
, attributes
);
2466 Fsignal (Qfile_date_error
,
2467 Fcons (build_string ("Cannot set file date"),
2468 Fcons (newname
, Qnil
)));
2470 /* Restore original attributes. */
2471 SetFileAttributes (filename
, attributes
);
2473 #else /* not WINDOWSNT */
2475 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2479 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2481 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2483 /* We can only copy regular files and symbolic links. Other files are not
2485 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2487 #if !defined (DOS_NT) || __DJGPP__ > 1
2488 if (out_st
.st_mode
!= 0
2489 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2492 report_file_error ("Input and output files are the same",
2493 Fcons (file
, Fcons (newname
, Qnil
)));
2497 #if defined (S_ISREG) && defined (S_ISLNK)
2498 if (input_file_statable_p
)
2500 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2502 #if defined (EISDIR)
2503 /* Get a better looking error message. */
2506 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2509 #endif /* S_ISREG && S_ISLNK */
2512 /* Create the copy file with the same record format as the input file */
2513 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2516 /* System's default file type was set to binary by _fmode in emacs.c. */
2517 ofd
= creat (SDATA (encoded_newname
), S_IREAD
| S_IWRITE
);
2518 #else /* not MSDOS */
2519 ofd
= creat (SDATA (encoded_newname
), 0666);
2520 #endif /* not MSDOS */
2523 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2525 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2529 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2530 if (emacs_write (ofd
, buf
, n
) != n
)
2531 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2534 /* Closing the output clobbers the file times on some systems. */
2535 if (emacs_close (ofd
) < 0)
2536 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2538 if (input_file_statable_p
)
2540 if (!NILP (keep_time
))
2542 EMACS_TIME atime
, mtime
;
2543 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2544 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2545 if (set_file_times (SDATA (encoded_newname
),
2547 Fsignal (Qfile_date_error
,
2548 Fcons (build_string ("Cannot set file date"),
2549 Fcons (newname
, Qnil
)));
2552 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2554 #if defined (__DJGPP__) && __DJGPP__ > 1
2555 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2556 and if it can't, it tells so. Otherwise, under MSDOS we usually
2557 get only the READ bit, which will make the copied file read-only,
2558 so it's better not to chmod at all. */
2559 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2560 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2561 #endif /* DJGPP version 2 or newer */
2566 #endif /* WINDOWSNT */
2568 /* Discard the unwind protects. */
2569 specpdl_ptr
= specpdl
+ count
;
2575 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2576 Smake_directory_internal
, 1, 1, 0,
2577 doc
: /* Create a new directory named DIRECTORY. */)
2579 Lisp_Object directory
;
2581 const unsigned char *dir
;
2582 Lisp_Object handler
;
2583 Lisp_Object encoded_dir
;
2585 CHECK_STRING (directory
);
2586 directory
= Fexpand_file_name (directory
, Qnil
);
2588 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2589 if (!NILP (handler
))
2590 return call2 (handler
, Qmake_directory_internal
, directory
);
2592 encoded_dir
= ENCODE_FILE (directory
);
2594 dir
= SDATA (encoded_dir
);
2597 if (mkdir (dir
) != 0)
2599 if (mkdir (dir
, 0777) != 0)
2601 report_file_error ("Creating directory", Flist (1, &directory
));
2606 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2607 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2609 Lisp_Object directory
;
2611 const unsigned char *dir
;
2612 Lisp_Object handler
;
2613 Lisp_Object encoded_dir
;
2615 CHECK_STRING (directory
);
2616 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2618 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2619 if (!NILP (handler
))
2620 return call2 (handler
, Qdelete_directory
, directory
);
2622 encoded_dir
= ENCODE_FILE (directory
);
2624 dir
= SDATA (encoded_dir
);
2626 if (rmdir (dir
) != 0)
2627 report_file_error ("Removing directory", Flist (1, &directory
));
2632 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2633 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2634 If file has multiple names, it continues to exist with the other names. */)
2636 Lisp_Object filename
;
2638 Lisp_Object handler
;
2639 Lisp_Object encoded_file
;
2640 struct gcpro gcpro1
;
2643 if (!NILP (Ffile_directory_p (filename
))
2644 && NILP (Ffile_symlink_p (filename
)))
2645 Fsignal (Qfile_error
,
2646 Fcons (build_string ("Removing old name: is a directory"),
2647 Fcons (filename
, Qnil
)));
2649 filename
= Fexpand_file_name (filename
, Qnil
);
2651 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2652 if (!NILP (handler
))
2653 return call2 (handler
, Qdelete_file
, filename
);
2655 encoded_file
= ENCODE_FILE (filename
);
2657 if (0 > unlink (SDATA (encoded_file
)))
2658 report_file_error ("Removing old name", Flist (1, &filename
));
2663 internal_delete_file_1 (ignore
)
2669 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2672 internal_delete_file (filename
)
2673 Lisp_Object filename
;
2675 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2676 Qt
, internal_delete_file_1
));
2679 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2680 "fRename file: \nFRename %s to file: \np",
2681 doc
: /* Rename FILE as NEWNAME. Both args strings.
2682 If file has names other than FILE, it continues to have those names.
2683 Signals a `file-already-exists' error if a file NEWNAME already exists
2684 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2685 A number as third arg means request confirmation if NEWNAME already exists.
2686 This is what happens in interactive use with M-x. */)
2687 (file
, newname
, ok_if_already_exists
)
2688 Lisp_Object file
, newname
, ok_if_already_exists
;
2691 Lisp_Object args
[2];
2693 Lisp_Object handler
;
2694 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2695 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2697 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2698 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2699 CHECK_STRING (file
);
2700 CHECK_STRING (newname
);
2701 file
= Fexpand_file_name (file
, Qnil
);
2702 newname
= Fexpand_file_name (newname
, Qnil
);
2704 /* If the file name has special constructs in it,
2705 call the corresponding file handler. */
2706 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2708 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2709 if (!NILP (handler
))
2710 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2711 file
, newname
, ok_if_already_exists
));
2713 encoded_file
= ENCODE_FILE (file
);
2714 encoded_newname
= ENCODE_FILE (newname
);
2717 /* If the file names are identical but for the case, don't ask for
2718 confirmation: they simply want to change the letter-case of the
2720 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2722 if (NILP (ok_if_already_exists
)
2723 || INTEGERP (ok_if_already_exists
))
2724 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2725 INTEGERP (ok_if_already_exists
), 0, 0);
2727 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2729 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2730 || 0 > unlink (SDATA (encoded_file
)))
2736 symlink_target
= Ffile_symlink_p (file
);
2737 if (! NILP (symlink_target
))
2738 Fmake_symbolic_link (symlink_target
, newname
,
2739 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2742 Fcopy_file (file
, newname
,
2743 /* We have already prompted if it was an integer,
2744 so don't have copy-file prompt again. */
2745 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2746 Fdelete_file (file
);
2753 report_file_error ("Renaming", Flist (2, args
));
2756 report_file_error ("Renaming", Flist (2, &file
));
2763 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2764 "fAdd name to file: \nFName to add to %s: \np",
2765 doc
: /* Give FILE additional name NEWNAME. Both args strings.
2766 Signals a `file-already-exists' error if a file NEWNAME already exists
2767 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2768 A number as third arg means request confirmation if NEWNAME already exists.
2769 This is what happens in interactive use with M-x. */)
2770 (file
, newname
, ok_if_already_exists
)
2771 Lisp_Object file
, newname
, ok_if_already_exists
;
2774 Lisp_Object args
[2];
2776 Lisp_Object handler
;
2777 Lisp_Object encoded_file
, encoded_newname
;
2778 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2780 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2781 encoded_file
= encoded_newname
= Qnil
;
2782 CHECK_STRING (file
);
2783 CHECK_STRING (newname
);
2784 file
= Fexpand_file_name (file
, Qnil
);
2785 newname
= Fexpand_file_name (newname
, Qnil
);
2787 /* If the file name has special constructs in it,
2788 call the corresponding file handler. */
2789 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2790 if (!NILP (handler
))
2791 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2792 newname
, ok_if_already_exists
));
2794 /* If the new name has special constructs in it,
2795 call the corresponding file handler. */
2796 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2797 if (!NILP (handler
))
2798 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2799 newname
, ok_if_already_exists
));
2801 encoded_file
= ENCODE_FILE (file
);
2802 encoded_newname
= ENCODE_FILE (newname
);
2804 if (NILP (ok_if_already_exists
)
2805 || INTEGERP (ok_if_already_exists
))
2806 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2807 INTEGERP (ok_if_already_exists
), 0, 0);
2809 unlink (SDATA (newname
));
2810 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2815 report_file_error ("Adding new name", Flist (2, args
));
2817 report_file_error ("Adding new name", Flist (2, &file
));
2826 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2827 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2828 doc
: /* Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2829 Signals a `file-already-exists' error if a file LINKNAME already exists
2830 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2831 A number as third arg means request confirmation if LINKNAME already exists.
2832 This happens for interactive use with M-x. */)
2833 (filename
, linkname
, ok_if_already_exists
)
2834 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2837 Lisp_Object args
[2];
2839 Lisp_Object handler
;
2840 Lisp_Object encoded_filename
, encoded_linkname
;
2841 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2843 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2844 encoded_filename
= encoded_linkname
= Qnil
;
2845 CHECK_STRING (filename
);
2846 CHECK_STRING (linkname
);
2847 /* If the link target has a ~, we must expand it to get
2848 a truly valid file name. Otherwise, do not expand;
2849 we want to permit links to relative file names. */
2850 if (SREF (filename
, 0) == '~')
2851 filename
= Fexpand_file_name (filename
, Qnil
);
2852 linkname
= Fexpand_file_name (linkname
, Qnil
);
2854 /* If the file name has special constructs in it,
2855 call the corresponding file handler. */
2856 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2857 if (!NILP (handler
))
2858 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2859 linkname
, ok_if_already_exists
));
2861 /* If the new link name has special constructs in it,
2862 call the corresponding file handler. */
2863 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2864 if (!NILP (handler
))
2865 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2866 linkname
, ok_if_already_exists
));
2868 encoded_filename
= ENCODE_FILE (filename
);
2869 encoded_linkname
= ENCODE_FILE (linkname
);
2871 if (NILP (ok_if_already_exists
)
2872 || INTEGERP (ok_if_already_exists
))
2873 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2874 INTEGERP (ok_if_already_exists
), 0, 0);
2875 if (0 > symlink (SDATA (encoded_filename
),
2876 SDATA (encoded_linkname
)))
2878 /* If we didn't complain already, silently delete existing file. */
2879 if (errno
== EEXIST
)
2881 unlink (SDATA (encoded_linkname
));
2882 if (0 <= symlink (SDATA (encoded_filename
),
2883 SDATA (encoded_linkname
)))
2893 report_file_error ("Making symbolic link", Flist (2, args
));
2895 report_file_error ("Making symbolic link", Flist (2, &filename
));
2901 #endif /* S_IFLNK */
2905 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2906 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2907 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2908 If STRING is nil or a null string, the logical name NAME is deleted. */)
2913 CHECK_STRING (name
);
2915 delete_logical_name (SDATA (name
));
2918 CHECK_STRING (string
);
2920 if (SCHARS (string
) == 0)
2921 delete_logical_name (SDATA (name
));
2923 define_logical_name (SDATA (name
), SDATA (string
));
2932 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2933 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2935 Lisp_Object path
, login
;
2939 CHECK_STRING (path
);
2940 CHECK_STRING (login
);
2942 netresult
= netunam (SDATA (path
), SDATA (login
));
2944 if (netresult
== -1)
2949 #endif /* HPUX_NET */
2951 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2953 doc
: /* Return t if file FILENAME specifies an absolute file name.
2954 On Unix, this is a name starting with a `/' or a `~'. */)
2956 Lisp_Object filename
;
2958 const unsigned char *ptr
;
2960 CHECK_STRING (filename
);
2961 ptr
= SDATA (filename
);
2962 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2964 /* ??? This criterion is probably wrong for '<'. */
2965 || index (ptr
, ':') || index (ptr
, '<')
2966 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2970 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2978 /* Return nonzero if file FILENAME exists and can be executed. */
2981 check_executable (filename
)
2985 int len
= strlen (filename
);
2988 if (stat (filename
, &st
) < 0)
2990 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2991 return ((st
.st_mode
& S_IEXEC
) != 0);
2993 return (S_ISREG (st
.st_mode
)
2995 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2996 || stricmp (suffix
, ".exe") == 0
2997 || stricmp (suffix
, ".bat") == 0)
2998 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2999 #endif /* not WINDOWSNT */
3000 #else /* not DOS_NT */
3001 #ifdef HAVE_EUIDACCESS
3002 return (euidaccess (filename
, 1) >= 0);
3004 /* Access isn't quite right because it uses the real uid
3005 and we really want to test with the effective uid.
3006 But Unix doesn't give us a right way to do it. */
3007 return (access (filename
, 1) >= 0);
3009 #endif /* not DOS_NT */
3012 /* Return nonzero if file FILENAME exists and can be written. */
3015 check_writable (filename
)
3020 if (stat (filename
, &st
) < 0)
3022 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3023 #else /* not MSDOS */
3024 #ifdef HAVE_EUIDACCESS
3025 return (euidaccess (filename
, 2) >= 0);
3027 /* Access isn't quite right because it uses the real uid
3028 and we really want to test with the effective uid.
3029 But Unix doesn't give us a right way to do it.
3030 Opening with O_WRONLY could work for an ordinary file,
3031 but would lose for directories. */
3032 return (access (filename
, 2) >= 0);
3034 #endif /* not MSDOS */
3037 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3038 doc
: /* Return t if file FILENAME exists. (This does not mean you can read it.)
3039 See also `file-readable-p' and `file-attributes'. */)
3041 Lisp_Object filename
;
3043 Lisp_Object absname
;
3044 Lisp_Object handler
;
3045 struct stat statbuf
;
3047 CHECK_STRING (filename
);
3048 absname
= Fexpand_file_name (filename
, Qnil
);
3050 /* If the file name has special constructs in it,
3051 call the corresponding file handler. */
3052 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3053 if (!NILP (handler
))
3054 return call2 (handler
, Qfile_exists_p
, absname
);
3056 absname
= ENCODE_FILE (absname
);
3058 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3061 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3062 doc
: /* Return t if FILENAME can be executed by you.
3063 For a directory, this means you can access files in that directory. */)
3065 Lisp_Object filename
;
3067 Lisp_Object absname
;
3068 Lisp_Object handler
;
3070 CHECK_STRING (filename
);
3071 absname
= Fexpand_file_name (filename
, Qnil
);
3073 /* If the file name has special constructs in it,
3074 call the corresponding file handler. */
3075 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3076 if (!NILP (handler
))
3077 return call2 (handler
, Qfile_executable_p
, absname
);
3079 absname
= ENCODE_FILE (absname
);
3081 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3084 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3085 doc
: /* Return t if file FILENAME exists and you can read it.
3086 See also `file-exists-p' and `file-attributes'. */)
3088 Lisp_Object filename
;
3090 Lisp_Object absname
;
3091 Lisp_Object handler
;
3094 struct stat statbuf
;
3096 CHECK_STRING (filename
);
3097 absname
= Fexpand_file_name (filename
, Qnil
);
3099 /* If the file name has special constructs in it,
3100 call the corresponding file handler. */
3101 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3102 if (!NILP (handler
))
3103 return call2 (handler
, Qfile_readable_p
, absname
);
3105 absname
= ENCODE_FILE (absname
);
3107 #if defined(DOS_NT) || defined(macintosh)
3108 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3110 if (access (SDATA (absname
), 0) == 0)
3113 #else /* not DOS_NT and not macintosh */
3115 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3116 /* Opening a fifo without O_NONBLOCK can wait.
3117 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3118 except in the case of a fifo, on a system which handles it. */
3119 desc
= stat (SDATA (absname
), &statbuf
);
3122 if (S_ISFIFO (statbuf
.st_mode
))
3123 flags
|= O_NONBLOCK
;
3125 desc
= emacs_open (SDATA (absname
), flags
, 0);
3130 #endif /* not DOS_NT and not macintosh */
3133 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3135 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3136 doc
: /* Return t if file FILENAME can be written or created by you. */)
3138 Lisp_Object filename
;
3140 Lisp_Object absname
, dir
, encoded
;
3141 Lisp_Object handler
;
3142 struct stat statbuf
;
3144 CHECK_STRING (filename
);
3145 absname
= Fexpand_file_name (filename
, Qnil
);
3147 /* If the file name has special constructs in it,
3148 call the corresponding file handler. */
3149 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3150 if (!NILP (handler
))
3151 return call2 (handler
, Qfile_writable_p
, absname
);
3153 encoded
= ENCODE_FILE (absname
);
3154 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3155 return (check_writable (SDATA (encoded
))
3158 dir
= Ffile_name_directory (absname
);
3161 dir
= Fdirectory_file_name (dir
);
3165 dir
= Fdirectory_file_name (dir
);
3168 dir
= ENCODE_FILE (dir
);
3170 /* The read-only attribute of the parent directory doesn't affect
3171 whether a file or directory can be created within it. Some day we
3172 should check ACLs though, which do affect this. */
3173 if (stat (SDATA (dir
), &statbuf
) < 0)
3175 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3177 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3182 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3183 doc
: /* Access file FILENAME, and get an error if that does not work.
3184 The second argument STRING is used in the error message.
3185 If there is no error, we return nil. */)
3187 Lisp_Object filename
, string
;
3189 Lisp_Object handler
, encoded_filename
, absname
;
3192 CHECK_STRING (filename
);
3193 absname
= Fexpand_file_name (filename
, Qnil
);
3195 CHECK_STRING (string
);
3197 /* If the file name has special constructs in it,
3198 call the corresponding file handler. */
3199 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3200 if (!NILP (handler
))
3201 return call3 (handler
, Qaccess_file
, absname
, string
);
3203 encoded_filename
= ENCODE_FILE (absname
);
3205 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3207 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3213 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3214 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3215 The value is the link target, as a string.
3216 Otherwise returns nil. */)
3218 Lisp_Object filename
;
3220 Lisp_Object handler
;
3222 CHECK_STRING (filename
);
3223 filename
= Fexpand_file_name (filename
, Qnil
);
3225 /* If the file name has special constructs in it,
3226 call the corresponding file handler. */
3227 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3228 if (!NILP (handler
))
3229 return call2 (handler
, Qfile_symlink_p
, filename
);
3238 filename
= ENCODE_FILE (filename
);
3245 buf
= (char *) xrealloc (buf
, bufsize
);
3246 bzero (buf
, bufsize
);
3249 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3253 /* HP-UX reports ERANGE if buffer is too small. */
3254 if (errno
== ERANGE
)
3264 while (valsize
>= bufsize
);
3266 val
= make_string (buf
, valsize
);
3267 if (buf
[0] == '/' && index (buf
, ':'))
3268 val
= concat2 (build_string ("/:"), val
);
3270 val
= DECODE_FILE (val
);
3273 #else /* not S_IFLNK */
3275 #endif /* not S_IFLNK */
3278 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3279 doc
: /* Return t if FILENAME names an existing directory.
3280 Symbolic links to directories count as directories.
3281 See `file-symlink-p' to distinguish symlinks. */)
3283 Lisp_Object filename
;
3285 register Lisp_Object absname
;
3287 Lisp_Object handler
;
3289 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3291 /* If the file name has special constructs in it,
3292 call the corresponding file handler. */
3293 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3294 if (!NILP (handler
))
3295 return call2 (handler
, Qfile_directory_p
, absname
);
3297 absname
= ENCODE_FILE (absname
);
3299 if (stat (SDATA (absname
), &st
) < 0)
3301 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3304 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3305 doc
: /* Return t if file FILENAME names a directory you can open.
3306 For the value to be t, FILENAME must specify the name of a directory as a file,
3307 and the directory must allow you to open files in it. In order to use a
3308 directory as a buffer's current directory, this predicate must return true.
3309 A directory name spec may be given instead; then the value is t
3310 if the directory so specified exists and really is a readable and
3311 searchable directory. */)
3313 Lisp_Object filename
;
3315 Lisp_Object handler
;
3317 struct gcpro gcpro1
;
3319 /* If the file name has special constructs in it,
3320 call the corresponding file handler. */
3321 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3322 if (!NILP (handler
))
3323 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3326 tem
= (NILP (Ffile_directory_p (filename
))
3327 || NILP (Ffile_executable_p (filename
)));
3329 return tem
? Qnil
: Qt
;
3332 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3333 doc
: /* Return t if file FILENAME is the name of a regular file.
3334 This is the sort of file that holds an ordinary stream of data bytes. */)
3336 Lisp_Object filename
;
3338 register Lisp_Object absname
;
3340 Lisp_Object handler
;
3342 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3344 /* If the file name has special constructs in it,
3345 call the corresponding file handler. */
3346 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3347 if (!NILP (handler
))
3348 return call2 (handler
, Qfile_regular_p
, absname
);
3350 absname
= ENCODE_FILE (absname
);
3355 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3357 /* Tell stat to use expensive method to get accurate info. */
3358 Vw32_get_true_file_attributes
= Qt
;
3359 result
= stat (SDATA (absname
), &st
);
3360 Vw32_get_true_file_attributes
= tem
;
3364 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3367 if (stat (SDATA (absname
), &st
) < 0)
3369 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3373 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3374 doc
: /* Return mode bits of file named FILENAME, as an integer. */)
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 Lisp_Object coding_system
;
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 /* The value Qnil means that the coding system is not yet
3723 coding_system
= Qnil
;
3725 /* If the file name has special constructs in it,
3726 call the corresponding file handler. */
3727 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3728 if (!NILP (handler
))
3730 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3731 visit
, beg
, end
, replace
);
3732 if (CONSP (val
) && CONSP (XCDR (val
)))
3733 inserted
= XINT (XCAR (XCDR (val
)));
3737 orig_filename
= filename
;
3738 filename
= ENCODE_FILE (filename
);
3744 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3746 /* Tell stat to use expensive method to get accurate info. */
3747 Vw32_get_true_file_attributes
= Qt
;
3748 total
= stat (SDATA (filename
), &st
);
3749 Vw32_get_true_file_attributes
= tem
;
3754 if (stat (SDATA (filename
), &st
) < 0)
3756 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3757 || fstat (fd
, &st
) < 0)
3758 #endif /* not APOLLO */
3759 #endif /* WINDOWSNT */
3761 if (fd
>= 0) emacs_close (fd
);
3764 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3767 if (!NILP (Vcoding_system_for_read
))
3768 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3773 /* This code will need to be changed in order to work on named
3774 pipes, and it's probably just not worth it. So we should at
3775 least signal an error. */
3776 if (!S_ISREG (st
.st_mode
))
3783 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3784 Fsignal (Qfile_error
,
3785 Fcons (build_string ("not a regular file"),
3786 Fcons (orig_filename
, Qnil
)));
3791 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3794 /* Replacement should preserve point as it preserves markers. */
3795 if (!NILP (replace
))
3796 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3798 record_unwind_protect (close_file_unwind
, make_number (fd
));
3800 /* Supposedly happens on VMS. */
3801 /* Can happen on any platform that uses long as type of off_t, but allows
3802 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3803 give a message suitable for the latter case. */
3804 if (! not_regular
&& st
.st_size
< 0)
3805 error ("Maximum buffer size exceeded");
3807 /* Prevent redisplay optimizations. */
3808 current_buffer
->clip_changed
= 1;
3812 if (!NILP (beg
) || !NILP (end
))
3813 error ("Attempt to visit less than an entire file");
3814 if (BEG
< Z
&& NILP (replace
))
3815 error ("Cannot do file visiting in a non-empty buffer");
3821 XSETFASTINT (beg
, 0);
3829 XSETINT (end
, st
.st_size
);
3831 /* Arithmetic overflow can occur if an Emacs integer cannot
3832 represent the file size, or if the calculations below
3833 overflow. The calculations below double the file size
3834 twice, so check that it can be multiplied by 4 safely. */
3835 if (XINT (end
) != st
.st_size
3836 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3837 error ("Maximum buffer size exceeded");
3839 /* The file size returned from stat may be zero, but data
3840 may be readable nonetheless, for example when this is a
3841 file in the /proc filesystem. */
3842 if (st
.st_size
== 0)
3843 XSETINT (end
, READ_BUF_SIZE
);
3847 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3849 coding_system
= Qutf_8_emacs
;
3850 setup_coding_system (coding_system
, &coding
);
3851 /* Ensure we set Vlast_coding_system_used. */
3852 set_coding_system
= 1;
3856 /* Decide the coding system to use for reading the file now
3857 because we can't use an optimized method for handling
3858 `coding:' tag if the current buffer is not empty. */
3859 if (!NILP (Vcoding_system_for_read
))
3860 coding_system
= Vcoding_system_for_read
;
3861 else if (! NILP (replace
))
3862 /* In REPLACE mode, we can use the same coding system
3863 that was used to visit the file. */
3864 coding_system
= current_buffer
->buffer_file_coding_system
;
3867 /* Don't try looking inside a file for a coding system
3868 specification if it is not seekable. */
3869 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3871 /* Find a coding system specified in the heading two
3872 lines or in the tailing several lines of the file.
3873 We assume that the 1K-byte and 3K-byte for heading
3874 and tailing respectively are sufficient for this
3878 if (st
.st_size
<= (1024 * 4))
3879 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3882 nread
= emacs_read (fd
, read_buf
, 1024);
3885 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3886 report_file_error ("Setting file position",
3887 Fcons (orig_filename
, Qnil
));
3888 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3893 error ("IO error reading %s: %s",
3894 SDATA (orig_filename
), emacs_strerror (errno
));
3897 struct buffer
*prev
= current_buffer
;
3901 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3903 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3904 buf
= XBUFFER (buffer
);
3906 delete_all_overlays (buf
);
3907 buf
->directory
= current_buffer
->directory
;
3908 buf
->read_only
= Qnil
;
3909 buf
->filename
= Qnil
;
3910 buf
->undo_list
= Qt
;
3911 eassert (buf
->overlays_before
== NULL
);
3912 eassert (buf
->overlays_after
== NULL
);
3914 set_buffer_internal (buf
);
3916 buf
->enable_multibyte_characters
= Qnil
;
3918 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3919 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3920 coding_system
= call2 (Vset_auto_coding_function
,
3921 filename
, make_number (nread
));
3922 set_buffer_internal (prev
);
3924 /* Discard the unwind protect for recovering the
3928 /* Rewind the file for the actual read done later. */
3929 if (lseek (fd
, 0, 0) < 0)
3930 report_file_error ("Setting file position",
3931 Fcons (orig_filename
, Qnil
));
3935 if (NILP (coding_system
))
3937 /* If we have not yet decided a coding system, check
3938 file-coding-system-alist. */
3939 Lisp_Object args
[6];
3941 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3942 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3943 coding_system
= Ffind_operation_coding_system (6, args
);
3944 if (CONSP (coding_system
))
3945 coding_system
= XCAR (coding_system
);
3949 if (NILP (coding_system
))
3950 coding_system
= Qundecided
;
3952 CHECK_CODING_SYSTEM (coding_system
);
3954 if (NILP (current_buffer
->enable_multibyte_characters
))
3955 /* We must suppress all character code conversion except for
3956 end-of-line conversion. */
3957 coding_system
= raw_text_coding_system (coding_system
);
3959 setup_coding_system (coding_system
, &coding
);
3960 /* Ensure we set Vlast_coding_system_used. */
3961 set_coding_system
= 1;
3964 /* If requested, replace the accessible part of the buffer
3965 with the file contents. Avoid replacing text at the
3966 beginning or end of the buffer that matches the file contents;
3967 that preserves markers pointing to the unchanged parts.
3969 Here we implement this feature in an optimized way
3970 for the case where code conversion is NOT needed.
3971 The following if-statement handles the case of conversion
3972 in a less optimal way.
3974 If the code conversion is "automatic" then we try using this
3975 method and hope for the best.
3976 But if we discover the need for conversion, we give up on this method
3977 and let the following if-statement handle the replace job. */
3980 && (NILP (coding_system
)
3981 || ! CODING_REQUIRE_DECODING (&coding
)))
3983 /* same_at_start and same_at_end count bytes,
3984 because file access counts bytes
3985 and BEG and END count bytes. */
3986 int same_at_start
= BEGV_BYTE
;
3987 int same_at_end
= ZV_BYTE
;
3989 /* There is still a possibility we will find the need to do code
3990 conversion. If that happens, we set this variable to 1 to
3991 give up on handling REPLACE in the optimized way. */
3992 int giveup_match_end
= 0;
3994 if (XINT (beg
) != 0)
3996 if (lseek (fd
, XINT (beg
), 0) < 0)
3997 report_file_error ("Setting file position",
3998 Fcons (orig_filename
, Qnil
));
4003 /* Count how many chars at the start of the file
4004 match the text at the beginning of the buffer. */
4009 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4011 error ("IO error reading %s: %s",
4012 SDATA (orig_filename
), emacs_strerror (errno
));
4013 else if (nread
== 0)
4016 if (CODING_REQUIRE_DETECTION (&coding
))
4018 coding_system
= detect_coding_system (buffer
, nread
, nread
, 1, 0,
4020 setup_coding_system (coding_system
, &coding
);
4023 if (CODING_REQUIRE_DECODING (&coding
))
4024 /* We found that the file should be decoded somehow.
4025 Let's give up here. */
4027 giveup_match_end
= 1;
4032 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4033 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4034 same_at_start
++, bufpos
++;
4035 /* If we found a discrepancy, stop the scan.
4036 Otherwise loop around and scan the next bufferful. */
4037 if (bufpos
!= nread
)
4041 /* If the file matches the buffer completely,
4042 there's no need to replace anything. */
4043 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4047 /* Truncate the buffer to the size of the file. */
4048 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4053 /* Count how many chars at the end of the file
4054 match the text at the end of the buffer. But, if we have
4055 already found that decoding is necessary, don't waste time. */
4056 while (!giveup_match_end
)
4058 int total_read
, nread
, bufpos
, curpos
, trial
;
4060 /* At what file position are we now scanning? */
4061 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4062 /* If the entire file matches the buffer tail, stop the scan. */
4065 /* How much can we scan in the next step? */
4066 trial
= min (curpos
, sizeof buffer
);
4067 if (lseek (fd
, curpos
- trial
, 0) < 0)
4068 report_file_error ("Setting file position",
4069 Fcons (orig_filename
, Qnil
));
4071 total_read
= nread
= 0;
4072 while (total_read
< trial
)
4074 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4076 error ("IO error reading %s: %s",
4077 SDATA (orig_filename
), emacs_strerror (errno
));
4078 else if (nread
== 0)
4080 total_read
+= nread
;
4083 /* Scan this bufferful from the end, comparing with
4084 the Emacs buffer. */
4085 bufpos
= total_read
;
4087 /* Compare with same_at_start to avoid counting some buffer text
4088 as matching both at the file's beginning and at the end. */
4089 while (bufpos
> 0 && same_at_end
> same_at_start
4090 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4091 same_at_end
--, bufpos
--;
4093 /* If we found a discrepancy, stop the scan.
4094 Otherwise loop around and scan the preceding bufferful. */
4097 /* If this discrepancy is because of code conversion,
4098 we cannot use this method; giveup and try the other. */
4099 if (same_at_end
> same_at_start
4100 && FETCH_BYTE (same_at_end
- 1) >= 0200
4101 && ! NILP (current_buffer
->enable_multibyte_characters
)
4102 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4103 giveup_match_end
= 1;
4112 if (! giveup_match_end
)
4116 /* We win! We can handle REPLACE the optimized way. */
4118 /* Extend the start of non-matching text area to multibyte
4119 character boundary. */
4120 if (! NILP (current_buffer
->enable_multibyte_characters
))
4121 while (same_at_start
> BEGV_BYTE
4122 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4125 /* Extend the end of non-matching text area to multibyte
4126 character boundary. */
4127 if (! NILP (current_buffer
->enable_multibyte_characters
))
4128 while (same_at_end
< ZV_BYTE
4129 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4132 /* Don't try to reuse the same piece of text twice. */
4133 overlap
= (same_at_start
- BEGV_BYTE
4134 - (same_at_end
+ st
.st_size
- ZV
));
4136 same_at_end
+= overlap
;
4138 /* Arrange to read only the nonmatching middle part of the file. */
4139 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4140 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4142 del_range_byte (same_at_start
, same_at_end
, 0);
4143 /* Insert from the file at the proper position. */
4144 temp
= BYTE_TO_CHAR (same_at_start
);
4145 SET_PT_BOTH (temp
, same_at_start
);
4147 /* If display currently starts at beginning of line,
4148 keep it that way. */
4149 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4150 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4152 replace_handled
= 1;
4156 /* If requested, replace the accessible part of the buffer
4157 with the file contents. Avoid replacing text at the
4158 beginning or end of the buffer that matches the file contents;
4159 that preserves markers pointing to the unchanged parts.
4161 Here we implement this feature for the case where code conversion
4162 is needed, in a simple way that needs a lot of memory.
4163 The preceding if-statement handles the case of no conversion
4164 in a more optimized way. */
4165 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4167 int same_at_start
= BEGV_BYTE
;
4168 int same_at_end
= ZV_BYTE
;
4169 int same_at_start_charpos
;
4173 unsigned char *decoded
;
4175 int this_count
= SPECPDL_INDEX ();
4176 int multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
4177 Lisp_Object conversion_buffer
;
4179 conversion_buffer
= code_conversion_save (1, multibyte
);
4181 /* First read the whole file, performing code conversion into
4182 CONVERSION_BUFFER. */
4184 if (lseek (fd
, XINT (beg
), 0) < 0)
4185 report_file_error ("Setting file position",
4186 Fcons (orig_filename
, Qnil
));
4188 total
= st
.st_size
; /* Total bytes in the file. */
4189 how_much
= 0; /* Bytes read from file so far. */
4190 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4191 unprocessed
= 0; /* Bytes not processed in previous loop. */
4193 GCPRO1 (conversion_buffer
);
4194 while (how_much
< total
)
4196 /* We read one bunch by one (READ_BUF_SIZE bytes) to allow
4197 quitting while reading a huge while. */
4198 /* try is reserved in some compilers (Microsoft C) */
4199 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4202 /* Allow quitting out of the actual I/O. */
4205 this = emacs_read (fd
, read_buf
+ unprocessed
, trytry
);
4217 BUF_SET_PT (XBUFFER (conversion_buffer
),
4218 BUF_Z (XBUFFER (conversion_buffer
)));
4219 decode_coding_c_string (&coding
, read_buf
, unprocessed
+ this,
4221 unprocessed
= coding
.carryover_bytes
;
4222 if (coding
.carryover_bytes
> 0)
4223 bcopy (coding
.carryover
, read_buf
, unprocessed
);
4228 /* At this point, HOW_MUCH should equal TOTAL, or should be <= 0
4229 if we couldn't read the file. */
4234 error ("IO error reading %s: %s",
4235 SDATA (orig_filename
), emacs_strerror (errno
));
4236 else if (how_much
== -2)
4237 error ("maximum buffer size exceeded");
4240 if (unprocessed
> 0)
4242 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4243 decode_coding_c_string (&coding
, read_buf
, unprocessed
,
4245 coding
.mode
&= ~CODING_MODE_LAST_BLOCK
;
4248 decoded
= BUF_BEG_ADDR (XBUFFER (conversion_buffer
));
4249 inserted
= (BUF_Z_BYTE (XBUFFER (conversion_buffer
))
4250 - BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
4252 /* Compare the beginning of the converted string with the buffer
4256 while (bufpos
< inserted
&& same_at_start
< same_at_end
4257 && FETCH_BYTE (same_at_start
) == decoded
[bufpos
])
4258 same_at_start
++, bufpos
++;
4260 /* If the file matches the head of buffer completely,
4261 there's no need to replace anything. */
4263 if (bufpos
== inserted
)
4266 /* Truncate the buffer to the size of the file. */
4267 del_range_byte (same_at_start
, same_at_end
, 0);
4270 unbind_to (this_count
, Qnil
);
4274 /* Extend the start of non-matching text area to the previous
4275 multibyte character boundary. */
4276 if (! NILP (current_buffer
->enable_multibyte_characters
))
4277 while (same_at_start
> BEGV_BYTE
4278 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4281 /* Scan this bufferful from the end, comparing with
4282 the Emacs buffer. */
4285 /* Compare with same_at_start to avoid counting some buffer text
4286 as matching both at the file's beginning and at the end. */
4287 while (bufpos
> 0 && same_at_end
> same_at_start
4288 && FETCH_BYTE (same_at_end
- 1) == decoded
[bufpos
- 1])
4289 same_at_end
--, bufpos
--;
4291 /* Extend the end of non-matching text area to the next
4292 multibyte character boundary. */
4293 if (! NILP (current_buffer
->enable_multibyte_characters
))
4294 while (same_at_end
< ZV_BYTE
4295 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4298 /* Don't try to reuse the same piece of text twice. */
4299 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4301 same_at_end
+= overlap
;
4303 /* If display currently starts at beginning of line,
4304 keep it that way. */
4305 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4306 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4308 /* Replace the chars that we need to replace,
4309 and update INSERTED to equal the number of bytes
4310 we are taking from the decoded string. */
4311 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4313 if (same_at_end
!= same_at_start
)
4315 del_range_byte (same_at_start
, same_at_end
, 0);
4317 same_at_start
= GPT_BYTE
;
4321 temp
= BYTE_TO_CHAR (same_at_start
);
4323 /* Insert from the file at the proper position. */
4324 SET_PT_BOTH (temp
, same_at_start
);
4325 same_at_start_charpos
4326 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4329 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4330 same_at_start
+ inserted
)
4331 - same_at_start_charpos
);
4332 insert_from_buffer (XBUFFER (conversion_buffer
),
4333 same_at_start_charpos
, inserted_chars
, 0);
4334 /* Set `inserted' to the number of inserted characters. */
4335 inserted
= PT
- temp
;
4337 unbind_to (this_count
, Qnil
);
4344 register Lisp_Object temp
;
4346 total
= XINT (end
) - XINT (beg
);
4348 /* Make sure point-max won't overflow after this insertion. */
4349 XSETINT (temp
, total
);
4350 if (total
!= XINT (temp
))
4351 error ("Maximum buffer size exceeded");
4354 /* For a special file, all we can do is guess. */
4355 total
= READ_BUF_SIZE
;
4357 if (NILP (visit
) && total
> 0)
4358 prepare_to_modify_buffer (PT
, PT
, NULL
);
4361 if (GAP_SIZE
< total
)
4362 make_gap (total
- GAP_SIZE
);
4364 if (XINT (beg
) != 0 || !NILP (replace
))
4366 if (lseek (fd
, XINT (beg
), 0) < 0)
4367 report_file_error ("Setting file position",
4368 Fcons (orig_filename
, Qnil
));
4371 /* In the following loop, HOW_MUCH contains the total bytes read so
4372 far for a regular file, and not changed for a special file. But,
4373 before exiting the loop, it is set to a negative value if I/O
4377 /* Total bytes inserted. */
4380 /* Here, we don't do code conversion in the loop. It is done by
4381 decode_coding_gap after all data are read into the buffer. */
4383 int gap_size
= GAP_SIZE
;
4385 while (how_much
< total
)
4387 /* try is reserved in some compilers (Microsoft C) */
4388 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4395 /* Maybe make more room. */
4396 if (gap_size
< trytry
)
4398 make_gap (total
- gap_size
);
4399 gap_size
= GAP_SIZE
;
4402 /* Read from the file, capturing `quit'. When an
4403 error occurs, end the loop, and arrange for a quit
4404 to be signaled after decoding the text we read. */
4405 non_regular_fd
= fd
;
4406 non_regular_inserted
= inserted
;
4407 non_regular_nbytes
= trytry
;
4408 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4409 read_non_regular_quit
);
4420 /* Allow quitting out of the actual I/O. We don't make text
4421 part of the buffer until all the reading is done, so a C-g
4422 here doesn't do any harm. */
4425 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4437 /* For a regular file, where TOTAL is the real size,
4438 count HOW_MUCH to compare with it.
4439 For a special file, where TOTAL is just a buffer size,
4440 so don't bother counting in HOW_MUCH.
4441 (INSERTED is where we count the number of characters inserted.) */
4448 /* Make the text read part of the buffer. */
4449 GAP_SIZE
-= inserted
;
4451 GPT_BYTE
+= inserted
;
4453 ZV_BYTE
+= inserted
;
4458 /* Put an anchor to ensure multi-byte form ends at gap. */
4463 /* Discard the unwind protect for closing the file. */
4467 error ("IO error reading %s: %s",
4468 SDATA (orig_filename
), emacs_strerror (errno
));
4472 if (NILP (coding_system
))
4474 /* The coding system is not yet decided. Decide it by an
4475 optimized method for handling `coding:' tag.
4477 Note that we can get here only if the buffer was empty
4478 before the insertion. */
4480 if (!NILP (Vcoding_system_for_read
))
4481 coding_system
= Vcoding_system_for_read
;
4484 /* Since we are sure that the current buffer was empty
4485 before the insertion, we can toggle
4486 enable-multibyte-characters directly here without taking
4487 care of marker adjustment. By this way, we can run Lisp
4488 program safely before decoding the inserted text. */
4489 Lisp_Object unwind_data
;
4490 int count
= SPECPDL_INDEX ();
4492 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4493 Fcons (current_buffer
->undo_list
,
4494 Fcurrent_buffer ()));
4495 current_buffer
->enable_multibyte_characters
= Qnil
;
4496 current_buffer
->undo_list
= Qt
;
4497 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4499 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4501 coding_system
= call2 (Vset_auto_coding_function
,
4502 filename
, make_number (inserted
));
4505 if (NILP (coding_system
))
4507 /* If the coding system is not yet decided, check
4508 file-coding-system-alist. */
4509 Lisp_Object args
[6];
4511 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4512 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4513 coding_system
= Ffind_operation_coding_system (6, args
);
4514 if (CONSP (coding_system
))
4515 coding_system
= XCAR (coding_system
);
4518 unbind_to (count
, Qnil
);
4519 inserted
= Z_BYTE
- BEG_BYTE
;
4522 if (NILP (coding_system
))
4523 coding_system
= Qundecided
;
4525 CHECK_CODING_SYSTEM (coding_system
);
4527 if (NILP (current_buffer
->enable_multibyte_characters
))
4528 /* We must suppress all character code conversion except for
4529 end-of-line conversion. */
4530 coding_system
= raw_text_coding_system (coding_system
);
4531 setup_coding_system (coding_system
, &coding
);
4532 /* Ensure we set Vlast_coding_system_used. */
4533 set_coding_system
= 1;
4538 /* When we visit a file by raw-text, we change the buffer to
4540 if (CODING_FOR_UNIBYTE (&coding
)
4541 /* Can't do this if part of the buffer might be preserved. */
4543 /* Visiting a file with these coding system makes the buffer
4545 current_buffer
->enable_multibyte_characters
= Qnil
;
4548 coding
.dst_multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
4549 if (CODING_MAY_REQUIRE_DECODING (&coding
)
4550 && (inserted
> 0 || CODING_REQUIRE_FLUSHING (&coding
)))
4552 move_gap_both (PT
, PT_BYTE
);
4553 GAP_SIZE
+= inserted
;
4554 ZV_BYTE
-= inserted
;
4558 decode_coding_gap (&coding
, inserted
, inserted
);
4559 inserted
= coding
.produced_char
;
4560 coding_system
= CODING_ID_NAME (coding
.id
);
4562 else if (inserted
> 0)
4563 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4566 /* Now INSERTED is measured in characters. */
4569 /* Use the conversion type to determine buffer-file-type
4570 (find-buffer-file-type is now used to help determine the
4572 if ((VECTORP (CODING_ID_EOL_TYPE (coding
.id
))
4573 || EQ (CODING_ID_EOL_TYPE (coding
.id
), Qunix
))
4574 && ! CODING_REQUIRE_DECODING (&coding
))
4575 current_buffer
->buffer_file_type
= Qt
;
4577 current_buffer
->buffer_file_type
= Qnil
;
4584 if (!EQ (current_buffer
->undo_list
, Qt
))
4585 current_buffer
->undo_list
= Qnil
;
4587 stat (SDATA (filename
), &st
);
4592 current_buffer
->modtime
= st
.st_mtime
;
4593 current_buffer
->filename
= orig_filename
;
4596 SAVE_MODIFF
= MODIFF
;
4597 current_buffer
->auto_save_modified
= MODIFF
;
4598 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4599 #ifdef CLASH_DETECTION
4602 if (!NILP (current_buffer
->file_truename
))
4603 unlock_file (current_buffer
->file_truename
);
4604 unlock_file (filename
);
4606 #endif /* CLASH_DETECTION */
4608 Fsignal (Qfile_error
,
4609 Fcons (build_string ("not a regular file"),
4610 Fcons (orig_filename
, Qnil
)));
4613 if (set_coding_system
)
4614 Vlast_coding_system_used
= coding_system
;
4616 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4618 insval
= call1 (Qafter_insert_file_set_coding
, make_number (inserted
));
4619 if (! NILP (insval
))
4621 CHECK_NUMBER (insval
);
4622 inserted
= XFASTINT (insval
);
4626 /* Decode file format */
4629 int empty_undo_list_p
= 0;
4631 /* If we're anyway going to discard undo information, don't
4632 record it in the first place. The buffer's undo list at this
4633 point is either nil or t when visiting a file. */
4636 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4637 current_buffer
->undo_list
= Qt
;
4640 insval
= call3 (Qformat_decode
,
4641 Qnil
, make_number (inserted
), visit
);
4642 CHECK_NUMBER (insval
);
4643 inserted
= XFASTINT (insval
);
4646 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4649 /* Call after-change hooks for the inserted text, aside from the case
4650 of normal visiting (not with REPLACE), which is done in a new buffer
4651 "before" the buffer is changed. */
4652 if (inserted
> 0 && total
> 0
4653 && (NILP (visit
) || !NILP (replace
)))
4655 signal_after_change (PT
, 0, inserted
);
4656 update_compositions (PT
, PT
, CHECK_BORDER
);
4659 p
= Vafter_insert_file_functions
;
4662 insval
= call1 (XCAR (p
), make_number (inserted
));
4665 CHECK_NUMBER (insval
);
4666 inserted
= XFASTINT (insval
);
4673 && current_buffer
->modtime
== -1)
4675 /* If visiting nonexistent file, return nil. */
4676 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4680 Fsignal (Qquit
, Qnil
);
4682 /* ??? Retval needs to be dealt with in all cases consistently. */
4684 val
= Fcons (orig_filename
,
4685 Fcons (make_number (inserted
),
4688 RETURN_UNGCPRO (unbind_to (count
, val
));
4691 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4693 /* If build_annotations switched buffers, switch back to BUF.
4694 Kill the temporary buffer that was selected in the meantime.
4696 Since this kill only the last temporary buffer, some buffers remain
4697 not killed if build_annotations switched buffers more than once.
4701 build_annotations_unwind (buf
)
4706 if (XBUFFER (buf
) == current_buffer
)
4708 tembuf
= Fcurrent_buffer ();
4710 Fkill_buffer (tembuf
);
4714 /* Decide the coding-system to encode the data with. */
4717 choose_write_coding_system (start
, end
, filename
,
4718 append
, visit
, lockname
, coding
)
4719 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4720 struct coding_system
*coding
;
4725 && NILP (Fstring_equal (current_buffer
->filename
,
4726 current_buffer
->auto_save_file_name
)))
4728 else if (!NILP (Vcoding_system_for_write
))
4730 val
= Vcoding_system_for_write
;
4731 if (coding_system_require_warning
4732 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4733 /* Confirm that VAL can surely encode the current region. */
4734 val
= call5 (Vselect_safe_coding_system_function
,
4735 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4740 /* If the variable `buffer-file-coding-system' is set locally,
4741 it means that the file was read with some kind of code
4742 conversion or the variable is explicitly set by users. We
4743 had better write it out with the same coding system even if
4744 `enable-multibyte-characters' is nil.
4746 If it is not set locally, we anyway have to convert EOL
4747 format if the default value of `buffer-file-coding-system'
4748 tells that it is not Unix-like (LF only) format. */
4749 int using_default_coding
= 0;
4750 int force_raw_text
= 0;
4752 val
= current_buffer
->buffer_file_coding_system
;
4754 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4757 if (NILP (current_buffer
->enable_multibyte_characters
))
4763 /* Check file-coding-system-alist. */
4764 Lisp_Object args
[7], coding_systems
;
4766 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4767 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4769 coding_systems
= Ffind_operation_coding_system (7, args
);
4770 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4771 val
= XCDR (coding_systems
);
4776 /* If we still have not decided a coding system, use the
4777 default value of buffer-file-coding-system. */
4778 val
= current_buffer
->buffer_file_coding_system
;
4779 using_default_coding
= 1;
4782 if (! NILP (val
) && ! force_raw_text
)
4784 Lisp_Object spec
, attrs
;
4786 CHECK_CODING_SYSTEM_GET_SPEC (val
, spec
);
4787 attrs
= AREF (spec
, 0);
4788 if (EQ (CODING_ATTR_TYPE (attrs
), Qraw_text
))
4793 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4794 /* Confirm that VAL can surely encode the current region. */
4795 val
= call5 (Vselect_safe_coding_system_function
,
4796 start
, end
, val
, Qnil
, filename
);
4798 /* If the decided coding-system doesn't specify end-of-line
4799 format, we use that of
4800 `default-buffer-file-coding-system'. */
4801 if (! using_default_coding
4802 && ! NILP (buffer_defaults
.buffer_file_coding_system
))
4803 val
= (coding_inherit_eol_type
4804 (val
, buffer_defaults
.buffer_file_coding_system
));
4806 /* If we decide not to encode text, use `raw-text' or one of its
4809 val
= raw_text_coding_system (val
);
4812 setup_coding_system (val
, coding
);
4814 && VECTORP (CODING_ID_EOL_TYPE (coding
->id
)))
4815 val
= AREF (CODING_ID_EOL_TYPE (coding
->id
), 0);
4817 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4818 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4822 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4823 "r\nFWrite region to file: \ni\ni\ni\np",
4824 doc
: /* Write current region into specified file.
4825 When called from a program, requires three arguments:
4826 START, END and FILENAME. START and END are normally buffer positions
4827 specifying the part of the buffer to write.
4828 If START is nil, that means to use the entire buffer contents.
4829 If START is a string, then output that string to the file
4830 instead of any buffer contents; END is ignored.
4832 Optional fourth argument APPEND if non-nil means
4833 append to existing file contents (if any). If it is an integer,
4834 seek to that offset in the file before writing.
4835 Optional fifth argument VISIT, if t or a string, means
4836 set the last-save-file-modtime of buffer to this file's modtime
4837 and mark buffer not modified.
4838 If VISIT is a string, it is a second file name;
4839 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4840 VISIT is also the file name to lock and unlock for clash detection.
4841 If VISIT is neither t nor nil nor a string,
4842 that means do not display the \"Wrote file\" message.
4843 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4844 use for locking and unlocking, overriding FILENAME and VISIT.
4845 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4846 for an existing file with the same name. If MUSTBENEW is `excl',
4847 that means to get an error if the file already exists; never overwrite.
4848 If MUSTBENEW is neither nil nor `excl', that means ask for
4849 confirmation before overwriting, but do go ahead and overwrite the file
4850 if the user confirms.
4852 This does code conversion according to the value of
4853 `coding-system-for-write', `buffer-file-coding-system', or
4854 `file-coding-system-alist', and sets the variable
4855 `last-coding-system-used' to the coding system actually used. */)
4856 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4857 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4862 const unsigned char *fn
;
4864 int count
= SPECPDL_INDEX ();
4867 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4869 Lisp_Object handler
;
4870 Lisp_Object visit_file
;
4871 Lisp_Object annotations
;
4872 Lisp_Object encoded_filename
;
4873 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4874 int quietly
= !NILP (visit
);
4875 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4876 struct buffer
*given_buffer
;
4878 int buffer_file_type
= O_BINARY
;
4880 struct coding_system coding
;
4882 if (current_buffer
->base_buffer
&& visiting
)
4883 error ("Cannot do file visiting in an indirect buffer");
4885 if (!NILP (start
) && !STRINGP (start
))
4886 validate_region (&start
, &end
);
4888 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4890 filename
= Fexpand_file_name (filename
, Qnil
);
4892 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4893 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4895 if (STRINGP (visit
))
4896 visit_file
= Fexpand_file_name (visit
, Qnil
);
4898 visit_file
= filename
;
4900 if (NILP (lockname
))
4901 lockname
= visit_file
;
4905 /* If the file name has special constructs in it,
4906 call the corresponding file handler. */
4907 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4908 /* If FILENAME has no handler, see if VISIT has one. */
4909 if (NILP (handler
) && STRINGP (visit
))
4910 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4912 if (!NILP (handler
))
4915 val
= call6 (handler
, Qwrite_region
, start
, end
,
4916 filename
, append
, visit
);
4920 SAVE_MODIFF
= MODIFF
;
4921 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4922 current_buffer
->filename
= visit_file
;
4928 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4930 /* Special kludge to simplify auto-saving. */
4933 XSETFASTINT (start
, BEG
);
4934 XSETFASTINT (end
, Z
);
4938 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4939 count1
= SPECPDL_INDEX ();
4941 given_buffer
= current_buffer
;
4943 if (!STRINGP (start
))
4945 annotations
= build_annotations (start
, end
);
4947 if (current_buffer
!= given_buffer
)
4949 XSETFASTINT (start
, BEGV
);
4950 XSETFASTINT (end
, ZV
);
4956 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4958 /* Decide the coding-system to encode the data with.
4959 We used to make this choice before calling build_annotations, but that
4960 leads to problems when a write-annotate-function takes care of
4961 unsavable chars (as was the case with X-Symbol). */
4962 Vlast_coding_system_used
4963 = choose_write_coding_system (start
, end
, filename
,
4964 append
, visit
, lockname
, &coding
);
4966 #ifdef CLASH_DETECTION
4969 #if 0 /* This causes trouble for GNUS. */
4970 /* If we've locked this file for some other buffer,
4971 query before proceeding. */
4972 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4973 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4976 lock_file (lockname
);
4978 #endif /* CLASH_DETECTION */
4980 encoded_filename
= ENCODE_FILE (filename
);
4982 fn
= SDATA (encoded_filename
);
4986 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
4987 #else /* not DOS_NT */
4988 desc
= emacs_open (fn
, O_WRONLY
, 0);
4989 #endif /* not DOS_NT */
4991 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4993 if (auto_saving
) /* Overwrite any previous version of autosave file */
4995 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4996 desc
= emacs_open (fn
, O_RDWR
, 0);
4998 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4999 ? SDATA (current_buffer
->filename
) : 0,
5002 else /* Write to temporary name and rename if no errors */
5004 Lisp_Object temp_name
;
5005 temp_name
= Ffile_name_directory (filename
);
5007 if (!NILP (temp_name
))
5009 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5010 build_string ("$$SAVE$$")));
5011 fname
= SDATA (filename
);
5012 fn
= SDATA (temp_name
);
5013 desc
= creat_copy_attrs (fname
, fn
);
5016 /* If we can't open the temporary file, try creating a new
5017 version of the original file. VMS "creat" creates a
5018 new version rather than truncating an existing file. */
5021 desc
= creat (fn
, 0666);
5022 #if 0 /* This can clobber an existing file and fail to replace it,
5023 if the user runs out of space. */
5026 /* We can't make a new version;
5027 try to truncate and rewrite existing version if any. */
5029 desc
= emacs_open (fn
, O_RDWR
, 0);
5035 desc
= creat (fn
, 0666);
5039 desc
= emacs_open (fn
,
5040 O_WRONLY
| O_CREAT
| buffer_file_type
5041 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5042 S_IREAD
| S_IWRITE
);
5043 #else /* not DOS_NT */
5044 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5045 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5046 auto_saving
? auto_save_mode_bits
: 0666);
5047 #endif /* not DOS_NT */
5048 #endif /* not VMS */
5052 #ifdef CLASH_DETECTION
5054 if (!auto_saving
) unlock_file (lockname
);
5056 #endif /* CLASH_DETECTION */
5058 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5061 record_unwind_protect (close_file_unwind
, make_number (desc
));
5063 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5067 if (NUMBERP (append
))
5068 ret
= lseek (desc
, XINT (append
), 1);
5070 ret
= lseek (desc
, 0, 2);
5073 #ifdef CLASH_DETECTION
5074 if (!auto_saving
) unlock_file (lockname
);
5075 #endif /* CLASH_DETECTION */
5077 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5085 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5086 * if we do writes that don't end with a carriage return. Furthermore
5087 * it cannot handle writes of more then 16K. The modified
5088 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5089 * this EXCEPT for the last record (iff it doesn't end with a carriage
5090 * return). This implies that if your buffer doesn't end with a carriage
5091 * return, you get one free... tough. However it also means that if
5092 * we make two calls to sys_write (a la the following code) you can
5093 * get one at the gap as well. The easiest way to fix this (honest)
5094 * is to move the gap to the next newline (or the end of the buffer).
5099 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5100 move_gap (find_next_newline (GPT
, 1));
5103 /* The new encoding routine doesn't require the following. */
5105 /* Whether VMS or not, we must move the gap to the next of newline
5106 when we must put designation sequences at beginning of line. */
5107 if (INTEGERP (start
)
5108 && coding
.type
== coding_type_iso2022
5109 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5110 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5112 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5113 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5114 move_gap_both (PT
, PT_BYTE
);
5115 SET_PT_BOTH (opoint
, opoint_byte
);
5123 if (STRINGP (start
))
5125 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5126 &annotations
, &coding
);
5129 else if (XINT (start
) != XINT (end
))
5131 failure
= 0 > a_write (desc
, Qnil
,
5132 XINT (start
), XINT (end
) - XINT (start
),
5133 &annotations
, &coding
);
5138 /* If file was empty, still need to write the annotations */
5139 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5140 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5144 if (CODING_REQUIRE_FLUSHING (&coding
)
5145 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5148 /* We have to flush out a data. */
5149 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5150 failure
= 0 > e_write (desc
, Qnil
, 1, 1, &coding
);
5157 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5158 Disk full in NFS may be reported here. */
5159 /* mib says that closing the file will try to write as fast as NFS can do
5160 it, and that means the fsync here is not crucial for autosave files. */
5161 if (!auto_saving
&& fsync (desc
) < 0)
5163 /* If fsync fails with EINTR, don't treat that as serious. */
5165 failure
= 1, save_errno
= errno
;
5169 /* Spurious "file has changed on disk" warnings have been
5170 observed on Suns as well.
5171 It seems that `close' can change the modtime, under nfs.
5173 (This has supposedly been fixed in Sunos 4,
5174 but who knows about all the other machines with NFS?) */
5177 /* On VMS and APOLLO, must do the stat after the close
5178 since closing changes the modtime. */
5181 /* Recall that #if defined does not work on VMS. */
5188 /* NFS can report a write failure now. */
5189 if (emacs_close (desc
) < 0)
5190 failure
= 1, save_errno
= errno
;
5193 /* If we wrote to a temporary name and had no errors, rename to real name. */
5197 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5205 /* Discard the unwind protect for close_file_unwind. */
5206 specpdl_ptr
= specpdl
+ count1
;
5207 /* Restore the original current buffer. */
5208 visit_file
= unbind_to (count
, visit_file
);
5210 #ifdef CLASH_DETECTION
5212 unlock_file (lockname
);
5213 #endif /* CLASH_DETECTION */
5215 /* Do this before reporting IO error
5216 to avoid a "file has changed on disk" warning on
5217 next attempt to save. */
5219 current_buffer
->modtime
= st
.st_mtime
;
5222 error ("IO error writing %s: %s", SDATA (filename
),
5223 emacs_strerror (save_errno
));
5227 SAVE_MODIFF
= MODIFF
;
5228 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5229 current_buffer
->filename
= visit_file
;
5230 update_mode_lines
++;
5235 && ! NILP (Fstring_equal (current_buffer
->filename
,
5236 current_buffer
->auto_save_file_name
)))
5237 SAVE_MODIFF
= MODIFF
;
5243 message_with_string ((INTEGERP (append
)
5253 Lisp_Object
merge ();
5255 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5256 doc
: /* Return t if (car A) is numerically less than (car B). */)
5260 return Flss (Fcar (a
), Fcar (b
));
5263 /* Build the complete list of annotations appropriate for writing out
5264 the text between START and END, by calling all the functions in
5265 write-region-annotate-functions and merging the lists they return.
5266 If one of these functions switches to a different buffer, we assume
5267 that buffer contains altered text. Therefore, the caller must
5268 make sure to restore the current buffer in all cases,
5269 as save-excursion would do. */
5272 build_annotations (start
, end
)
5273 Lisp_Object start
, end
;
5275 Lisp_Object annotations
;
5277 struct gcpro gcpro1
, gcpro2
;
5278 Lisp_Object original_buffer
;
5279 int i
, used_global
= 0;
5281 XSETBUFFER (original_buffer
, current_buffer
);
5284 p
= Vwrite_region_annotate_functions
;
5285 GCPRO2 (annotations
, p
);
5288 struct buffer
*given_buffer
= current_buffer
;
5289 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5290 { /* Use the global value of the hook. */
5293 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5295 p
= Fappend (2, arg
);
5298 Vwrite_region_annotations_so_far
= annotations
;
5299 res
= call2 (XCAR (p
), start
, end
);
5300 /* If the function makes a different buffer current,
5301 assume that means this buffer contains altered text to be output.
5302 Reset START and END from the buffer bounds
5303 and discard all previous annotations because they should have
5304 been dealt with by this function. */
5305 if (current_buffer
!= given_buffer
)
5307 XSETFASTINT (start
, BEGV
);
5308 XSETFASTINT (end
, ZV
);
5311 Flength (res
); /* Check basic validity of return value */
5312 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5316 /* Now do the same for annotation functions implied by the file-format */
5317 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
5318 p
= current_buffer
->auto_save_file_format
;
5320 p
= current_buffer
->file_format
;
5321 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5323 struct buffer
*given_buffer
= current_buffer
;
5325 Vwrite_region_annotations_so_far
= annotations
;
5327 /* Value is either a list of annotations or nil if the function
5328 has written annotations to a temporary buffer, which is now
5330 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5331 original_buffer
, make_number (i
));
5332 if (current_buffer
!= given_buffer
)
5334 XSETFASTINT (start
, BEGV
);
5335 XSETFASTINT (end
, ZV
);
5340 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5348 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5349 If STRING is nil, POS is the character position in the current buffer.
5350 Intersperse with them the annotations from *ANNOT
5351 which fall within the range of POS to POS + NCHARS,
5352 each at its appropriate position.
5354 We modify *ANNOT by discarding elements as we use them up.
5356 The return value is negative in case of system call failure. */
5359 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5362 register int nchars
;
5365 struct coding_system
*coding
;
5369 int lastpos
= pos
+ nchars
;
5371 while (NILP (*annot
) || CONSP (*annot
))
5373 tem
= Fcar_safe (Fcar (*annot
));
5376 nextpos
= XFASTINT (tem
);
5378 /* If there are no more annotations in this range,
5379 output the rest of the range all at once. */
5380 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5381 return e_write (desc
, string
, pos
, lastpos
, coding
);
5383 /* Output buffer text up to the next annotation's position. */
5386 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5390 /* Output the annotation. */
5391 tem
= Fcdr (Fcar (*annot
));
5394 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5397 *annot
= Fcdr (*annot
);
5403 /* Write text in the range START and END into descriptor DESC,
5404 encoding them with coding system CODING. If STRING is nil, START
5405 and END are character positions of the current buffer, else they
5406 are indexes to the string STRING. */
5409 e_write (desc
, string
, start
, end
, coding
)
5413 struct coding_system
*coding
;
5415 if (STRINGP (string
))
5418 end
= SCHARS (string
);
5421 /* We used to have a code for handling selective display here. But,
5422 now it is handled within encode_coding. */
5426 if (STRINGP (string
))
5428 coding
->src_multibyte
= SCHARS (string
) < SBYTES (string
);
5429 if (CODING_REQUIRE_ENCODING (coding
))
5431 encode_coding_object (coding
, string
,
5432 start
, string_char_to_byte (string
, start
),
5433 end
, string_char_to_byte (string
, end
), Qt
);
5437 coding
->dst_object
= string
;
5438 coding
->consumed_char
= SCHARS (string
);
5439 coding
->produced
= SBYTES (string
);
5444 int start_byte
= CHAR_TO_BYTE (start
);
5445 int end_byte
= CHAR_TO_BYTE (end
);
5447 coding
->src_multibyte
= (end
- start
) < (end_byte
- start_byte
);
5448 if (CODING_REQUIRE_ENCODING (coding
))
5450 encode_coding_object (coding
, Fcurrent_buffer (),
5451 start
, start_byte
, end
, end_byte
, Qt
);
5455 coding
->dst_object
= Qnil
;
5456 coding
->dst_pos_byte
= start_byte
;
5457 if (start
>= GPT
|| end
<= GPT
)
5459 coding
->consumed_char
= end
- start
;
5460 coding
->produced
= end_byte
- start_byte
;
5464 coding
->consumed_char
= GPT
- start
;
5465 coding
->produced
= GPT_BYTE
- start_byte
;
5470 if (coding
->produced
> 0)
5474 STRINGP (coding
->dst_object
)
5475 ? SDATA (coding
->dst_object
)
5476 : BYTE_POS_ADDR (coding
->dst_pos_byte
),
5479 if (coding
->produced
)
5482 start
+= coding
->consumed_char
;
5488 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5489 Sverify_visited_file_modtime
, 1, 1, 0,
5490 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5491 This means that the file has not been changed since it was visited or saved.
5492 See Info node `(elisp)Modification Time' for more details. */)
5498 Lisp_Object handler
;
5499 Lisp_Object filename
;
5504 if (!STRINGP (b
->filename
)) return Qt
;
5505 if (b
->modtime
== 0) return Qt
;
5507 /* If the file name has special constructs in it,
5508 call the corresponding file handler. */
5509 handler
= Ffind_file_name_handler (b
->filename
,
5510 Qverify_visited_file_modtime
);
5511 if (!NILP (handler
))
5512 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5514 filename
= ENCODE_FILE (b
->filename
);
5516 if (stat (SDATA (filename
), &st
) < 0)
5518 /* If the file doesn't exist now and didn't exist before,
5519 we say that it isn't modified, provided the error is a tame one. */
5520 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5525 if (st
.st_mtime
== b
->modtime
5526 /* If both are positive, accept them if they are off by one second. */
5527 || (st
.st_mtime
> 0 && b
->modtime
> 0
5528 && (st
.st_mtime
== b
->modtime
+ 1
5529 || st
.st_mtime
== b
->modtime
- 1)))
5534 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5535 Sclear_visited_file_modtime
, 0, 0, 0,
5536 doc
: /* Clear out records of last mod time of visited file.
5537 Next attempt to save will certainly not complain of a discrepancy. */)
5540 current_buffer
->modtime
= 0;
5544 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5545 Svisited_file_modtime
, 0, 0, 0,
5546 doc
: /* Return the current buffer's recorded visited file modification time.
5547 The value is a list of the form (HIGH LOW), like the time values
5548 that `file-attributes' returns. If the current buffer has no recorded
5549 file modification time, this function returns 0.
5550 See Info node `(elisp)Modification Time' for more details. */)
5554 tcons
= long_to_cons ((unsigned long) current_buffer
->modtime
);
5556 return list2 (XCAR (tcons
), XCDR (tcons
));
5560 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5561 Sset_visited_file_modtime
, 0, 1, 0,
5562 doc
: /* Update buffer's recorded modification time from the visited file's time.
5563 Useful if the buffer was not read from the file normally
5564 or if the file itself has been changed for some known benign reason.
5565 An argument specifies the modification time value to use
5566 \(instead of that of the visited file), in the form of a list
5567 \(HIGH . LOW) or (HIGH LOW). */)
5569 Lisp_Object time_list
;
5571 if (!NILP (time_list
))
5572 current_buffer
->modtime
= cons_to_long (time_list
);
5575 register Lisp_Object filename
;
5577 Lisp_Object handler
;
5579 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5581 /* If the file name has special constructs in it,
5582 call the corresponding file handler. */
5583 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5584 if (!NILP (handler
))
5585 /* The handler can find the file name the same way we did. */
5586 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5588 filename
= ENCODE_FILE (filename
);
5590 if (stat (SDATA (filename
), &st
) >= 0)
5591 current_buffer
->modtime
= st
.st_mtime
;
5598 auto_save_error (error
)
5601 Lisp_Object args
[3], msg
;
5603 struct gcpro gcpro1
;
5607 args
[0] = build_string ("Auto-saving %s: %s");
5608 args
[1] = current_buffer
->name
;
5609 args
[2] = Ferror_message_string (error
);
5610 msg
= Fformat (3, args
);
5612 nbytes
= SBYTES (msg
);
5614 for (i
= 0; i
< 3; ++i
)
5617 message2 (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5619 message2_nolog (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5620 Fsleep_for (make_number (1), Qnil
);
5632 /* Get visited file's mode to become the auto save file's mode. */
5633 if (! NILP (current_buffer
->filename
)
5634 && stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5635 /* But make sure we can overwrite it later! */
5636 auto_save_mode_bits
= st
.st_mode
| 0600;
5637 else if (! NILP (current_buffer
->filename
))
5638 /* Remote files don't cooperate with stat. */
5639 auto_save_mode_bits
= XINT (Ffile_modes (current_buffer
->filename
)) | 0600;
5641 auto_save_mode_bits
= 0666;
5644 Fwrite_region (Qnil
, Qnil
,
5645 current_buffer
->auto_save_file_name
,
5646 Qnil
, Qlambda
, Qnil
, Qnil
);
5650 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5655 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5656 | XFASTINT (XCDR (stream
))));
5661 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5664 minibuffer_auto_raise
= XINT (value
);
5669 do_auto_save_make_dir (dir
)
5672 return call2 (Qmake_directory
, dir
, Qt
);
5676 do_auto_save_eh (ignore
)
5682 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5683 doc
: /* Auto-save all buffers that need it.
5684 This is all buffers that have auto-saving enabled
5685 and are changed since last auto-saved.
5686 Auto-saving writes the buffer into a file
5687 so that your editing is not lost if the system crashes.
5688 This file is not the file you visited; that changes only when you save.
5689 Normally we run the normal hook `auto-save-hook' before saving.
5691 A non-nil NO-MESSAGE argument means do not print any message if successful.
5692 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5693 (no_message
, current_only
)
5694 Lisp_Object no_message
, current_only
;
5696 struct buffer
*old
= current_buffer
, *b
;
5697 Lisp_Object tail
, buf
;
5699 int do_handled_files
;
5702 Lisp_Object lispstream
;
5703 int count
= SPECPDL_INDEX ();
5704 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5705 int old_message_p
= 0;
5706 struct gcpro gcpro1
, gcpro2
;
5708 if (max_specpdl_size
< specpdl_size
+ 40)
5709 max_specpdl_size
= specpdl_size
+ 40;
5714 if (NILP (no_message
))
5716 old_message_p
= push_message ();
5717 record_unwind_protect (pop_message_unwind
, Qnil
);
5720 /* Ordinarily don't quit within this function,
5721 but don't make it impossible to quit (in case we get hung in I/O). */
5725 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5726 point to non-strings reached from Vbuffer_alist. */
5728 if (!NILP (Vrun_hooks
))
5729 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5731 if (STRINGP (Vauto_save_list_file_name
))
5733 Lisp_Object listfile
;
5735 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5737 /* Don't try to create the directory when shutting down Emacs,
5738 because creating the directory might signal an error, and
5739 that would leave Emacs in a strange state. */
5740 if (!NILP (Vrun_hooks
))
5744 GCPRO2 (dir
, listfile
);
5745 dir
= Ffile_name_directory (listfile
);
5746 if (NILP (Ffile_directory_p (dir
)))
5747 internal_condition_case_1 (do_auto_save_make_dir
,
5748 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5753 stream
= fopen (SDATA (listfile
), "w");
5756 /* Arrange to close that file whether or not we get an error.
5757 Also reset auto_saving to 0. */
5758 lispstream
= Fcons (Qnil
, Qnil
);
5759 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
5760 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
5771 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5772 record_unwind_protect (do_auto_save_unwind_1
,
5773 make_number (minibuffer_auto_raise
));
5774 minibuffer_auto_raise
= 0;
5777 /* On first pass, save all files that don't have handlers.
5778 On second pass, save all files that do have handlers.
5780 If Emacs is crashing, the handlers may tweak what is causing
5781 Emacs to crash in the first place, and it would be a shame if
5782 Emacs failed to autosave perfectly ordinary files because it
5783 couldn't handle some ange-ftp'd file. */
5785 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5786 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5788 buf
= XCDR (XCAR (tail
));
5791 /* Record all the buffers that have auto save mode
5792 in the special file that lists them. For each of these buffers,
5793 Record visited name (if any) and auto save name. */
5794 if (STRINGP (b
->auto_save_file_name
)
5795 && stream
!= NULL
&& do_handled_files
== 0)
5797 if (!NILP (b
->filename
))
5799 fwrite (SDATA (b
->filename
), 1,
5800 SBYTES (b
->filename
), stream
);
5802 putc ('\n', stream
);
5803 fwrite (SDATA (b
->auto_save_file_name
), 1,
5804 SBYTES (b
->auto_save_file_name
), stream
);
5805 putc ('\n', stream
);
5808 if (!NILP (current_only
)
5809 && b
!= current_buffer
)
5812 /* Don't auto-save indirect buffers.
5813 The base buffer takes care of it. */
5817 /* Check for auto save enabled
5818 and file changed since last auto save
5819 and file changed since last real save. */
5820 if (STRINGP (b
->auto_save_file_name
)
5821 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5822 && b
->auto_save_modified
< BUF_MODIFF (b
)
5823 /* -1 means we've turned off autosaving for a while--see below. */
5824 && XINT (b
->save_length
) >= 0
5825 && (do_handled_files
5826 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5829 EMACS_TIME before_time
, after_time
;
5831 EMACS_GET_TIME (before_time
);
5833 /* If we had a failure, don't try again for 20 minutes. */
5834 if (b
->auto_save_failure_time
>= 0
5835 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5838 if ((XFASTINT (b
->save_length
) * 10
5839 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5840 /* A short file is likely to change a large fraction;
5841 spare the user annoying messages. */
5842 && XFASTINT (b
->save_length
) > 5000
5843 /* These messages are frequent and annoying for `*mail*'. */
5844 && !EQ (b
->filename
, Qnil
)
5845 && NILP (no_message
))
5847 /* It has shrunk too much; turn off auto-saving here. */
5848 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5849 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5851 minibuffer_auto_raise
= 0;
5852 /* Turn off auto-saving until there's a real save,
5853 and prevent any more warnings. */
5854 XSETINT (b
->save_length
, -1);
5855 Fsleep_for (make_number (1), Qnil
);
5858 set_buffer_internal (b
);
5859 if (!auto_saved
&& NILP (no_message
))
5860 message1 ("Auto-saving...");
5861 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5863 b
->auto_save_modified
= BUF_MODIFF (b
);
5864 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5865 set_buffer_internal (old
);
5867 EMACS_GET_TIME (after_time
);
5869 /* If auto-save took more than 60 seconds,
5870 assume it was an NFS failure that got a timeout. */
5871 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5872 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5876 /* Prevent another auto save till enough input events come in. */
5877 record_auto_save ();
5879 if (auto_saved
&& NILP (no_message
))
5883 /* If we are going to restore an old message,
5884 give time to read ours. */
5885 sit_for (1, 0, 0, 0, 0);
5889 /* If we displayed a message and then restored a state
5890 with no message, leave a "done" message on the screen. */
5891 message1 ("Auto-saving...done");
5896 /* This restores the message-stack status. */
5897 unbind_to (count
, Qnil
);
5901 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5902 Sset_buffer_auto_saved
, 0, 0, 0,
5903 doc
: /* Mark current buffer as auto-saved with its current text.
5904 No auto-save file will be written until the buffer changes again. */)
5907 current_buffer
->auto_save_modified
= MODIFF
;
5908 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5909 current_buffer
->auto_save_failure_time
= -1;
5913 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5914 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5915 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5918 current_buffer
->auto_save_failure_time
= -1;
5922 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
5924 doc
: /* Return t if buffer has been auto-saved since last read in or saved. */)
5927 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
5930 /* Reading and completing file names */
5931 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
5933 /* In the string VAL, change each $ to $$ and return the result. */
5936 double_dollars (val
)
5939 register const unsigned char *old
;
5940 register unsigned char *new;
5944 osize
= SBYTES (val
);
5946 /* Count the number of $ characters. */
5947 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
5948 if (*old
++ == '$') count
++;
5952 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
5955 for (n
= osize
; n
> 0; n
--)
5969 read_file_name_cleanup (arg
)
5972 return (current_buffer
->directory
= arg
);
5975 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
5977 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
5978 (string
, dir
, action
)
5979 Lisp_Object string
, dir
, action
;
5980 /* action is nil for complete, t for return list of completions,
5981 lambda for verify final value */
5983 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
5985 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
5987 CHECK_STRING (string
);
5994 /* No need to protect ACTION--we only compare it with t and nil. */
5995 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
5997 if (SCHARS (string
) == 0)
5999 if (EQ (action
, Qlambda
))
6007 orig_string
= string
;
6008 string
= Fsubstitute_in_file_name (string
);
6009 changed
= NILP (Fstring_equal (string
, orig_string
));
6010 name
= Ffile_name_nondirectory (string
);
6011 val
= Ffile_name_directory (string
);
6013 realdir
= Fexpand_file_name (val
, realdir
);
6018 specdir
= Ffile_name_directory (string
);
6019 val
= Ffile_name_completion (name
, realdir
);
6024 return double_dollars (string
);
6028 if (!NILP (specdir
))
6029 val
= concat2 (specdir
, val
);
6031 return double_dollars (val
);
6034 #endif /* not VMS */
6038 if (EQ (action
, Qt
))
6040 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6044 if (NILP (Vread_file_name_predicate
)
6045 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6049 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6051 /* Brute-force speed up for directory checking:
6052 Discard strings which don't end in a slash. */
6053 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6055 Lisp_Object tem
= XCAR (all
);
6057 if (STRINGP (tem
) &&
6058 (len
= SCHARS (tem
), len
> 0) &&
6059 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6060 comp
= Fcons (tem
, comp
);
6066 /* Must do it the hard (and slow) way. */
6067 GCPRO3 (all
, comp
, specdir
);
6068 count
= SPECPDL_INDEX ();
6069 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6070 current_buffer
->directory
= realdir
;
6071 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6072 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
6073 comp
= Fcons (XCAR (all
), comp
);
6074 unbind_to (count
, Qnil
);
6077 return Fnreverse (comp
);
6080 /* Only other case actually used is ACTION = lambda */
6082 /* Supposedly this helps commands such as `cd' that read directory names,
6083 but can someone explain how it helps them? -- RMS */
6084 if (SCHARS (name
) == 0)
6087 string
= Fexpand_file_name (string
, dir
);
6088 if (!NILP (Vread_file_name_predicate
))
6089 return call1 (Vread_file_name_predicate
, string
);
6090 return Ffile_exists_p (string
);
6093 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6094 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6095 Value is not expanded---you must call `expand-file-name' yourself.
6096 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6097 the same non-empty string that was inserted by this function.
6098 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6099 except that if INITIAL is specified, that combined with DIR is used.)
6100 If the user exits with an empty minibuffer, this function returns
6101 an empty string. (This can only happen if the user erased the
6102 pre-inserted contents or if `insert-default-directory' is nil.)
6103 Fourth arg MUSTMATCH non-nil means require existing file's name.
6104 Non-nil and non-t means also require confirmation after completion.
6105 Fifth arg INITIAL specifies text to start with.
6106 If optional sixth arg PREDICATE is non-nil, possible completions and
6107 the resulting file name must satisfy (funcall PREDICATE NAME).
6108 DIR should be an absolute directory name. It defaults to the value of
6109 `default-directory'.
6111 If this command was invoked with the mouse, use a file dialog box if
6112 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6113 provides a file dialog box.
6115 See also `read-file-name-completion-ignore-case'
6116 and `read-file-name-function'. */)
6117 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6118 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6120 Lisp_Object val
, insdef
, tem
;
6121 struct gcpro gcpro1
, gcpro2
;
6122 register char *homedir
;
6123 Lisp_Object decoded_homedir
;
6124 int replace_in_history
= 0;
6125 int add_to_history
= 0;
6129 dir
= current_buffer
->directory
;
6130 if (NILP (Ffile_name_absolute_p (dir
)))
6131 dir
= Fexpand_file_name (dir
, Qnil
);
6132 if (NILP (default_filename
))
6135 ? Fexpand_file_name (initial
, dir
)
6136 : current_buffer
->filename
);
6138 /* If dir starts with user's homedir, change that to ~. */
6139 homedir
= (char *) egetenv ("HOME");
6141 /* homedir can be NULL in temacs, since Vprocess_environment is not
6142 yet set up. We shouldn't crash in that case. */
6145 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6146 CORRECT_DIR_SEPS (homedir
);
6151 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6154 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6155 SBYTES (decoded_homedir
))
6156 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6158 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6159 dir
= concat2 (build_string ("~"), dir
);
6161 /* Likewise for default_filename. */
6163 && STRINGP (default_filename
)
6164 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6165 SBYTES (decoded_homedir
))
6166 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6169 = Fsubstring (default_filename
,
6170 make_number (SCHARS (decoded_homedir
)), Qnil
);
6171 default_filename
= concat2 (build_string ("~"), default_filename
);
6173 if (!NILP (default_filename
))
6175 CHECK_STRING (default_filename
);
6176 default_filename
= double_dollars (default_filename
);
6179 if (insert_default_directory
&& STRINGP (dir
))
6182 if (!NILP (initial
))
6184 Lisp_Object args
[2], pos
;
6188 insdef
= Fconcat (2, args
);
6189 pos
= make_number (SCHARS (double_dollars (dir
)));
6190 insdef
= Fcons (double_dollars (insdef
), pos
);
6193 insdef
= double_dollars (insdef
);
6195 else if (STRINGP (initial
))
6196 insdef
= Fcons (double_dollars (initial
), make_number (0));
6200 if (!NILP (Vread_file_name_function
))
6202 Lisp_Object args
[7];
6204 GCPRO2 (insdef
, default_filename
);
6205 args
[0] = Vread_file_name_function
;
6208 args
[3] = default_filename
;
6209 args
[4] = mustmatch
;
6211 args
[6] = predicate
;
6212 RETURN_UNGCPRO (Ffuncall (7, args
));
6215 count
= SPECPDL_INDEX ();
6216 specbind (intern ("completion-ignore-case"),
6217 read_file_name_completion_ignore_case
? Qt
: Qnil
);
6218 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6219 specbind (intern ("read-file-name-predicate"),
6220 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6222 GCPRO2 (insdef
, default_filename
);
6224 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (TARGET_API_MAC_CARBON)
6225 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6230 /* If DIR contains a file name, split it. */
6232 file
= Ffile_name_nondirectory (dir
);
6233 if (SCHARS (file
) && NILP (default_filename
))
6235 default_filename
= file
;
6236 dir
= Ffile_name_directory (dir
);
6238 if (!NILP(default_filename
))
6239 default_filename
= Fexpand_file_name (default_filename
, dir
);
6240 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
,
6241 EQ (predicate
, Qfile_directory_p
) ? Qt
: Qnil
);
6246 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6247 dir
, mustmatch
, insdef
,
6248 Qfile_name_history
, default_filename
, Qnil
);
6250 tem
= Fsymbol_value (Qfile_name_history
);
6251 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6252 replace_in_history
= 1;
6254 /* If Fcompleting_read returned the inserted default string itself
6255 (rather than a new string with the same contents),
6256 it has to mean that the user typed RET with the minibuffer empty.
6257 In that case, we really want to return ""
6258 so that commands such as set-visited-file-name can distinguish. */
6259 if (EQ (val
, default_filename
))
6261 /* In this case, Fcompleting_read has not added an element
6262 to the history. Maybe we should. */
6263 if (! replace_in_history
)
6269 unbind_to (count
, Qnil
);
6272 error ("No file name specified");
6274 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6276 if (!NILP (tem
) && !NILP (default_filename
))
6277 val
= default_filename
;
6278 val
= Fsubstitute_in_file_name (val
);
6280 if (replace_in_history
)
6281 /* Replace what Fcompleting_read added to the history
6282 with what we will actually return. */
6283 XSETCAR (Fsymbol_value (Qfile_name_history
), double_dollars (val
));
6284 else if (add_to_history
)
6286 /* Add the value to the history--but not if it matches
6287 the last value already there. */
6288 Lisp_Object val1
= double_dollars (val
);
6289 tem
= Fsymbol_value (Qfile_name_history
);
6290 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6291 Fset (Qfile_name_history
,
6302 /* Must be set before any path manipulation is performed. */
6303 XSETFASTINT (Vdirectory_sep_char
, '/');
6310 Qexpand_file_name
= intern ("expand-file-name");
6311 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6312 Qdirectory_file_name
= intern ("directory-file-name");
6313 Qfile_name_directory
= intern ("file-name-directory");
6314 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6315 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6316 Qfile_name_as_directory
= intern ("file-name-as-directory");
6317 Qcopy_file
= intern ("copy-file");
6318 Qmake_directory_internal
= intern ("make-directory-internal");
6319 Qmake_directory
= intern ("make-directory");
6320 Qdelete_directory
= intern ("delete-directory");
6321 Qdelete_file
= intern ("delete-file");
6322 Qrename_file
= intern ("rename-file");
6323 Qadd_name_to_file
= intern ("add-name-to-file");
6324 Qmake_symbolic_link
= intern ("make-symbolic-link");
6325 Qfile_exists_p
= intern ("file-exists-p");
6326 Qfile_executable_p
= intern ("file-executable-p");
6327 Qfile_readable_p
= intern ("file-readable-p");
6328 Qfile_writable_p
= intern ("file-writable-p");
6329 Qfile_symlink_p
= intern ("file-symlink-p");
6330 Qaccess_file
= intern ("access-file");
6331 Qfile_directory_p
= intern ("file-directory-p");
6332 Qfile_regular_p
= intern ("file-regular-p");
6333 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6334 Qfile_modes
= intern ("file-modes");
6335 Qset_file_modes
= intern ("set-file-modes");
6336 Qset_file_times
= intern ("set-file-times");
6337 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6338 Qinsert_file_contents
= intern ("insert-file-contents");
6339 Qwrite_region
= intern ("write-region");
6340 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6341 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6342 Qauto_save_coding
= intern ("auto-save-coding");
6344 staticpro (&Qexpand_file_name
);
6345 staticpro (&Qsubstitute_in_file_name
);
6346 staticpro (&Qdirectory_file_name
);
6347 staticpro (&Qfile_name_directory
);
6348 staticpro (&Qfile_name_nondirectory
);
6349 staticpro (&Qunhandled_file_name_directory
);
6350 staticpro (&Qfile_name_as_directory
);
6351 staticpro (&Qcopy_file
);
6352 staticpro (&Qmake_directory_internal
);
6353 staticpro (&Qmake_directory
);
6354 staticpro (&Qdelete_directory
);
6355 staticpro (&Qdelete_file
);
6356 staticpro (&Qrename_file
);
6357 staticpro (&Qadd_name_to_file
);
6358 staticpro (&Qmake_symbolic_link
);
6359 staticpro (&Qfile_exists_p
);
6360 staticpro (&Qfile_executable_p
);
6361 staticpro (&Qfile_readable_p
);
6362 staticpro (&Qfile_writable_p
);
6363 staticpro (&Qaccess_file
);
6364 staticpro (&Qfile_symlink_p
);
6365 staticpro (&Qfile_directory_p
);
6366 staticpro (&Qfile_regular_p
);
6367 staticpro (&Qfile_accessible_directory_p
);
6368 staticpro (&Qfile_modes
);
6369 staticpro (&Qset_file_modes
);
6370 staticpro (&Qset_file_times
);
6371 staticpro (&Qfile_newer_than_file_p
);
6372 staticpro (&Qinsert_file_contents
);
6373 staticpro (&Qwrite_region
);
6374 staticpro (&Qverify_visited_file_modtime
);
6375 staticpro (&Qset_visited_file_modtime
);
6376 staticpro (&Qauto_save_coding
);
6378 Qfile_name_history
= intern ("file-name-history");
6379 Fset (Qfile_name_history
, Qnil
);
6380 staticpro (&Qfile_name_history
);
6382 Qfile_error
= intern ("file-error");
6383 staticpro (&Qfile_error
);
6384 Qfile_already_exists
= intern ("file-already-exists");
6385 staticpro (&Qfile_already_exists
);
6386 Qfile_date_error
= intern ("file-date-error");
6387 staticpro (&Qfile_date_error
);
6388 Qexcl
= intern ("excl");
6392 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6393 staticpro (&Qfind_buffer_file_type
);
6396 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6397 doc
: /* *Coding system for encoding file names.
6398 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6399 Vfile_name_coding_system
= Qnil
;
6401 DEFVAR_LISP ("default-file-name-coding-system",
6402 &Vdefault_file_name_coding_system
,
6403 doc
: /* Default coding system for encoding file names.
6404 This variable is used only when `file-name-coding-system' is nil.
6406 This variable is set/changed by the command `set-language-environment'.
6407 User should not set this variable manually,
6408 instead use `file-name-coding-system' to get a constant encoding
6409 of file names regardless of the current language environment. */);
6410 Vdefault_file_name_coding_system
= Qnil
;
6412 Qformat_decode
= intern ("format-decode");
6413 staticpro (&Qformat_decode
);
6414 Qformat_annotate_function
= intern ("format-annotate-function");
6415 staticpro (&Qformat_annotate_function
);
6416 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6417 staticpro (&Qafter_insert_file_set_coding
);
6419 Qcar_less_than_car
= intern ("car-less-than-car");
6420 staticpro (&Qcar_less_than_car
);
6422 Fput (Qfile_error
, Qerror_conditions
,
6423 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6424 Fput (Qfile_error
, Qerror_message
,
6425 build_string ("File error"));
6427 Fput (Qfile_already_exists
, Qerror_conditions
,
6428 Fcons (Qfile_already_exists
,
6429 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6430 Fput (Qfile_already_exists
, Qerror_message
,
6431 build_string ("File already exists"));
6433 Fput (Qfile_date_error
, Qerror_conditions
,
6434 Fcons (Qfile_date_error
,
6435 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6436 Fput (Qfile_date_error
, Qerror_message
,
6437 build_string ("Cannot set file date"));
6439 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6440 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6441 Vread_file_name_function
= Qnil
;
6443 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6444 doc
: /* Current predicate used by `read-file-name-internal'. */);
6445 Vread_file_name_predicate
= Qnil
;
6447 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case
,
6448 doc
: /* *Non-nil means when reading a file name completion ignores case. */);
6449 #if defined VMS || defined DOS_NT || defined MAC_OS
6450 read_file_name_completion_ignore_case
= 1;
6452 read_file_name_completion_ignore_case
= 0;
6455 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6456 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6457 If the initial minibuffer contents are non-empty, you can usually
6458 request a default filename by typing RETURN without editing. For some
6459 commands, exiting with an empty minibuffer has a special meaning,
6460 such as making the current buffer visit no file in the case of
6461 `set-visited-file-name'.
6462 If this variable is non-nil, the minibuffer contents are always
6463 initially non-empty and typing RETURN without editing will fetch the
6464 default name, if one is provided. Note however that this default name
6465 is not necessarily the name originally inserted in the minibuffer, if
6466 that is just the default directory.
6467 If this variable is nil, the minibuffer often starts out empty. In
6468 that case you may have to explicitly fetch the next history element to
6469 request the default name. */);
6470 insert_default_directory
= 1;
6472 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6473 doc
: /* *Non-nil means write new files with record format `stmlf'.
6474 nil means use format `var'. This variable is meaningful only on VMS. */);
6475 vms_stmlf_recfm
= 0;
6477 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6478 doc
: /* Directory separator character for built-in functions that return file names.
6479 The value is always ?/. Don't use this variable, just use `/'. */);
6481 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6482 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6483 If a file name matches REGEXP, then all I/O on that file is done by calling
6486 The first argument given to HANDLER is the name of the I/O primitive
6487 to be handled; the remaining arguments are the arguments that were
6488 passed to that primitive. For example, if you do
6489 (file-exists-p FILENAME)
6490 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6491 (funcall HANDLER 'file-exists-p FILENAME)
6492 The function `find-file-name-handler' checks this list for a handler
6493 for its argument. */);
6494 Vfile_name_handler_alist
= Qnil
;
6496 DEFVAR_LISP ("set-auto-coding-function",
6497 &Vset_auto_coding_function
,
6498 doc
: /* If non-nil, a function to call to decide a coding system of file.
6499 Two arguments are passed to this function: the file name
6500 and the length of a file contents following the point.
6501 This function should return a coding system to decode the file contents.
6502 It should check the file name against `auto-coding-alist'.
6503 If no coding system is decided, it should check a coding system
6504 specified in the heading lines with the format:
6505 -*- ... coding: CODING-SYSTEM; ... -*-
6506 or local variable spec of the tailing lines with `coding:' tag. */);
6507 Vset_auto_coding_function
= Qnil
;
6509 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6510 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6511 Each is passed one argument, the number of characters inserted.
6512 It should return the new character count, and leave point the same.
6513 If `insert-file-contents' is intercepted by a handler from
6514 `file-name-handler-alist', that handler is responsible for calling the
6515 functions in `after-insert-file-functions' if appropriate. */);
6516 Vafter_insert_file_functions
= Qnil
;
6518 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6519 doc
: /* A list of functions to be called at the start of `write-region'.
6520 Each is passed two arguments, START and END as for `write-region'.
6521 These are usually two numbers but not always; see the documentation
6522 for `write-region'. The function should return a list of pairs
6523 of the form (POSITION . STRING), consisting of strings to be effectively
6524 inserted at the specified positions of the file being written (1 means to
6525 insert before the first byte written). The POSITIONs must be sorted into
6526 increasing order. If there are several functions in the list, the several
6527 lists are merged destructively. Alternatively, the function can return
6528 with a different buffer current; in that case it should pay attention
6529 to the annotations returned by previous functions and listed in
6530 `write-region-annotations-so-far'.*/);
6531 Vwrite_region_annotate_functions
= Qnil
;
6532 staticpro (&Qwrite_region_annotate_functions
);
6533 Qwrite_region_annotate_functions
6534 = intern ("write-region-annotate-functions");
6536 DEFVAR_LISP ("write-region-annotations-so-far",
6537 &Vwrite_region_annotations_so_far
,
6538 doc
: /* When an annotation function is called, this holds the previous annotations.
6539 These are the annotations made by other annotation functions
6540 that were already called. See also `write-region-annotate-functions'. */);
6541 Vwrite_region_annotations_so_far
= Qnil
;
6543 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6544 doc
: /* A list of file name handlers that temporarily should not be used.
6545 This applies only to the operation `inhibit-file-name-operation'. */);
6546 Vinhibit_file_name_handlers
= Qnil
;
6548 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6549 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6550 Vinhibit_file_name_operation
= Qnil
;
6552 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6553 doc
: /* File name in which we write a list of all auto save file names.
6554 This variable is initialized automatically from `auto-save-list-file-prefix'
6555 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6556 a non-nil value. */);
6557 Vauto_save_list_file_name
= Qnil
;
6559 defsubr (&Sfind_file_name_handler
);
6560 defsubr (&Sfile_name_directory
);
6561 defsubr (&Sfile_name_nondirectory
);
6562 defsubr (&Sunhandled_file_name_directory
);
6563 defsubr (&Sfile_name_as_directory
);
6564 defsubr (&Sdirectory_file_name
);
6565 defsubr (&Smake_temp_name
);
6566 defsubr (&Sexpand_file_name
);
6567 defsubr (&Ssubstitute_in_file_name
);
6568 defsubr (&Scopy_file
);
6569 defsubr (&Smake_directory_internal
);
6570 defsubr (&Sdelete_directory
);
6571 defsubr (&Sdelete_file
);
6572 defsubr (&Srename_file
);
6573 defsubr (&Sadd_name_to_file
);
6575 defsubr (&Smake_symbolic_link
);
6576 #endif /* S_IFLNK */
6578 defsubr (&Sdefine_logical_name
);
6581 defsubr (&Ssysnetunam
);
6582 #endif /* HPUX_NET */
6583 defsubr (&Sfile_name_absolute_p
);
6584 defsubr (&Sfile_exists_p
);
6585 defsubr (&Sfile_executable_p
);
6586 defsubr (&Sfile_readable_p
);
6587 defsubr (&Sfile_writable_p
);
6588 defsubr (&Saccess_file
);
6589 defsubr (&Sfile_symlink_p
);
6590 defsubr (&Sfile_directory_p
);
6591 defsubr (&Sfile_accessible_directory_p
);
6592 defsubr (&Sfile_regular_p
);
6593 defsubr (&Sfile_modes
);
6594 defsubr (&Sset_file_modes
);
6595 defsubr (&Sset_file_times
);
6596 defsubr (&Sset_default_file_modes
);
6597 defsubr (&Sdefault_file_modes
);
6598 defsubr (&Sfile_newer_than_file_p
);
6599 defsubr (&Sinsert_file_contents
);
6600 defsubr (&Swrite_region
);
6601 defsubr (&Scar_less_than_car
);
6602 defsubr (&Sverify_visited_file_modtime
);
6603 defsubr (&Sclear_visited_file_modtime
);
6604 defsubr (&Svisited_file_modtime
);
6605 defsubr (&Sset_visited_file_modtime
);
6606 defsubr (&Sdo_auto_save
);
6607 defsubr (&Sset_buffer_auto_saved
);
6608 defsubr (&Sclear_buffer_auto_save_failure
);
6609 defsubr (&Srecent_auto_save_p
);
6611 defsubr (&Sread_file_name_internal
);
6612 defsubr (&Sread_file_name
);
6615 defsubr (&Sunix_sync
);
6619 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6620 (do not change this comment) */