1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996, 1997, 1998,
3 1999, 2000, 2001, 2003, 2004 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
29 #include <sys/types.h>
36 #if !defined (S_ISLNK) && defined (S_IFLNK)
37 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
40 #if !defined (S_ISFIFO) && defined (S_IFIFO)
41 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
44 #if !defined (S_ISREG) && defined (S_IFREG)
45 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
76 #include "intervals.h"
87 #endif /* not WINDOWSNT */
91 #include <sys/param.h>
99 #define CORRECT_DIR_SEPS(s) \
100 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
101 else unixtodos_filename (s); \
103 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
104 redirector allows the six letters between 'Z' and 'a' as well. */
106 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
109 #define IS_DRIVE(x) isalpha (x)
111 /* Need to lower-case the drive letter, or else expanded
112 filenames will sometimes compare inequal, because
113 `expand-file-name' doesn't always down-case the drive letter. */
114 #define DRIVE_LETTER(x) (tolower (x))
135 #include "commands.h"
136 extern int use_dialog_box
;
137 extern int use_file_dialog
;
151 #ifndef FILE_SYSTEM_CASE
152 #define FILE_SYSTEM_CASE(filename) (filename)
155 /* Nonzero during writing of auto-save files */
158 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
159 a new file with the same mode as the original */
160 int auto_save_mode_bits
;
162 /* The symbol bound to coding-system-for-read when
163 insert-file-contents is called for recovering a file. This is not
164 an actual coding system name, but just an indicator to tell
165 insert-file-contents to use `emacs-mule' with a special flag for
166 auto saving and recovering a file. */
167 Lisp_Object Qauto_save_coding
;
169 /* Coding system for file names, or nil if none. */
170 Lisp_Object Vfile_name_coding_system
;
172 /* Coding system for file names used only when
173 Vfile_name_coding_system is nil. */
174 Lisp_Object Vdefault_file_name_coding_system
;
176 /* Alist of elements (REGEXP . HANDLER) for file names
177 whose I/O is done with a special handler. */
178 Lisp_Object Vfile_name_handler_alist
;
180 /* Lisp functions for translating file formats */
181 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
183 /* Function to be called to decide a coding system of a reading file. */
184 Lisp_Object Vset_auto_coding_function
;
186 /* Functions to be called to process text properties in inserted file. */
187 Lisp_Object Vafter_insert_file_functions
;
189 /* Lisp function for setting buffer-file-coding-system and the
190 multibyteness of the current buffer after inserting a file. */
191 Lisp_Object Qafter_insert_file_set_coding
;
193 /* Functions to be called to create text property annotations for file. */
194 Lisp_Object Vwrite_region_annotate_functions
;
195 Lisp_Object Qwrite_region_annotate_functions
;
197 /* During build_annotations, each time an annotation function is called,
198 this holds the annotations made by the previous functions. */
199 Lisp_Object Vwrite_region_annotations_so_far
;
201 /* File name in which we write a list of all our auto save files. */
202 Lisp_Object Vauto_save_list_file_name
;
204 /* Function to call to read a file name. */
205 Lisp_Object Vread_file_name_function
;
207 /* Current predicate used by read_file_name_internal. */
208 Lisp_Object Vread_file_name_predicate
;
210 /* Nonzero means completion ignores case when reading file name. */
211 int read_file_name_completion_ignore_case
;
213 /* Nonzero means, when reading a filename in the minibuffer,
214 start out by inserting the default directory into the minibuffer. */
215 int insert_default_directory
;
217 /* On VMS, nonzero means write new files with record format stmlf.
218 Zero means use var format. */
221 /* On NT, specifies the directory separator character, used (eg.) when
222 expanding file names. This can be bound to / or \. */
223 Lisp_Object Vdirectory_sep_char
;
225 extern Lisp_Object Vuser_login_name
;
228 extern Lisp_Object Vw32_get_true_file_attributes
;
231 extern int minibuf_level
;
233 extern int minibuffer_auto_raise
;
235 extern int history_delete_duplicates
;
237 /* These variables describe handlers that have "already" had a chance
238 to handle the current operation.
240 Vinhibit_file_name_handlers is a list of file name handlers.
241 Vinhibit_file_name_operation is the operation being handled.
242 If we try to handle that operation, we ignore those handlers. */
244 static Lisp_Object Vinhibit_file_name_handlers
;
245 static Lisp_Object Vinhibit_file_name_operation
;
247 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
249 Lisp_Object Qfile_name_history
;
251 Lisp_Object Qcar_less_than_car
;
253 static int a_write
P_ ((int, Lisp_Object
, int, int,
254 Lisp_Object
*, struct coding_system
*));
255 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
259 report_file_error (string
, data
)
263 Lisp_Object errstring
;
266 synchronize_system_messages_locale ();
267 errstring
= code_convert_string_norecord (build_string (strerror (errorno
)),
268 Vlocale_coding_system
, 0);
274 Fsignal (Qfile_already_exists
, Fcons (errstring
, data
));
277 /* System error messages are capitalized. Downcase the initial
278 unless it is followed by a slash. */
279 if (SREF (errstring
, 1) != '/')
280 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
282 Fsignal (Qfile_error
,
283 Fcons (build_string (string
), Fcons (errstring
, data
)));
288 close_file_unwind (fd
)
291 emacs_close (XFASTINT (fd
));
295 /* Restore point, having saved it as a marker. */
298 restore_point_unwind (location
)
299 Lisp_Object location
;
301 Fgoto_char (location
);
302 Fset_marker (location
, Qnil
, Qnil
);
306 Lisp_Object Qexpand_file_name
;
307 Lisp_Object Qsubstitute_in_file_name
;
308 Lisp_Object Qdirectory_file_name
;
309 Lisp_Object Qfile_name_directory
;
310 Lisp_Object Qfile_name_nondirectory
;
311 Lisp_Object Qunhandled_file_name_directory
;
312 Lisp_Object Qfile_name_as_directory
;
313 Lisp_Object Qcopy_file
;
314 Lisp_Object Qmake_directory_internal
;
315 Lisp_Object Qmake_directory
;
316 Lisp_Object Qdelete_directory
;
317 Lisp_Object Qdelete_file
;
318 Lisp_Object Qrename_file
;
319 Lisp_Object Qadd_name_to_file
;
320 Lisp_Object Qmake_symbolic_link
;
321 Lisp_Object Qfile_exists_p
;
322 Lisp_Object Qfile_executable_p
;
323 Lisp_Object Qfile_readable_p
;
324 Lisp_Object Qfile_writable_p
;
325 Lisp_Object Qfile_symlink_p
;
326 Lisp_Object Qaccess_file
;
327 Lisp_Object Qfile_directory_p
;
328 Lisp_Object Qfile_regular_p
;
329 Lisp_Object Qfile_accessible_directory_p
;
330 Lisp_Object Qfile_modes
;
331 Lisp_Object Qset_file_modes
;
332 Lisp_Object Qset_file_times
;
333 Lisp_Object Qfile_newer_than_file_p
;
334 Lisp_Object Qinsert_file_contents
;
335 Lisp_Object Qwrite_region
;
336 Lisp_Object Qverify_visited_file_modtime
;
337 Lisp_Object Qset_visited_file_modtime
;
339 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
340 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
341 Otherwise, return nil.
342 A file name is handled if one of the regular expressions in
343 `file-name-handler-alist' matches it.
345 If OPERATION equals `inhibit-file-name-operation', then we ignore
346 any handlers that are members of `inhibit-file-name-handlers',
347 but we still do run any other handlers. This lets handlers
348 use the standard functions without calling themselves recursively. */)
349 (filename
, operation
)
350 Lisp_Object filename
, operation
;
352 /* This function must not munge the match data. */
353 Lisp_Object chain
, inhibited_handlers
, result
;
357 CHECK_STRING (filename
);
359 if (EQ (operation
, Vinhibit_file_name_operation
))
360 inhibited_handlers
= Vinhibit_file_name_handlers
;
362 inhibited_handlers
= Qnil
;
364 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
365 chain
= XCDR (chain
))
375 && (match_pos
= fast_string_match (string
, filename
)) > pos
)
377 Lisp_Object handler
, tem
;
379 handler
= XCDR (elt
);
380 tem
= Fmemq (handler
, inhibited_handlers
);
394 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
396 doc
: /* Return the directory component in file name FILENAME.
397 Return nil if FILENAME does not include a directory.
398 Otherwise return a directory spec.
399 Given a Unix syntax file name, returns a string ending in slash;
400 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
402 Lisp_Object filename
;
405 register const unsigned char *beg
;
407 register unsigned char *beg
;
409 register const unsigned char *p
;
412 CHECK_STRING (filename
);
414 /* If the file name has special constructs in it,
415 call the corresponding file handler. */
416 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
418 return call2 (handler
, Qfile_name_directory
, filename
);
420 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 name
= FILE_SYSTEM_CASE (name
);
1133 /* We will force directory separators to be either all \ or /, so make
1134 a local copy to modify, even if there ends up being no change. */
1135 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1137 /* Note if special escape prefix is present, but remove for now. */
1138 if (nm
[0] == '/' && nm
[1] == ':')
1144 /* Find and remove drive specifier if present; this makes nm absolute
1145 even if the rest of the name appears to be relative. Only look for
1146 drive specifier at the beginning. */
1147 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1154 /* If we see "c://somedir", we want to strip the first slash after the
1155 colon when stripping the drive letter. Otherwise, this expands to
1157 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1159 #endif /* WINDOWSNT */
1163 /* Discard any previous drive specifier if nm is now in UNC format. */
1164 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1170 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1171 none are found, we can probably return right away. We will avoid
1172 allocating a new string if name is already fully expanded. */
1174 IS_DIRECTORY_SEP (nm
[0])
1176 && drive
&& !is_escaped
1179 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1186 /* If it turns out that the filename we want to return is just a
1187 suffix of FILENAME, we don't need to go through and edit
1188 things; we just need to construct a new string using data
1189 starting at the middle of FILENAME. If we set lose to a
1190 non-zero value, that means we've discovered that we can't do
1197 /* Since we know the name is absolute, we can assume that each
1198 element starts with a "/". */
1200 /* "." and ".." are hairy. */
1201 if (IS_DIRECTORY_SEP (p
[0])
1203 && (IS_DIRECTORY_SEP (p
[2])
1205 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1208 /* We want to replace multiple `/' in a row with a single
1211 && IS_DIRECTORY_SEP (p
[0])
1212 && IS_DIRECTORY_SEP (p
[1]))
1219 /* if dev:[dir]/, move nm to / */
1220 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1221 nm
= (brack
? brack
+ 1 : colon
+ 1);
1222 lbrack
= rbrack
= 0;
1230 /* VMS pre V4.4,convert '-'s in filenames. */
1231 if (lbrack
== rbrack
)
1233 if (dots
< 2) /* this is to allow negative version numbers */
1238 if (lbrack
> rbrack
&&
1239 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1240 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1246 /* count open brackets, reset close bracket pointer */
1247 if (p
[0] == '[' || p
[0] == '<')
1248 lbrack
++, brack
= 0;
1249 /* count close brackets, set close bracket pointer */
1250 if (p
[0] == ']' || p
[0] == '>')
1251 rbrack
++, brack
= p
;
1252 /* detect ][ or >< */
1253 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1255 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1256 nm
= p
+ 1, lose
= 1;
1257 if (p
[0] == ':' && (colon
|| slash
))
1258 /* if dev1:[dir]dev2:, move nm to dev2: */
1264 /* if /name/dev:, move nm to dev: */
1267 /* if node::dev:, move colon following dev */
1268 else if (colon
&& colon
[-1] == ':')
1270 /* if dev1:dev2:, move nm to dev2: */
1271 else if (colon
&& colon
[-1] != ':')
1276 if (p
[0] == ':' && !colon
)
1282 if (lbrack
== rbrack
)
1285 else if (p
[0] == '.')
1293 if (index (nm
, '/'))
1295 nm
= sys_translate_unix (nm
);
1296 return make_specified_string (nm
, -1, strlen (nm
),
1297 STRING_MULTIBYTE (name
));
1301 /* Make sure directories are all separated with / or \ as
1302 desired, but avoid allocation of a new string when not
1304 CORRECT_DIR_SEPS (nm
);
1306 if (IS_DIRECTORY_SEP (nm
[1]))
1308 if (strcmp (nm
, SDATA (name
)) != 0)
1309 name
= make_specified_string (nm
, -1, strlen (nm
),
1310 STRING_MULTIBYTE (name
));
1314 /* drive must be set, so this is okay */
1315 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1319 name
= make_specified_string (nm
, -1, p
- nm
,
1320 STRING_MULTIBYTE (name
));
1321 temp
[0] = DRIVE_LETTER (drive
);
1322 name
= concat2 (build_string (temp
), name
);
1325 #else /* not DOS_NT */
1326 if (nm
== SDATA (name
))
1328 return make_specified_string (nm
, -1, strlen (nm
),
1329 STRING_MULTIBYTE (name
));
1330 #endif /* not DOS_NT */
1334 /* At this point, nm might or might not be an absolute file name. We
1335 need to expand ~ or ~user if present, otherwise prefix nm with
1336 default_directory if nm is not absolute, and finally collapse /./
1337 and /foo/../ sequences.
1339 We set newdir to be the appropriate prefix if one is needed:
1340 - the relevant user directory if nm starts with ~ or ~user
1341 - the specified drive's working dir (DOS/NT only) if nm does not
1343 - the value of default_directory.
1345 Note that these prefixes are not guaranteed to be absolute (except
1346 for the working dir of a drive). Therefore, to ensure we always
1347 return an absolute name, if the final prefix is not absolute we
1348 append it to the current working directory. */
1352 if (nm
[0] == '~') /* prefix ~ */
1354 if (IS_DIRECTORY_SEP (nm
[1])
1358 || nm
[1] == 0) /* ~ by itself */
1360 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1361 newdir
= (unsigned char *) "";
1364 collapse_newdir
= 0;
1367 nm
++; /* Don't leave the slash in nm. */
1370 else /* ~user/filename */
1372 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1377 o
= (unsigned char *) alloca (p
- nm
+ 1);
1378 bcopy ((char *) nm
, o
, p
- nm
);
1381 pw
= (struct passwd
*) getpwnam (o
+ 1);
1384 newdir
= (unsigned char *) pw
-> pw_dir
;
1386 nm
= p
+ 1; /* skip the terminator */
1390 collapse_newdir
= 0;
1395 /* If we don't find a user of that name, leave the name
1396 unchanged; don't move nm forward to p. */
1401 /* On DOS and Windows, nm is absolute if a drive name was specified;
1402 use the drive's current directory as the prefix if needed. */
1403 if (!newdir
&& drive
)
1405 /* Get default directory if needed to make nm absolute. */
1406 if (!IS_DIRECTORY_SEP (nm
[0]))
1408 newdir
= alloca (MAXPATHLEN
+ 1);
1409 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1414 /* Either nm starts with /, or drive isn't mounted. */
1415 newdir
= alloca (4);
1416 newdir
[0] = DRIVE_LETTER (drive
);
1424 /* Finally, if no prefix has been specified and nm is not absolute,
1425 then it must be expanded relative to default_directory. */
1429 /* /... alone is not absolute on DOS and Windows. */
1430 && !IS_DIRECTORY_SEP (nm
[0])
1433 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1440 newdir
= SDATA (default_directory
);
1442 /* Note if special escape prefix is present, but remove for now. */
1443 if (newdir
[0] == '/' && newdir
[1] == ':')
1454 /* First ensure newdir is an absolute name. */
1456 /* Detect MSDOS file names with drive specifiers. */
1457 ! (IS_DRIVE (newdir
[0])
1458 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1460 /* Detect Windows file names in UNC format. */
1461 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1465 /* Effectively, let newdir be (expand-file-name newdir cwd).
1466 Because of the admonition against calling expand-file-name
1467 when we have pointers into lisp strings, we accomplish this
1468 indirectly by prepending newdir to nm if necessary, and using
1469 cwd (or the wd of newdir's drive) as the new newdir. */
1471 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1476 if (!IS_DIRECTORY_SEP (nm
[0]))
1478 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1479 file_name_as_directory (tmp
, newdir
);
1483 newdir
= alloca (MAXPATHLEN
+ 1);
1486 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1493 /* Strip off drive name from prefix, if present. */
1494 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1500 /* Keep only a prefix from newdir if nm starts with slash
1501 (//server/share for UNC, nothing otherwise). */
1502 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1505 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1507 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1509 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1511 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1523 /* Get rid of any slash at the end of newdir, unless newdir is
1524 just / or // (an incomplete UNC name). */
1525 length
= strlen (newdir
);
1526 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1528 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1532 unsigned char *temp
= (unsigned char *) alloca (length
);
1533 bcopy (newdir
, temp
, length
- 1);
1534 temp
[length
- 1] = 0;
1542 /* Now concatenate the directory and name to new space in the stack frame */
1543 tlen
+= strlen (nm
) + 1;
1545 /* Reserve space for drive specifier and escape prefix, since either
1546 or both may need to be inserted. (The Microsoft x86 compiler
1547 produces incorrect code if the following two lines are combined.) */
1548 target
= (unsigned char *) alloca (tlen
+ 4);
1550 #else /* not DOS_NT */
1551 target
= (unsigned char *) alloca (tlen
);
1552 #endif /* not DOS_NT */
1558 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1561 /* If newdir is effectively "C:/", then the drive letter will have
1562 been stripped and newdir will be "/". Concatenating with an
1563 absolute directory in nm produces "//", which will then be
1564 incorrectly treated as a network share. Ignore newdir in
1565 this case (keeping the drive letter). */
1566 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1567 && newdir
[1] == '\0'))
1569 strcpy (target
, newdir
);
1573 file_name_as_directory (target
, newdir
);
1576 strcat (target
, nm
);
1578 if (index (target
, '/'))
1579 strcpy (target
, sys_translate_unix (target
));
1582 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1584 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1593 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1599 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1600 /* brackets are offset from each other by 2 */
1603 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1604 /* convert [foo][bar] to [bar] */
1605 while (o
[-1] != '[' && o
[-1] != '<')
1607 else if (*p
== '-' && *o
!= '.')
1610 else if (p
[0] == '-' && o
[-1] == '.' &&
1611 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1612 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1616 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1617 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1619 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1621 /* else [foo.-] ==> [-] */
1627 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1628 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1634 if (!IS_DIRECTORY_SEP (*p
))
1638 else if (IS_DIRECTORY_SEP (p
[0])
1640 && (IS_DIRECTORY_SEP (p
[2])
1643 /* If "/." is the entire filename, keep the "/". Otherwise,
1644 just delete the whole "/.". */
1645 if (o
== target
&& p
[2] == '\0')
1649 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1650 /* `/../' is the "superroot" on certain file systems. */
1652 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1654 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1656 /* Keep initial / only if this is the whole name. */
1657 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1662 && IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1]))
1664 /* Collapse multiple `/' in a row. */
1666 while (IS_DIRECTORY_SEP (*p
))
1673 #endif /* not VMS */
1677 /* At last, set drive name. */
1679 /* Except for network file name. */
1680 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1681 #endif /* WINDOWSNT */
1683 if (!drive
) abort ();
1685 target
[0] = DRIVE_LETTER (drive
);
1688 /* Reinsert the escape prefix if required. */
1695 CORRECT_DIR_SEPS (target
);
1698 result
= make_specified_string (target
, -1, o
- target
,
1699 STRING_MULTIBYTE (name
));
1701 /* Again look to see if the file name has special constructs in it
1702 and perhaps call the corresponding file handler. This is needed
1703 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1704 the ".." component gives us "/user@host:/bar/../baz" which needs
1705 to be expanded again. */
1706 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1707 if (!NILP (handler
))
1708 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1714 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1715 This is the old version of expand-file-name, before it was thoroughly
1716 rewritten for Emacs 10.31. We leave this version here commented-out,
1717 because the code is very complex and likely to have subtle bugs. If
1718 bugs _are_ found, it might be of interest to look at the old code and
1719 see what did it do in the relevant situation.
1721 Don't remove this code: it's true that it will be accessible via CVS,
1722 but a few years from deletion, people will forget it is there. */
1724 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1725 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1726 "Convert FILENAME to absolute, and canonicalize it.\n\
1727 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1728 (does not start with slash); if DEFAULT is nil or missing,\n\
1729 the current buffer's value of default-directory is used.\n\
1730 Filenames containing `.' or `..' as components are simplified;\n\
1731 initial `~/' expands to your home directory.\n\
1732 See also the function `substitute-in-file-name'.")
1734 Lisp_Object name
, defalt
;
1738 register unsigned char *newdir
, *p
, *o
;
1740 unsigned char *target
;
1744 unsigned char * colon
= 0;
1745 unsigned char * close
= 0;
1746 unsigned char * slash
= 0;
1747 unsigned char * brack
= 0;
1748 int lbrack
= 0, rbrack
= 0;
1752 CHECK_STRING (name
);
1755 /* Filenames on VMS are always upper case. */
1756 name
= Fupcase (name
);
1761 /* If nm is absolute, flush ...// and detect /./ and /../.
1762 If no /./ or /../ we can return right away. */
1774 if (p
[0] == '/' && p
[1] == '/'
1776 /* // at start of filename is meaningful on Apollo system. */
1781 if (p
[0] == '/' && p
[1] == '~')
1782 nm
= p
+ 1, lose
= 1;
1783 if (p
[0] == '/' && p
[1] == '.'
1784 && (p
[2] == '/' || p
[2] == 0
1785 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1791 /* if dev:[dir]/, move nm to / */
1792 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1793 nm
= (brack
? brack
+ 1 : colon
+ 1);
1794 lbrack
= rbrack
= 0;
1802 /* VMS pre V4.4,convert '-'s in filenames. */
1803 if (lbrack
== rbrack
)
1805 if (dots
< 2) /* this is to allow negative version numbers */
1810 if (lbrack
> rbrack
&&
1811 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1812 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1818 /* count open brackets, reset close bracket pointer */
1819 if (p
[0] == '[' || p
[0] == '<')
1820 lbrack
++, brack
= 0;
1821 /* count close brackets, set close bracket pointer */
1822 if (p
[0] == ']' || p
[0] == '>')
1823 rbrack
++, brack
= p
;
1824 /* detect ][ or >< */
1825 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1827 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1828 nm
= p
+ 1, lose
= 1;
1829 if (p
[0] == ':' && (colon
|| slash
))
1830 /* if dev1:[dir]dev2:, move nm to dev2: */
1836 /* If /name/dev:, move nm to dev: */
1839 /* If node::dev:, move colon following dev */
1840 else if (colon
&& colon
[-1] == ':')
1842 /* If dev1:dev2:, move nm to dev2: */
1843 else if (colon
&& colon
[-1] != ':')
1848 if (p
[0] == ':' && !colon
)
1854 if (lbrack
== rbrack
)
1857 else if (p
[0] == '.')
1865 if (index (nm
, '/'))
1866 return build_string (sys_translate_unix (nm
));
1868 if (nm
== SDATA (name
))
1870 return build_string (nm
);
1874 /* Now determine directory to start with and put it in NEWDIR */
1878 if (nm
[0] == '~') /* prefix ~ */
1883 || nm
[1] == 0)/* ~/filename */
1885 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1886 newdir
= (unsigned char *) "";
1889 nm
++; /* Don't leave the slash in nm. */
1892 else /* ~user/filename */
1894 /* Get past ~ to user */
1895 unsigned char *user
= nm
+ 1;
1896 /* Find end of name. */
1897 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1898 int len
= ptr
? ptr
- user
: strlen (user
);
1900 unsigned char *ptr1
= index (user
, ':');
1901 if (ptr1
!= 0 && ptr1
- user
< len
)
1904 /* Copy the user name into temp storage. */
1905 o
= (unsigned char *) alloca (len
+ 1);
1906 bcopy ((char *) user
, o
, len
);
1909 /* Look up the user name. */
1910 pw
= (struct passwd
*) getpwnam (o
+ 1);
1912 error ("\"%s\" isn't a registered user", o
+ 1);
1914 newdir
= (unsigned char *) pw
->pw_dir
;
1916 /* Discard the user name from NM. */
1923 #endif /* not VMS */
1927 defalt
= current_buffer
->directory
;
1928 CHECK_STRING (defalt
);
1929 newdir
= SDATA (defalt
);
1932 /* Now concatenate the directory and name to new space in the stack frame */
1934 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1935 target
= (unsigned char *) alloca (tlen
);
1941 if (nm
[0] == 0 || nm
[0] == '/')
1942 strcpy (target
, newdir
);
1945 file_name_as_directory (target
, newdir
);
1948 strcat (target
, nm
);
1950 if (index (target
, '/'))
1951 strcpy (target
, sys_translate_unix (target
));
1954 /* Now canonicalize by removing /. and /foo/.. if they appear */
1962 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1968 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1969 /* brackets are offset from each other by 2 */
1972 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1973 /* convert [foo][bar] to [bar] */
1974 while (o
[-1] != '[' && o
[-1] != '<')
1976 else if (*p
== '-' && *o
!= '.')
1979 else if (p
[0] == '-' && o
[-1] == '.' &&
1980 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1981 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1985 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1986 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1988 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1990 /* else [foo.-] ==> [-] */
1996 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1997 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2007 else if (!strncmp (p
, "//", 2)
2009 /* // at start of filename is meaningful in Apollo system. */
2017 else if (p
[0] == '/' && p
[1] == '.' &&
2018 (p
[2] == '/' || p
[2] == 0))
2020 else if (!strncmp (p
, "/..", 3)
2021 /* `/../' is the "superroot" on certain file systems. */
2023 && (p
[3] == '/' || p
[3] == 0))
2025 while (o
!= target
&& *--o
!= '/')
2028 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2032 if (o
== target
&& *o
== '/')
2040 #endif /* not VMS */
2043 return make_string (target
, o
- target
);
2047 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2048 Ssubstitute_in_file_name
, 1, 1, 0,
2049 doc
: /* Substitute environment variables referred to in FILENAME.
2050 `$FOO' where FOO is an environment variable name means to substitute
2051 the value of that variable. The variable name should be terminated
2052 with a character not a letter, digit or underscore; otherwise, enclose
2053 the entire variable name in braces.
2054 If `/~' appears, all of FILENAME through that `/' is discarded.
2056 On VMS, `$' substitution is not done; this function does little and only
2057 duplicates what `expand-file-name' does. */)
2059 Lisp_Object filename
;
2063 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2064 unsigned char *target
= NULL
;
2066 int substituted
= 0;
2069 Lisp_Object handler
;
2071 CHECK_STRING (filename
);
2073 /* If the file name has special constructs in it,
2074 call the corresponding file handler. */
2075 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2076 if (!NILP (handler
))
2077 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2079 nm
= SDATA (filename
);
2081 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2082 CORRECT_DIR_SEPS (nm
);
2083 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2085 endp
= nm
+ SBYTES (filename
);
2087 /* If /~ or // appears, discard everything through first slash. */
2089 for (p
= nm
; p
!= endp
; p
++)
2092 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2093 /* // at start of file name is meaningful in Apollo,
2094 WindowsNT and Cygwin systems. */
2095 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
2096 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2097 || IS_DIRECTORY_SEP (p
[0])
2098 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2103 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2105 || IS_DIRECTORY_SEP (p
[-1])))
2107 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2112 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2114 o
= (unsigned char *) alloca (s
- p
+ 1);
2115 bcopy ((char *) p
, o
, s
- p
);
2118 pw
= (struct passwd
*) getpwnam (o
+ 1);
2120 /* If we have ~/ or ~user and `user' exists, discard
2121 everything up to ~. But if `user' does not exist, leave
2122 ~user alone, it might be a literal file name. */
2123 if (IS_DIRECTORY_SEP (p
[0]) || s
== p
+ 1 || pw
)
2130 /* see comment in expand-file-name about drive specifiers */
2131 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2132 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
2141 return make_specified_string (nm
, -1, strlen (nm
),
2142 STRING_MULTIBYTE (filename
));
2145 /* See if any variables are substituted into the string
2146 and find the total length of their values in `total' */
2148 for (p
= nm
; p
!= endp
;)
2158 /* "$$" means a single "$" */
2167 while (p
!= endp
&& *p
!= '}') p
++;
2168 if (*p
!= '}') goto missingclose
;
2174 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2178 /* Copy out the variable name */
2179 target
= (unsigned char *) alloca (s
- o
+ 1);
2180 strncpy (target
, o
, s
- o
);
2183 strupr (target
); /* $home == $HOME etc. */
2186 /* Get variable value */
2187 o
= (unsigned char *) egetenv (target
);
2190 total
+= strlen (o
);
2200 /* If substitution required, recopy the string and do it */
2201 /* Make space in stack frame for the new copy */
2202 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2205 /* Copy the rest of the name through, replacing $ constructs with values */
2222 while (p
!= endp
&& *p
!= '}') p
++;
2223 if (*p
!= '}') goto missingclose
;
2229 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2233 /* Copy out the variable name */
2234 target
= (unsigned char *) alloca (s
- o
+ 1);
2235 strncpy (target
, o
, s
- o
);
2238 strupr (target
); /* $home == $HOME etc. */
2241 /* Get variable value */
2242 o
= (unsigned char *) egetenv (target
);
2246 strcpy (x
, target
); x
+= strlen (target
);
2248 else if (STRING_MULTIBYTE (filename
))
2250 /* If the original string is multibyte,
2251 convert what we substitute into multibyte. */
2254 int c
= unibyte_char_to_multibyte (*o
++);
2255 x
+= CHAR_STRING (c
, x
);
2267 /* If /~ or // appears, discard everything through first slash. */
2269 for (p
= xnm
; p
!= x
; p
++)
2271 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2272 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2273 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2274 || IS_DIRECTORY_SEP (p
[0])
2275 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2277 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2280 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2281 && p
> xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2285 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2288 error ("Bad format environment-variable substitution");
2290 error ("Missing \"}\" in environment-variable substitution");
2292 error ("Substituting nonexistent environment variable \"%s\"", target
);
2295 #endif /* not VMS */
2299 /* A slightly faster and more convenient way to get
2300 (directory-file-name (expand-file-name FOO)). */
2303 expand_and_dir_to_file (filename
, defdir
)
2304 Lisp_Object filename
, defdir
;
2306 register Lisp_Object absname
;
2308 absname
= Fexpand_file_name (filename
, defdir
);
2311 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2312 if (c
== ':' || c
== ']' || c
== '>')
2313 absname
= Fdirectory_file_name (absname
);
2316 /* Remove final slash, if any (unless this is the root dir).
2317 stat behaves differently depending! */
2318 if (SCHARS (absname
) > 1
2319 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2320 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2321 /* We cannot take shortcuts; they might be wrong for magic file names. */
2322 absname
= Fdirectory_file_name (absname
);
2327 /* Signal an error if the file ABSNAME already exists.
2328 If INTERACTIVE is nonzero, ask the user whether to proceed,
2329 and bypass the error if the user says to go ahead.
2330 QUERYSTRING is a name for the action that is being considered
2333 *STATPTR is used to store the stat information if the file exists.
2334 If the file does not exist, STATPTR->st_mode is set to 0.
2335 If STATPTR is null, we don't store into it.
2337 If QUICK is nonzero, we ask for y or n, not yes or no. */
2340 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2341 Lisp_Object absname
;
2342 unsigned char *querystring
;
2344 struct stat
*statptr
;
2347 register Lisp_Object tem
, encoded_filename
;
2348 struct stat statbuf
;
2349 struct gcpro gcpro1
;
2351 encoded_filename
= ENCODE_FILE (absname
);
2353 /* stat is a good way to tell whether the file exists,
2354 regardless of what access permissions it has. */
2355 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
2358 Fsignal (Qfile_already_exists
,
2359 Fcons (build_string ("File already exists"),
2360 Fcons (absname
, Qnil
)));
2362 tem
= format2 ("File %s already exists; %s anyway? ",
2363 absname
, build_string (querystring
));
2365 tem
= Fy_or_n_p (tem
);
2367 tem
= do_yes_or_no_p (tem
);
2370 Fsignal (Qfile_already_exists
,
2371 Fcons (build_string ("File already exists"),
2372 Fcons (absname
, Qnil
)));
2379 statptr
->st_mode
= 0;
2384 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2385 "fCopy file: \nFCopy %s to file: \np\nP",
2386 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2387 If NEWNAME names a directory, copy FILE there.
2388 Signals a `file-already-exists' error if file NEWNAME already exists,
2389 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
2390 A number as third arg means request confirmation if NEWNAME already exists.
2391 This is what happens in interactive use with M-x.
2392 Always sets the file modes of the output file to match the input file.
2393 Fourth arg KEEP-TIME non-nil means give the output file the same
2394 last-modified time as the old one. (This works on only some systems.)
2395 A prefix arg makes KEEP-TIME non-nil. */)
2396 (file
, newname
, ok_if_already_exists
, keep_time
)
2397 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2400 char buf
[16 * 1024];
2401 struct stat st
, out_st
;
2402 Lisp_Object handler
;
2403 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2404 int count
= SPECPDL_INDEX ();
2405 int input_file_statable_p
;
2406 Lisp_Object encoded_file
, encoded_newname
;
2408 encoded_file
= encoded_newname
= Qnil
;
2409 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2410 CHECK_STRING (file
);
2411 CHECK_STRING (newname
);
2413 if (!NILP (Ffile_directory_p (newname
)))
2414 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2416 newname
= Fexpand_file_name (newname
, Qnil
);
2418 file
= Fexpand_file_name (file
, Qnil
);
2420 /* If the input file name has special constructs in it,
2421 call the corresponding file handler. */
2422 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2423 /* Likewise for output file name. */
2425 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2426 if (!NILP (handler
))
2427 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2428 ok_if_already_exists
, keep_time
));
2430 encoded_file
= ENCODE_FILE (file
);
2431 encoded_newname
= ENCODE_FILE (newname
);
2433 if (NILP (ok_if_already_exists
)
2434 || INTEGERP (ok_if_already_exists
))
2435 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2436 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2437 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2441 if (!CopyFile (SDATA (encoded_file
),
2442 SDATA (encoded_newname
),
2444 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2445 /* CopyFile retains the timestamp by default. */
2446 else if (NILP (keep_time
))
2452 EMACS_GET_TIME (now
);
2453 filename
= SDATA (encoded_newname
);
2455 /* Ensure file is writable while its modified time is set. */
2456 attributes
= GetFileAttributes (filename
);
2457 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2458 if (set_file_times (filename
, now
, now
))
2460 /* Restore original attributes. */
2461 SetFileAttributes (filename
, attributes
);
2462 Fsignal (Qfile_date_error
,
2463 Fcons (build_string ("Cannot set file date"),
2464 Fcons (newname
, Qnil
)));
2466 /* Restore original attributes. */
2467 SetFileAttributes (filename
, attributes
);
2469 #else /* not WINDOWSNT */
2471 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2475 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2477 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2479 /* We can only copy regular files and symbolic links. Other files are not
2481 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2483 #if !defined (DOS_NT) || __DJGPP__ > 1
2484 if (out_st
.st_mode
!= 0
2485 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2488 report_file_error ("Input and output files are the same",
2489 Fcons (file
, Fcons (newname
, Qnil
)));
2493 #if defined (S_ISREG) && defined (S_ISLNK)
2494 if (input_file_statable_p
)
2496 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2498 #if defined (EISDIR)
2499 /* Get a better looking error message. */
2502 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2505 #endif /* S_ISREG && S_ISLNK */
2508 /* Create the copy file with the same record format as the input file */
2509 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2512 /* System's default file type was set to binary by _fmode in emacs.c. */
2513 ofd
= creat (SDATA (encoded_newname
), S_IREAD
| S_IWRITE
);
2514 #else /* not MSDOS */
2515 ofd
= creat (SDATA (encoded_newname
), 0666);
2516 #endif /* not MSDOS */
2519 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2521 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2525 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2526 if (emacs_write (ofd
, buf
, n
) != n
)
2527 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2530 /* Closing the output clobbers the file times on some systems. */
2531 if (emacs_close (ofd
) < 0)
2532 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2534 if (input_file_statable_p
)
2536 if (!NILP (keep_time
))
2538 EMACS_TIME atime
, mtime
;
2539 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2540 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2541 if (set_file_times (SDATA (encoded_newname
),
2543 Fsignal (Qfile_date_error
,
2544 Fcons (build_string ("Cannot set file date"),
2545 Fcons (newname
, Qnil
)));
2548 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2550 #if defined (__DJGPP__) && __DJGPP__ > 1
2551 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2552 and if it can't, it tells so. Otherwise, under MSDOS we usually
2553 get only the READ bit, which will make the copied file read-only,
2554 so it's better not to chmod at all. */
2555 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2556 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2557 #endif /* DJGPP version 2 or newer */
2562 #endif /* WINDOWSNT */
2564 /* Discard the unwind protects. */
2565 specpdl_ptr
= specpdl
+ count
;
2571 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2572 Smake_directory_internal
, 1, 1, 0,
2573 doc
: /* Create a new directory named DIRECTORY. */)
2575 Lisp_Object directory
;
2577 const unsigned char *dir
;
2578 Lisp_Object handler
;
2579 Lisp_Object encoded_dir
;
2581 CHECK_STRING (directory
);
2582 directory
= Fexpand_file_name (directory
, Qnil
);
2584 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2585 if (!NILP (handler
))
2586 return call2 (handler
, Qmake_directory_internal
, directory
);
2588 encoded_dir
= ENCODE_FILE (directory
);
2590 dir
= SDATA (encoded_dir
);
2593 if (mkdir (dir
) != 0)
2595 if (mkdir (dir
, 0777) != 0)
2597 report_file_error ("Creating directory", Flist (1, &directory
));
2602 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2603 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2605 Lisp_Object directory
;
2607 const unsigned char *dir
;
2608 Lisp_Object handler
;
2609 Lisp_Object encoded_dir
;
2611 CHECK_STRING (directory
);
2612 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2614 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2615 if (!NILP (handler
))
2616 return call2 (handler
, Qdelete_directory
, directory
);
2618 encoded_dir
= ENCODE_FILE (directory
);
2620 dir
= SDATA (encoded_dir
);
2622 if (rmdir (dir
) != 0)
2623 report_file_error ("Removing directory", Flist (1, &directory
));
2628 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2629 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2630 If file has multiple names, it continues to exist with the other names. */)
2632 Lisp_Object filename
;
2634 Lisp_Object handler
;
2635 Lisp_Object encoded_file
;
2636 struct gcpro gcpro1
;
2639 if (!NILP (Ffile_directory_p (filename
))
2640 && NILP (Ffile_symlink_p (filename
)))
2641 Fsignal (Qfile_error
,
2642 Fcons (build_string ("Removing old name: is a directory"),
2643 Fcons (filename
, Qnil
)));
2645 filename
= Fexpand_file_name (filename
, Qnil
);
2647 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2648 if (!NILP (handler
))
2649 return call2 (handler
, Qdelete_file
, filename
);
2651 encoded_file
= ENCODE_FILE (filename
);
2653 if (0 > unlink (SDATA (encoded_file
)))
2654 report_file_error ("Removing old name", Flist (1, &filename
));
2659 internal_delete_file_1 (ignore
)
2665 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2668 internal_delete_file (filename
)
2669 Lisp_Object filename
;
2671 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2672 Qt
, internal_delete_file_1
));
2675 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2676 "fRename file: \nFRename %s to file: \np",
2677 doc
: /* Rename FILE as NEWNAME. Both args strings.
2678 If file has names other than FILE, it continues to have those names.
2679 Signals a `file-already-exists' error if a file NEWNAME already exists
2680 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2681 A number as third arg means request confirmation if NEWNAME already exists.
2682 This is what happens in interactive use with M-x. */)
2683 (file
, newname
, ok_if_already_exists
)
2684 Lisp_Object file
, newname
, ok_if_already_exists
;
2687 Lisp_Object args
[2];
2689 Lisp_Object handler
;
2690 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2691 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2693 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2694 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2695 CHECK_STRING (file
);
2696 CHECK_STRING (newname
);
2697 file
= Fexpand_file_name (file
, Qnil
);
2698 newname
= Fexpand_file_name (newname
, Qnil
);
2700 /* If the file name has special constructs in it,
2701 call the corresponding file handler. */
2702 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2704 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2705 if (!NILP (handler
))
2706 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2707 file
, newname
, ok_if_already_exists
));
2709 encoded_file
= ENCODE_FILE (file
);
2710 encoded_newname
= ENCODE_FILE (newname
);
2713 /* If the file names are identical but for the case, don't ask for
2714 confirmation: they simply want to change the letter-case of the
2716 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2718 if (NILP (ok_if_already_exists
)
2719 || INTEGERP (ok_if_already_exists
))
2720 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2721 INTEGERP (ok_if_already_exists
), 0, 0);
2723 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2725 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2726 || 0 > unlink (SDATA (encoded_file
)))
2732 symlink_target
= Ffile_symlink_p (file
);
2733 if (! NILP (symlink_target
))
2734 Fmake_symbolic_link (symlink_target
, newname
,
2735 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2738 Fcopy_file (file
, newname
,
2739 /* We have already prompted if it was an integer,
2740 so don't have copy-file prompt again. */
2741 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2742 Fdelete_file (file
);
2749 report_file_error ("Renaming", Flist (2, args
));
2752 report_file_error ("Renaming", Flist (2, &file
));
2759 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2760 "fAdd name to file: \nFName to add to %s: \np",
2761 doc
: /* Give FILE additional name NEWNAME. Both args strings.
2762 Signals a `file-already-exists' error if a file NEWNAME already exists
2763 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2764 A number as third arg means request confirmation if NEWNAME already exists.
2765 This is what happens in interactive use with M-x. */)
2766 (file
, newname
, ok_if_already_exists
)
2767 Lisp_Object file
, newname
, ok_if_already_exists
;
2770 Lisp_Object args
[2];
2772 Lisp_Object handler
;
2773 Lisp_Object encoded_file
, encoded_newname
;
2774 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2776 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2777 encoded_file
= encoded_newname
= Qnil
;
2778 CHECK_STRING (file
);
2779 CHECK_STRING (newname
);
2780 file
= Fexpand_file_name (file
, Qnil
);
2781 newname
= Fexpand_file_name (newname
, Qnil
);
2783 /* If the file name has special constructs in it,
2784 call the corresponding file handler. */
2785 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2786 if (!NILP (handler
))
2787 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2788 newname
, ok_if_already_exists
));
2790 /* If the new name has special constructs in it,
2791 call the corresponding file handler. */
2792 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2793 if (!NILP (handler
))
2794 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2795 newname
, ok_if_already_exists
));
2797 encoded_file
= ENCODE_FILE (file
);
2798 encoded_newname
= ENCODE_FILE (newname
);
2800 if (NILP (ok_if_already_exists
)
2801 || INTEGERP (ok_if_already_exists
))
2802 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2803 INTEGERP (ok_if_already_exists
), 0, 0);
2805 unlink (SDATA (newname
));
2806 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2811 report_file_error ("Adding new name", Flist (2, args
));
2813 report_file_error ("Adding new name", Flist (2, &file
));
2822 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2823 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2824 doc
: /* Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2825 Signals a `file-already-exists' error if a file LINKNAME already exists
2826 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2827 A number as third arg means request confirmation if LINKNAME already exists.
2828 This happens for interactive use with M-x. */)
2829 (filename
, linkname
, ok_if_already_exists
)
2830 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2833 Lisp_Object args
[2];
2835 Lisp_Object handler
;
2836 Lisp_Object encoded_filename
, encoded_linkname
;
2837 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2839 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2840 encoded_filename
= encoded_linkname
= Qnil
;
2841 CHECK_STRING (filename
);
2842 CHECK_STRING (linkname
);
2843 /* If the link target has a ~, we must expand it to get
2844 a truly valid file name. Otherwise, do not expand;
2845 we want to permit links to relative file names. */
2846 if (SREF (filename
, 0) == '~')
2847 filename
= Fexpand_file_name (filename
, Qnil
);
2848 linkname
= Fexpand_file_name (linkname
, Qnil
);
2850 /* If the file name has special constructs in it,
2851 call the corresponding file handler. */
2852 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2853 if (!NILP (handler
))
2854 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2855 linkname
, ok_if_already_exists
));
2857 /* If the new link name has special constructs in it,
2858 call the corresponding file handler. */
2859 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2860 if (!NILP (handler
))
2861 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2862 linkname
, ok_if_already_exists
));
2864 encoded_filename
= ENCODE_FILE (filename
);
2865 encoded_linkname
= ENCODE_FILE (linkname
);
2867 if (NILP (ok_if_already_exists
)
2868 || INTEGERP (ok_if_already_exists
))
2869 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2870 INTEGERP (ok_if_already_exists
), 0, 0);
2871 if (0 > symlink (SDATA (encoded_filename
),
2872 SDATA (encoded_linkname
)))
2874 /* If we didn't complain already, silently delete existing file. */
2875 if (errno
== EEXIST
)
2877 unlink (SDATA (encoded_linkname
));
2878 if (0 <= symlink (SDATA (encoded_filename
),
2879 SDATA (encoded_linkname
)))
2889 report_file_error ("Making symbolic link", Flist (2, args
));
2891 report_file_error ("Making symbolic link", Flist (2, &filename
));
2897 #endif /* S_IFLNK */
2901 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2902 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2903 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2904 If STRING is nil or a null string, the logical name NAME is deleted. */)
2909 CHECK_STRING (name
);
2911 delete_logical_name (SDATA (name
));
2914 CHECK_STRING (string
);
2916 if (SCHARS (string
) == 0)
2917 delete_logical_name (SDATA (name
));
2919 define_logical_name (SDATA (name
), SDATA (string
));
2928 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2929 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2931 Lisp_Object path
, login
;
2935 CHECK_STRING (path
);
2936 CHECK_STRING (login
);
2938 netresult
= netunam (SDATA (path
), SDATA (login
));
2940 if (netresult
== -1)
2945 #endif /* HPUX_NET */
2947 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2949 doc
: /* Return t if file FILENAME specifies an absolute file name.
2950 On Unix, this is a name starting with a `/' or a `~'. */)
2952 Lisp_Object filename
;
2954 const unsigned char *ptr
;
2956 CHECK_STRING (filename
);
2957 ptr
= SDATA (filename
);
2958 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2960 /* ??? This criterion is probably wrong for '<'. */
2961 || index (ptr
, ':') || index (ptr
, '<')
2962 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2966 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2974 /* Return nonzero if file FILENAME exists and can be executed. */
2977 check_executable (filename
)
2981 int len
= strlen (filename
);
2984 if (stat (filename
, &st
) < 0)
2986 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2987 return ((st
.st_mode
& S_IEXEC
) != 0);
2989 return (S_ISREG (st
.st_mode
)
2991 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2992 || stricmp (suffix
, ".exe") == 0
2993 || stricmp (suffix
, ".bat") == 0)
2994 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2995 #endif /* not WINDOWSNT */
2996 #else /* not DOS_NT */
2997 #ifdef HAVE_EUIDACCESS
2998 return (euidaccess (filename
, 1) >= 0);
3000 /* Access isn't quite right because it uses the real uid
3001 and we really want to test with the effective uid.
3002 But Unix doesn't give us a right way to do it. */
3003 return (access (filename
, 1) >= 0);
3005 #endif /* not DOS_NT */
3008 /* Return nonzero if file FILENAME exists and can be written. */
3011 check_writable (filename
)
3016 if (stat (filename
, &st
) < 0)
3018 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3019 #else /* not MSDOS */
3020 #ifdef HAVE_EUIDACCESS
3021 return (euidaccess (filename
, 2) >= 0);
3023 /* Access isn't quite right because it uses the real uid
3024 and we really want to test with the effective uid.
3025 But Unix doesn't give us a right way to do it.
3026 Opening with O_WRONLY could work for an ordinary file,
3027 but would lose for directories. */
3028 return (access (filename
, 2) >= 0);
3030 #endif /* not MSDOS */
3033 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3034 doc
: /* Return t if file FILENAME exists. (This does not mean you can read it.)
3035 See also `file-readable-p' and `file-attributes'. */)
3037 Lisp_Object filename
;
3039 Lisp_Object absname
;
3040 Lisp_Object handler
;
3041 struct stat statbuf
;
3043 CHECK_STRING (filename
);
3044 absname
= Fexpand_file_name (filename
, Qnil
);
3046 /* If the file name has special constructs in it,
3047 call the corresponding file handler. */
3048 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3049 if (!NILP (handler
))
3050 return call2 (handler
, Qfile_exists_p
, absname
);
3052 absname
= ENCODE_FILE (absname
);
3054 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3057 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3058 doc
: /* Return t if FILENAME can be executed by you.
3059 For a directory, this means you can access files in that directory. */)
3061 Lisp_Object filename
;
3063 Lisp_Object absname
;
3064 Lisp_Object handler
;
3066 CHECK_STRING (filename
);
3067 absname
= Fexpand_file_name (filename
, Qnil
);
3069 /* If the file name has special constructs in it,
3070 call the corresponding file handler. */
3071 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3072 if (!NILP (handler
))
3073 return call2 (handler
, Qfile_executable_p
, absname
);
3075 absname
= ENCODE_FILE (absname
);
3077 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3080 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3081 doc
: /* Return t if file FILENAME exists and you can read it.
3082 See also `file-exists-p' and `file-attributes'. */)
3084 Lisp_Object filename
;
3086 Lisp_Object absname
;
3087 Lisp_Object handler
;
3090 struct stat statbuf
;
3092 CHECK_STRING (filename
);
3093 absname
= Fexpand_file_name (filename
, Qnil
);
3095 /* If the file name has special constructs in it,
3096 call the corresponding file handler. */
3097 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3098 if (!NILP (handler
))
3099 return call2 (handler
, Qfile_readable_p
, absname
);
3101 absname
= ENCODE_FILE (absname
);
3103 #if defined(DOS_NT) || defined(macintosh)
3104 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3106 if (access (SDATA (absname
), 0) == 0)
3109 #else /* not DOS_NT and not macintosh */
3111 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3112 /* Opening a fifo without O_NONBLOCK can wait.
3113 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3114 except in the case of a fifo, on a system which handles it. */
3115 desc
= stat (SDATA (absname
), &statbuf
);
3118 if (S_ISFIFO (statbuf
.st_mode
))
3119 flags
|= O_NONBLOCK
;
3121 desc
= emacs_open (SDATA (absname
), flags
, 0);
3126 #endif /* not DOS_NT and not macintosh */
3129 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3131 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3132 doc
: /* Return t if file FILENAME can be written or created by you. */)
3134 Lisp_Object filename
;
3136 Lisp_Object absname
, dir
, encoded
;
3137 Lisp_Object handler
;
3138 struct stat statbuf
;
3140 CHECK_STRING (filename
);
3141 absname
= Fexpand_file_name (filename
, Qnil
);
3143 /* If the file name has special constructs in it,
3144 call the corresponding file handler. */
3145 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3146 if (!NILP (handler
))
3147 return call2 (handler
, Qfile_writable_p
, absname
);
3149 encoded
= ENCODE_FILE (absname
);
3150 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3151 return (check_writable (SDATA (encoded
))
3154 dir
= Ffile_name_directory (absname
);
3157 dir
= Fdirectory_file_name (dir
);
3161 dir
= Fdirectory_file_name (dir
);
3164 dir
= ENCODE_FILE (dir
);
3166 /* The read-only attribute of the parent directory doesn't affect
3167 whether a file or directory can be created within it. Some day we
3168 should check ACLs though, which do affect this. */
3169 if (stat (SDATA (dir
), &statbuf
) < 0)
3171 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3173 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3178 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3179 doc
: /* Access file FILENAME, and get an error if that does not work.
3180 The second argument STRING is used in the error message.
3181 If there is no error, we return nil. */)
3183 Lisp_Object filename
, string
;
3185 Lisp_Object handler
, encoded_filename
, absname
;
3188 CHECK_STRING (filename
);
3189 absname
= Fexpand_file_name (filename
, Qnil
);
3191 CHECK_STRING (string
);
3193 /* If the file name has special constructs in it,
3194 call the corresponding file handler. */
3195 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3196 if (!NILP (handler
))
3197 return call3 (handler
, Qaccess_file
, absname
, string
);
3199 encoded_filename
= ENCODE_FILE (absname
);
3201 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3203 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3209 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3210 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3211 The value is the link target, as a string.
3212 Otherwise returns nil. */)
3214 Lisp_Object filename
;
3216 Lisp_Object handler
;
3218 CHECK_STRING (filename
);
3219 filename
= Fexpand_file_name (filename
, Qnil
);
3221 /* If the file name has special constructs in it,
3222 call the corresponding file handler. */
3223 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3224 if (!NILP (handler
))
3225 return call2 (handler
, Qfile_symlink_p
, filename
);
3234 filename
= ENCODE_FILE (filename
);
3241 buf
= (char *) xrealloc (buf
, bufsize
);
3242 bzero (buf
, bufsize
);
3245 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3249 /* HP-UX reports ERANGE if buffer is too small. */
3250 if (errno
== ERANGE
)
3260 while (valsize
>= bufsize
);
3262 val
= make_string (buf
, valsize
);
3263 if (buf
[0] == '/' && index (buf
, ':'))
3264 val
= concat2 (build_string ("/:"), val
);
3266 val
= DECODE_FILE (val
);
3269 #else /* not S_IFLNK */
3271 #endif /* not S_IFLNK */
3274 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3275 doc
: /* Return t if FILENAME names an existing directory.
3276 Symbolic links to directories count as directories.
3277 See `file-symlink-p' to distinguish symlinks. */)
3279 Lisp_Object filename
;
3281 register Lisp_Object absname
;
3283 Lisp_Object handler
;
3285 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3287 /* If the file name has special constructs in it,
3288 call the corresponding file handler. */
3289 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3290 if (!NILP (handler
))
3291 return call2 (handler
, Qfile_directory_p
, absname
);
3293 absname
= ENCODE_FILE (absname
);
3295 if (stat (SDATA (absname
), &st
) < 0)
3297 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3300 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3301 doc
: /* Return t if file FILENAME names a directory you can open.
3302 For the value to be t, FILENAME must specify the name of a directory as a file,
3303 and the directory must allow you to open files in it. In order to use a
3304 directory as a buffer's current directory, this predicate must return true.
3305 A directory name spec may be given instead; then the value is t
3306 if the directory so specified exists and really is a readable and
3307 searchable directory. */)
3309 Lisp_Object filename
;
3311 Lisp_Object handler
;
3313 struct gcpro gcpro1
;
3315 /* If the file name has special constructs in it,
3316 call the corresponding file handler. */
3317 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3318 if (!NILP (handler
))
3319 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3322 tem
= (NILP (Ffile_directory_p (filename
))
3323 || NILP (Ffile_executable_p (filename
)));
3325 return tem
? Qnil
: Qt
;
3328 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3329 doc
: /* Return t if file FILENAME is the name of a regular file.
3330 This is the sort of file that holds an ordinary stream of data bytes. */)
3332 Lisp_Object filename
;
3334 register Lisp_Object absname
;
3336 Lisp_Object handler
;
3338 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3340 /* If the file name has special constructs in it,
3341 call the corresponding file handler. */
3342 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3343 if (!NILP (handler
))
3344 return call2 (handler
, Qfile_regular_p
, absname
);
3346 absname
= ENCODE_FILE (absname
);
3351 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3353 /* Tell stat to use expensive method to get accurate info. */
3354 Vw32_get_true_file_attributes
= Qt
;
3355 result
= stat (SDATA (absname
), &st
);
3356 Vw32_get_true_file_attributes
= tem
;
3360 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3363 if (stat (SDATA (absname
), &st
) < 0)
3365 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3369 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3370 doc
: /* Return mode bits of file named FILENAME, as an integer.
3371 Return nil, if file does not exist or is not accessible. */)
3373 Lisp_Object filename
;
3375 Lisp_Object absname
;
3377 Lisp_Object handler
;
3379 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3381 /* If the file name has special constructs in it,
3382 call the corresponding file handler. */
3383 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3384 if (!NILP (handler
))
3385 return call2 (handler
, Qfile_modes
, absname
);
3387 absname
= ENCODE_FILE (absname
);
3389 if (stat (SDATA (absname
), &st
) < 0)
3391 #if defined (MSDOS) && __DJGPP__ < 2
3392 if (check_executable (SDATA (absname
)))
3393 st
.st_mode
|= S_IEXEC
;
3394 #endif /* MSDOS && __DJGPP__ < 2 */
3396 return make_number (st
.st_mode
& 07777);
3399 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3400 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3401 Only the 12 low bits of MODE are used. */)
3403 Lisp_Object filename
, mode
;
3405 Lisp_Object absname
, encoded_absname
;
3406 Lisp_Object handler
;
3408 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3409 CHECK_NUMBER (mode
);
3411 /* If the file name has special constructs in it,
3412 call the corresponding file handler. */
3413 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3414 if (!NILP (handler
))
3415 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3417 encoded_absname
= ENCODE_FILE (absname
);
3419 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3420 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3425 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3426 doc
: /* Set the file permission bits for newly created files.
3427 The argument MODE should be an integer; only the low 9 bits are used.
3428 This setting is inherited by subprocesses. */)
3432 CHECK_NUMBER (mode
);
3434 umask ((~ XINT (mode
)) & 0777);
3439 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3440 doc
: /* Return the default file protection for created files.
3441 The value is an integer. */)
3447 realmask
= umask (0);
3450 XSETINT (value
, (~ realmask
) & 0777);
3454 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3456 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3457 doc
: /* Set times of file FILENAME to TIME.
3458 Set both access and modification times.
3459 Return t on success, else nil.
3460 Use the current time if TIME is nil. TIME is in the format of
3463 Lisp_Object filename
, time
;
3465 Lisp_Object absname
, encoded_absname
;
3466 Lisp_Object handler
;
3470 if (! lisp_time_argument (time
, &sec
, &usec
))
3471 error ("Invalid time specification");
3473 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3475 /* If the file name has special constructs in it,
3476 call the corresponding file handler. */
3477 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3478 if (!NILP (handler
))
3479 return call3 (handler
, Qset_file_times
, absname
, time
);
3481 encoded_absname
= ENCODE_FILE (absname
);
3486 EMACS_SET_SECS (t
, sec
);
3487 EMACS_SET_USECS (t
, usec
);
3489 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3494 /* Setting times on a directory always fails. */
3495 if (stat (SDATA (encoded_absname
), &st
) == 0
3496 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3499 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3512 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3513 doc
: /* Tell Unix to finish all pending disk updates. */)
3522 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3523 doc
: /* Return t if file FILE1 is newer than file FILE2.
3524 If FILE1 does not exist, the answer is nil;
3525 otherwise, if FILE2 does not exist, the answer is t. */)
3527 Lisp_Object file1
, file2
;
3529 Lisp_Object absname1
, absname2
;
3532 Lisp_Object handler
;
3533 struct gcpro gcpro1
, gcpro2
;
3535 CHECK_STRING (file1
);
3536 CHECK_STRING (file2
);
3539 GCPRO2 (absname1
, file2
);
3540 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3541 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3544 /* If the file name has special constructs in it,
3545 call the corresponding file handler. */
3546 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3548 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3549 if (!NILP (handler
))
3550 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3552 GCPRO2 (absname1
, absname2
);
3553 absname1
= ENCODE_FILE (absname1
);
3554 absname2
= ENCODE_FILE (absname2
);
3557 if (stat (SDATA (absname1
), &st
) < 0)
3560 mtime1
= st
.st_mtime
;
3562 if (stat (SDATA (absname2
), &st
) < 0)
3565 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3569 Lisp_Object Qfind_buffer_file_type
;
3572 #ifndef READ_BUF_SIZE
3573 #define READ_BUF_SIZE (64 << 10)
3576 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3578 /* This function is called after Lisp functions to decide a coding
3579 system are called, or when they cause an error. Before they are
3580 called, the current buffer is set unibyte and it contains only a
3581 newly inserted text (thus the buffer was empty before the
3584 The functions may set markers, overlays, text properties, or even
3585 alter the buffer contents, change the current buffer.
3587 Here, we reset all those changes by:
3588 o set back the current buffer.
3589 o move all markers and overlays to BEG.
3590 o remove all text properties.
3591 o set back the buffer multibyteness. */
3594 decide_coding_unwind (unwind_data
)
3595 Lisp_Object unwind_data
;
3597 Lisp_Object multibyte
, undo_list
, buffer
;
3599 multibyte
= XCAR (unwind_data
);
3600 unwind_data
= XCDR (unwind_data
);
3601 undo_list
= XCAR (unwind_data
);
3602 buffer
= XCDR (unwind_data
);
3604 if (current_buffer
!= XBUFFER (buffer
))
3605 set_buffer_internal (XBUFFER (buffer
));
3606 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3607 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3608 BUF_INTERVALS (current_buffer
) = 0;
3609 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3611 /* Now we are safe to change the buffer's multibyteness directly. */
3612 current_buffer
->enable_multibyte_characters
= multibyte
;
3613 current_buffer
->undo_list
= undo_list
;
3619 /* Used to pass values from insert-file-contents to read_non_regular. */
3621 static int non_regular_fd
;
3622 static int non_regular_inserted
;
3623 static int non_regular_nbytes
;
3626 /* Read from a non-regular file.
3627 Read non_regular_trytry bytes max from non_regular_fd.
3628 Non_regular_inserted specifies where to put the read bytes.
3629 Value is the number of bytes read. */
3638 nbytes
= emacs_read (non_regular_fd
,
3639 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3640 non_regular_nbytes
);
3642 return make_number (nbytes
);
3646 /* Condition-case handler used when reading from non-regular files
3647 in insert-file-contents. */
3650 read_non_regular_quit ()
3656 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3658 doc
: /* Insert contents of file FILENAME after point.
3659 Returns list of absolute file name and number of characters inserted.
3660 If second argument VISIT is non-nil, the buffer's visited filename
3661 and last save file modtime are set, and it is marked unmodified.
3662 If visiting and the file does not exist, visiting is completed
3663 before the error is signaled.
3664 The optional third and fourth arguments BEG and END
3665 specify what portion of the file to insert.
3666 These arguments count bytes in the file, not characters in the buffer.
3667 If VISIT is non-nil, BEG and END must be nil.
3669 If optional fifth argument REPLACE is non-nil,
3670 it means replace the current buffer contents (in the accessible portion)
3671 with the file contents. This is better than simply deleting and inserting
3672 the whole thing because (1) it preserves some marker positions
3673 and (2) it puts less data in the undo list.
3674 When REPLACE is non-nil, the value is the number of characters actually read,
3675 which is often less than the number of characters to be read.
3677 This does code conversion according to the value of
3678 `coding-system-for-read' or `file-coding-system-alist',
3679 and sets the variable `last-coding-system-used' to the coding system
3681 (filename
, visit
, beg
, end
, replace
)
3682 Lisp_Object filename
, visit
, beg
, end
, replace
;
3687 register int how_much
;
3688 register int unprocessed
;
3689 int count
= SPECPDL_INDEX ();
3690 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3691 Lisp_Object handler
, val
, insval
, orig_filename
;
3694 int not_regular
= 0;
3695 unsigned char read_buf
[READ_BUF_SIZE
];
3696 struct coding_system coding
;
3697 unsigned char buffer
[1 << 14];
3698 int replace_handled
= 0;
3699 int set_coding_system
= 0;
3700 int coding_system_decided
= 0;
3703 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3704 error ("Cannot do file visiting in an indirect buffer");
3706 if (!NILP (current_buffer
->read_only
))
3707 Fbarf_if_buffer_read_only ();
3711 orig_filename
= Qnil
;
3713 GCPRO4 (filename
, val
, p
, orig_filename
);
3715 CHECK_STRING (filename
);
3716 filename
= Fexpand_file_name (filename
, Qnil
);
3718 /* If the file name has special constructs in it,
3719 call the corresponding file handler. */
3720 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3721 if (!NILP (handler
))
3723 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3724 visit
, beg
, end
, replace
);
3725 if (CONSP (val
) && CONSP (XCDR (val
)))
3726 inserted
= XINT (XCAR (XCDR (val
)));
3730 orig_filename
= filename
;
3731 filename
= ENCODE_FILE (filename
);
3737 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3739 /* Tell stat to use expensive method to get accurate info. */
3740 Vw32_get_true_file_attributes
= Qt
;
3741 total
= stat (SDATA (filename
), &st
);
3742 Vw32_get_true_file_attributes
= tem
;
3747 if (stat (SDATA (filename
), &st
) < 0)
3749 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3750 || fstat (fd
, &st
) < 0)
3751 #endif /* not APOLLO */
3752 #endif /* WINDOWSNT */
3754 if (fd
>= 0) emacs_close (fd
);
3757 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3760 if (!NILP (Vcoding_system_for_read
))
3761 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3766 /* This code will need to be changed in order to work on named
3767 pipes, and it's probably just not worth it. So we should at
3768 least signal an error. */
3769 if (!S_ISREG (st
.st_mode
))
3776 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3777 Fsignal (Qfile_error
,
3778 Fcons (build_string ("not a regular file"),
3779 Fcons (orig_filename
, Qnil
)));
3784 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3787 /* Replacement should preserve point as it preserves markers. */
3788 if (!NILP (replace
))
3789 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3791 record_unwind_protect (close_file_unwind
, make_number (fd
));
3793 /* Supposedly happens on VMS. */
3794 /* Can happen on any platform that uses long as type of off_t, but allows
3795 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3796 give a message suitable for the latter case. */
3797 if (! not_regular
&& st
.st_size
< 0)
3798 error ("Maximum buffer size exceeded");
3800 /* Prevent redisplay optimizations. */
3801 current_buffer
->clip_changed
= 1;
3805 if (!NILP (beg
) || !NILP (end
))
3806 error ("Attempt to visit less than an entire file");
3807 if (BEG
< Z
&& NILP (replace
))
3808 error ("Cannot do file visiting in a non-empty buffer");
3814 XSETFASTINT (beg
, 0);
3822 XSETINT (end
, st
.st_size
);
3824 /* Arithmetic overflow can occur if an Emacs integer cannot
3825 represent the file size, or if the calculations below
3826 overflow. The calculations below double the file size
3827 twice, so check that it can be multiplied by 4 safely. */
3828 if (XINT (end
) != st
.st_size
3829 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3830 error ("Maximum buffer size exceeded");
3832 /* The file size returned from stat may be zero, but data
3833 may be readable nonetheless, for example when this is a
3834 file in the /proc filesystem. */
3835 if (st
.st_size
== 0)
3836 XSETINT (end
, READ_BUF_SIZE
);
3840 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3842 /* We use emacs-mule for auto saving... */
3843 setup_coding_system (Qemacs_mule
, &coding
);
3844 /* ... but with the special flag to indicate to read in a
3845 multibyte sequence for eight-bit-control char as is. */
3847 coding
.src_multibyte
= 0;
3848 coding
.dst_multibyte
3849 = !NILP (current_buffer
->enable_multibyte_characters
);
3850 coding
.eol_type
= CODING_EOL_LF
;
3851 coding_system_decided
= 1;
3855 /* Decide the coding system to use for reading the file now
3856 because we can't use an optimized method for handling
3857 `coding:' tag if the current buffer is not empty. */
3861 if (!NILP (Vcoding_system_for_read
))
3862 val
= Vcoding_system_for_read
;
3865 /* Don't try looking inside a file for a coding system
3866 specification if it is not seekable. */
3867 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3869 /* Find a coding system specified in the heading two
3870 lines or in the tailing several lines of the file.
3871 We assume that the 1K-byte and 3K-byte for heading
3872 and tailing respectively are sufficient for this
3876 if (st
.st_size
<= (1024 * 4))
3877 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3880 nread
= emacs_read (fd
, read_buf
, 1024);
3883 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3884 report_file_error ("Setting file position",
3885 Fcons (orig_filename
, Qnil
));
3886 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3891 error ("IO error reading %s: %s",
3892 SDATA (orig_filename
), emacs_strerror (errno
));
3895 struct buffer
*prev
= current_buffer
;
3899 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3901 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3902 buf
= XBUFFER (buffer
);
3904 delete_all_overlays (buf
);
3905 buf
->directory
= current_buffer
->directory
;
3906 buf
->read_only
= Qnil
;
3907 buf
->filename
= Qnil
;
3908 buf
->undo_list
= Qt
;
3909 eassert (buf
->overlays_before
== NULL
);
3910 eassert (buf
->overlays_after
== NULL
);
3912 set_buffer_internal (buf
);
3914 buf
->enable_multibyte_characters
= Qnil
;
3916 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3917 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3918 val
= call2 (Vset_auto_coding_function
,
3919 filename
, make_number (nread
));
3920 set_buffer_internal (prev
);
3922 /* Discard the unwind protect for recovering the
3926 /* Rewind the file for the actual read done later. */
3927 if (lseek (fd
, 0, 0) < 0)
3928 report_file_error ("Setting file position",
3929 Fcons (orig_filename
, Qnil
));
3935 /* If we have not yet decided a coding system, check
3936 file-coding-system-alist. */
3937 Lisp_Object args
[6], coding_systems
;
3939 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3940 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3941 coding_systems
= Ffind_operation_coding_system (6, args
);
3942 if (CONSP (coding_systems
))
3943 val
= XCAR (coding_systems
);
3947 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3948 /* Ensure we set Vlast_coding_system_used. */
3949 set_coding_system
= 1;
3951 if (NILP (current_buffer
->enable_multibyte_characters
)
3953 /* We must suppress all character code conversion except for
3954 end-of-line conversion. */
3955 setup_raw_text_coding_system (&coding
);
3957 coding
.src_multibyte
= 0;
3958 coding
.dst_multibyte
3959 = !NILP (current_buffer
->enable_multibyte_characters
);
3960 coding_system_decided
= 1;
3963 /* If requested, replace the accessible part of the buffer
3964 with the file contents. Avoid replacing text at the
3965 beginning or end of the buffer that matches the file contents;
3966 that preserves markers pointing to the unchanged parts.
3968 Here we implement this feature in an optimized way
3969 for the case where code conversion is NOT needed.
3970 The following if-statement handles the case of conversion
3971 in a less optimal way.
3973 If the code conversion is "automatic" then we try using this
3974 method and hope for the best.
3975 But if we discover the need for conversion, we give up on this method
3976 and let the following if-statement handle the replace job. */
3979 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
3981 /* same_at_start and same_at_end count bytes,
3982 because file access counts bytes
3983 and BEG and END count bytes. */
3984 int same_at_start
= BEGV_BYTE
;
3985 int same_at_end
= ZV_BYTE
;
3987 /* There is still a possibility we will find the need to do code
3988 conversion. If that happens, we set this variable to 1 to
3989 give up on handling REPLACE in the optimized way. */
3990 int giveup_match_end
= 0;
3992 if (XINT (beg
) != 0)
3994 if (lseek (fd
, XINT (beg
), 0) < 0)
3995 report_file_error ("Setting file position",
3996 Fcons (orig_filename
, Qnil
));
4001 /* Count how many chars at the start of the file
4002 match the text at the beginning of the buffer. */
4007 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4009 error ("IO error reading %s: %s",
4010 SDATA (orig_filename
), emacs_strerror (errno
));
4011 else if (nread
== 0)
4014 if (coding
.type
== coding_type_undecided
)
4015 detect_coding (&coding
, buffer
, nread
);
4016 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
4017 /* We found that the file should be decoded somehow.
4018 Let's give up here. */
4020 giveup_match_end
= 1;
4024 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
4025 detect_eol (&coding
, buffer
, nread
);
4026 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
4027 && coding
.eol_type
!= CODING_EOL_LF
)
4028 /* We found that the format of eol should be decoded.
4029 Let's give up here. */
4031 giveup_match_end
= 1;
4036 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4037 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4038 same_at_start
++, bufpos
++;
4039 /* If we found a discrepancy, stop the scan.
4040 Otherwise loop around and scan the next bufferful. */
4041 if (bufpos
!= nread
)
4045 /* If the file matches the buffer completely,
4046 there's no need to replace anything. */
4047 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4051 /* Truncate the buffer to the size of the file. */
4052 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4057 /* Count how many chars at the end of the file
4058 match the text at the end of the buffer. But, if we have
4059 already found that decoding is necessary, don't waste time. */
4060 while (!giveup_match_end
)
4062 int total_read
, nread
, bufpos
, curpos
, trial
;
4064 /* At what file position are we now scanning? */
4065 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4066 /* If the entire file matches the buffer tail, stop the scan. */
4069 /* How much can we scan in the next step? */
4070 trial
= min (curpos
, sizeof buffer
);
4071 if (lseek (fd
, curpos
- trial
, 0) < 0)
4072 report_file_error ("Setting file position",
4073 Fcons (orig_filename
, Qnil
));
4075 total_read
= nread
= 0;
4076 while (total_read
< trial
)
4078 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4080 error ("IO error reading %s: %s",
4081 SDATA (orig_filename
), emacs_strerror (errno
));
4082 else if (nread
== 0)
4084 total_read
+= nread
;
4087 /* Scan this bufferful from the end, comparing with
4088 the Emacs buffer. */
4089 bufpos
= total_read
;
4091 /* Compare with same_at_start to avoid counting some buffer text
4092 as matching both at the file's beginning and at the end. */
4093 while (bufpos
> 0 && same_at_end
> same_at_start
4094 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4095 same_at_end
--, bufpos
--;
4097 /* If we found a discrepancy, stop the scan.
4098 Otherwise loop around and scan the preceding bufferful. */
4101 /* If this discrepancy is because of code conversion,
4102 we cannot use this method; giveup and try the other. */
4103 if (same_at_end
> same_at_start
4104 && FETCH_BYTE (same_at_end
- 1) >= 0200
4105 && ! NILP (current_buffer
->enable_multibyte_characters
)
4106 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4107 giveup_match_end
= 1;
4116 if (! giveup_match_end
)
4120 /* We win! We can handle REPLACE the optimized way. */
4122 /* Extend the start of non-matching text area to multibyte
4123 character boundary. */
4124 if (! NILP (current_buffer
->enable_multibyte_characters
))
4125 while (same_at_start
> BEGV_BYTE
4126 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4129 /* Extend the end of non-matching text area to multibyte
4130 character boundary. */
4131 if (! NILP (current_buffer
->enable_multibyte_characters
))
4132 while (same_at_end
< ZV_BYTE
4133 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4136 /* Don't try to reuse the same piece of text twice. */
4137 overlap
= (same_at_start
- BEGV_BYTE
4138 - (same_at_end
+ st
.st_size
- ZV
));
4140 same_at_end
+= overlap
;
4142 /* Arrange to read only the nonmatching middle part of the file. */
4143 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4144 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4146 del_range_byte (same_at_start
, same_at_end
, 0);
4147 /* Insert from the file at the proper position. */
4148 temp
= BYTE_TO_CHAR (same_at_start
);
4149 SET_PT_BOTH (temp
, same_at_start
);
4151 /* If display currently starts at beginning of line,
4152 keep it that way. */
4153 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4154 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4156 replace_handled
= 1;
4160 /* If requested, replace the accessible part of the buffer
4161 with the file contents. Avoid replacing text at the
4162 beginning or end of the buffer that matches the file contents;
4163 that preserves markers pointing to the unchanged parts.
4165 Here we implement this feature for the case where code conversion
4166 is needed, in a simple way that needs a lot of memory.
4167 The preceding if-statement handles the case of no conversion
4168 in a more optimized way. */
4169 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4171 int same_at_start
= BEGV_BYTE
;
4172 int same_at_end
= ZV_BYTE
;
4175 /* Make sure that the gap is large enough. */
4176 int bufsize
= 2 * st
.st_size
;
4177 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4180 /* First read the whole file, performing code conversion into
4181 CONVERSION_BUFFER. */
4183 if (lseek (fd
, XINT (beg
), 0) < 0)
4185 xfree (conversion_buffer
);
4186 report_file_error ("Setting file position",
4187 Fcons (orig_filename
, Qnil
));
4190 total
= st
.st_size
; /* Total bytes in the file. */
4191 how_much
= 0; /* Bytes read from file so far. */
4192 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4193 unprocessed
= 0; /* Bytes not processed in previous loop. */
4195 while (how_much
< total
)
4197 /* try is reserved in some compilers (Microsoft C) */
4198 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4199 unsigned char *destination
= read_buf
+ unprocessed
;
4202 /* Allow quitting out of the actual I/O. */
4205 this = emacs_read (fd
, destination
, trytry
);
4208 if (this < 0 || this + unprocessed
== 0)
4216 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4218 int require
, result
;
4220 this += unprocessed
;
4222 /* If we are using more space than estimated,
4223 make CONVERSION_BUFFER bigger. */
4224 require
= decoding_buffer_size (&coding
, this);
4225 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4227 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4228 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4231 /* Convert this batch with results in CONVERSION_BUFFER. */
4232 if (how_much
>= total
) /* This is the last block. */
4233 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4234 if (coding
.composing
!= COMPOSITION_DISABLED
)
4235 coding_allocate_composition_data (&coding
, BEGV
);
4236 result
= decode_coding (&coding
, read_buf
,
4237 conversion_buffer
+ inserted
,
4238 this, bufsize
- inserted
);
4240 /* Save for next iteration whatever we didn't convert. */
4241 unprocessed
= this - coding
.consumed
;
4242 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4243 if (!NILP (current_buffer
->enable_multibyte_characters
))
4244 this = coding
.produced
;
4246 this = str_as_unibyte (conversion_buffer
+ inserted
,
4253 /* At this point, INSERTED is how many characters (i.e. bytes)
4254 are present in CONVERSION_BUFFER.
4255 HOW_MUCH should equal TOTAL,
4256 or should be <= 0 if we couldn't read the file. */
4260 xfree (conversion_buffer
);
4261 coding_free_composition_data (&coding
);
4263 error ("IO error reading %s: %s",
4264 SDATA (orig_filename
), emacs_strerror (errno
));
4265 else if (how_much
== -2)
4266 error ("maximum buffer size exceeded");
4269 /* Compare the beginning of the converted file
4270 with the buffer text. */
4273 while (bufpos
< inserted
&& same_at_start
< same_at_end
4274 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4275 same_at_start
++, bufpos
++;
4277 /* If the file matches the buffer completely,
4278 there's no need to replace anything. */
4280 if (bufpos
== inserted
)
4282 xfree (conversion_buffer
);
4283 coding_free_composition_data (&coding
);
4286 /* Truncate the buffer to the size of the file. */
4287 del_range_byte (same_at_start
, same_at_end
, 0);
4292 /* Extend the start of non-matching text area to multibyte
4293 character boundary. */
4294 if (! NILP (current_buffer
->enable_multibyte_characters
))
4295 while (same_at_start
> BEGV_BYTE
4296 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4299 /* Scan this bufferful from the end, comparing with
4300 the Emacs buffer. */
4303 /* Compare with same_at_start to avoid counting some buffer text
4304 as matching both at the file's beginning and at the end. */
4305 while (bufpos
> 0 && same_at_end
> same_at_start
4306 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4307 same_at_end
--, bufpos
--;
4309 /* Extend the end of non-matching text area to multibyte
4310 character boundary. */
4311 if (! NILP (current_buffer
->enable_multibyte_characters
))
4312 while (same_at_end
< ZV_BYTE
4313 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4316 /* Don't try to reuse the same piece of text twice. */
4317 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4319 same_at_end
+= overlap
;
4321 /* If display currently starts at beginning of line,
4322 keep it that way. */
4323 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4324 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4326 /* Replace the chars that we need to replace,
4327 and update INSERTED to equal the number of bytes
4328 we are taking from the file. */
4329 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4331 if (same_at_end
!= same_at_start
)
4333 del_range_byte (same_at_start
, same_at_end
, 0);
4335 same_at_start
= GPT_BYTE
;
4339 temp
= BYTE_TO_CHAR (same_at_start
);
4341 /* Insert from the file at the proper position. */
4342 SET_PT_BOTH (temp
, same_at_start
);
4343 insert_1 (conversion_buffer
+ same_at_start
- BEGV_BYTE
, inserted
,
4345 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4346 coding_restore_composition (&coding
, Fcurrent_buffer ());
4347 coding_free_composition_data (&coding
);
4349 /* Set `inserted' to the number of inserted characters. */
4350 inserted
= PT
- temp
;
4352 xfree (conversion_buffer
);
4361 register Lisp_Object temp
;
4363 total
= XINT (end
) - XINT (beg
);
4365 /* Make sure point-max won't overflow after this insertion. */
4366 XSETINT (temp
, total
);
4367 if (total
!= XINT (temp
))
4368 error ("Maximum buffer size exceeded");
4371 /* For a special file, all we can do is guess. */
4372 total
= READ_BUF_SIZE
;
4374 if (NILP (visit
) && total
> 0)
4375 prepare_to_modify_buffer (PT
, PT
, NULL
);
4378 if (GAP_SIZE
< total
)
4379 make_gap (total
- GAP_SIZE
);
4381 if (XINT (beg
) != 0 || !NILP (replace
))
4383 if (lseek (fd
, XINT (beg
), 0) < 0)
4384 report_file_error ("Setting file position",
4385 Fcons (orig_filename
, Qnil
));
4388 /* In the following loop, HOW_MUCH contains the total bytes read so
4389 far for a regular file, and not changed for a special file. But,
4390 before exiting the loop, it is set to a negative value if I/O
4394 /* Total bytes inserted. */
4397 /* Here, we don't do code conversion in the loop. It is done by
4398 code_convert_region after all data are read into the buffer. */
4400 int gap_size
= GAP_SIZE
;
4402 while (how_much
< total
)
4404 /* try is reserved in some compilers (Microsoft C) */
4405 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4412 /* Maybe make more room. */
4413 if (gap_size
< trytry
)
4415 make_gap (total
- gap_size
);
4416 gap_size
= GAP_SIZE
;
4419 /* Read from the file, capturing `quit'. When an
4420 error occurs, end the loop, and arrange for a quit
4421 to be signaled after decoding the text we read. */
4422 non_regular_fd
= fd
;
4423 non_regular_inserted
= inserted
;
4424 non_regular_nbytes
= trytry
;
4425 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4426 read_non_regular_quit
);
4437 /* Allow quitting out of the actual I/O. We don't make text
4438 part of the buffer until all the reading is done, so a C-g
4439 here doesn't do any harm. */
4442 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4454 /* For a regular file, where TOTAL is the real size,
4455 count HOW_MUCH to compare with it.
4456 For a special file, where TOTAL is just a buffer size,
4457 so don't bother counting in HOW_MUCH.
4458 (INSERTED is where we count the number of characters inserted.) */
4465 /* Make the text read part of the buffer. */
4466 GAP_SIZE
-= inserted
;
4468 GPT_BYTE
+= inserted
;
4470 ZV_BYTE
+= inserted
;
4475 /* Put an anchor to ensure multi-byte form ends at gap. */
4480 /* Discard the unwind protect for closing the file. */
4484 error ("IO error reading %s: %s",
4485 SDATA (orig_filename
), emacs_strerror (errno
));
4489 if (! coding_system_decided
)
4491 /* The coding system is not yet decided. Decide it by an
4492 optimized method for handling `coding:' tag.
4494 Note that we can get here only if the buffer was empty
4495 before the insertion. */
4499 if (!NILP (Vcoding_system_for_read
))
4500 val
= Vcoding_system_for_read
;
4503 /* Since we are sure that the current buffer was empty
4504 before the insertion, we can toggle
4505 enable-multibyte-characters directly here without taking
4506 care of marker adjustment and byte combining problem. By
4507 this way, we can run Lisp program safely before decoding
4508 the inserted text. */
4509 Lisp_Object unwind_data
;
4510 int count
= SPECPDL_INDEX ();
4512 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4513 Fcons (current_buffer
->undo_list
,
4514 Fcurrent_buffer ()));
4515 current_buffer
->enable_multibyte_characters
= Qnil
;
4516 current_buffer
->undo_list
= Qt
;
4517 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4519 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4521 val
= call2 (Vset_auto_coding_function
,
4522 filename
, make_number (inserted
));
4527 /* If the coding system is not yet decided, check
4528 file-coding-system-alist. */
4529 Lisp_Object args
[6], coding_systems
;
4531 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4532 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4533 coding_systems
= Ffind_operation_coding_system (6, args
);
4534 if (CONSP (coding_systems
))
4535 val
= XCAR (coding_systems
);
4538 unbind_to (count
, Qnil
);
4539 inserted
= Z_BYTE
- BEG_BYTE
;
4542 /* The following kludgy code is to avoid some compiler bug.
4544 setup_coding_system (val, &coding);
4547 struct coding_system temp_coding
;
4548 setup_coding_system (val
, &temp_coding
);
4549 bcopy (&temp_coding
, &coding
, sizeof coding
);
4551 /* Ensure we set Vlast_coding_system_used. */
4552 set_coding_system
= 1;
4554 if (NILP (current_buffer
->enable_multibyte_characters
)
4556 /* We must suppress all character code conversion except for
4557 end-of-line conversion. */
4558 setup_raw_text_coding_system (&coding
);
4559 coding
.src_multibyte
= 0;
4560 coding
.dst_multibyte
4561 = !NILP (current_buffer
->enable_multibyte_characters
);
4565 /* Can't do this if part of the buffer might be preserved. */
4567 && (coding
.type
== coding_type_no_conversion
4568 || coding
.type
== coding_type_raw_text
))
4570 /* Visiting a file with these coding system makes the buffer
4572 current_buffer
->enable_multibyte_characters
= Qnil
;
4573 coding
.dst_multibyte
= 0;
4576 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4578 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4580 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4582 inserted
= coding
.produced_char
;
4585 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4589 /* Now INSERTED is measured in characters. */
4592 /* Use the conversion type to determine buffer-file-type
4593 (find-buffer-file-type is now used to help determine the
4595 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4596 || coding
.eol_type
== CODING_EOL_LF
)
4597 && ! CODING_REQUIRE_DECODING (&coding
))
4598 current_buffer
->buffer_file_type
= Qt
;
4600 current_buffer
->buffer_file_type
= Qnil
;
4607 if (!EQ (current_buffer
->undo_list
, Qt
))
4608 current_buffer
->undo_list
= Qnil
;
4610 stat (SDATA (filename
), &st
);
4615 current_buffer
->modtime
= st
.st_mtime
;
4616 current_buffer
->filename
= orig_filename
;
4619 SAVE_MODIFF
= MODIFF
;
4620 current_buffer
->auto_save_modified
= MODIFF
;
4621 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4622 #ifdef CLASH_DETECTION
4625 if (!NILP (current_buffer
->file_truename
))
4626 unlock_file (current_buffer
->file_truename
);
4627 unlock_file (filename
);
4629 #endif /* CLASH_DETECTION */
4631 Fsignal (Qfile_error
,
4632 Fcons (build_string ("not a regular file"),
4633 Fcons (orig_filename
, Qnil
)));
4636 if (set_coding_system
)
4637 Vlast_coding_system_used
= coding
.symbol
;
4639 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4641 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4643 if (! NILP (insval
))
4645 CHECK_NUMBER (insval
);
4646 inserted
= XFASTINT (insval
);
4650 /* Decode file format */
4653 int empty_undo_list_p
= 0;
4655 /* If we're anyway going to discard undo information, don't
4656 record it in the first place. The buffer's undo list at this
4657 point is either nil or t when visiting a file. */
4660 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4661 current_buffer
->undo_list
= Qt
;
4664 insval
= call3 (Qformat_decode
,
4665 Qnil
, make_number (inserted
), visit
);
4666 CHECK_NUMBER (insval
);
4667 inserted
= XFASTINT (insval
);
4670 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4673 /* Call after-change hooks for the inserted text, aside from the case
4674 of normal visiting (not with REPLACE), which is done in a new buffer
4675 "before" the buffer is changed. */
4676 if (inserted
> 0 && total
> 0
4677 && (NILP (visit
) || !NILP (replace
)))
4679 signal_after_change (PT
, 0, inserted
);
4680 update_compositions (PT
, PT
, CHECK_BORDER
);
4683 p
= Vafter_insert_file_functions
;
4686 insval
= call1 (XCAR (p
), make_number (inserted
));
4689 CHECK_NUMBER (insval
);
4690 inserted
= XFASTINT (insval
);
4697 && current_buffer
->modtime
== -1)
4699 /* If visiting nonexistent file, return nil. */
4700 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4704 Fsignal (Qquit
, Qnil
);
4706 /* ??? Retval needs to be dealt with in all cases consistently. */
4708 val
= Fcons (orig_filename
,
4709 Fcons (make_number (inserted
),
4712 RETURN_UNGCPRO (unbind_to (count
, val
));
4715 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4716 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4717 Lisp_Object
, Lisp_Object
));
4719 /* If build_annotations switched buffers, switch back to BUF.
4720 Kill the temporary buffer that was selected in the meantime.
4722 Since this kill only the last temporary buffer, some buffers remain
4723 not killed if build_annotations switched buffers more than once.
4727 build_annotations_unwind (buf
)
4732 if (XBUFFER (buf
) == current_buffer
)
4734 tembuf
= Fcurrent_buffer ();
4736 Fkill_buffer (tembuf
);
4740 /* Decide the coding-system to encode the data with. */
4743 choose_write_coding_system (start
, end
, filename
,
4744 append
, visit
, lockname
, coding
)
4745 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4746 struct coding_system
*coding
;
4751 && NILP (Fstring_equal (current_buffer
->filename
,
4752 current_buffer
->auto_save_file_name
)))
4754 /* We use emacs-mule for auto saving... */
4755 setup_coding_system (Qemacs_mule
, coding
);
4756 /* ... but with the special flag to indicate not to strip off
4757 leading code of eight-bit-control chars. */
4759 goto done_setup_coding
;
4761 else if (!NILP (Vcoding_system_for_write
))
4763 val
= Vcoding_system_for_write
;
4764 if (coding_system_require_warning
4765 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4766 /* Confirm that VAL can surely encode the current region. */
4767 val
= call5 (Vselect_safe_coding_system_function
,
4768 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4773 /* If the variable `buffer-file-coding-system' is set locally,
4774 it means that the file was read with some kind of code
4775 conversion or the variable is explicitly set by users. We
4776 had better write it out with the same coding system even if
4777 `enable-multibyte-characters' is nil.
4779 If it is not set locally, we anyway have to convert EOL
4780 format if the default value of `buffer-file-coding-system'
4781 tells that it is not Unix-like (LF only) format. */
4782 int using_default_coding
= 0;
4783 int force_raw_text
= 0;
4785 val
= current_buffer
->buffer_file_coding_system
;
4787 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4790 if (NILP (current_buffer
->enable_multibyte_characters
))
4796 /* Check file-coding-system-alist. */
4797 Lisp_Object args
[7], coding_systems
;
4799 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4800 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4802 coding_systems
= Ffind_operation_coding_system (7, args
);
4803 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4804 val
= XCDR (coding_systems
);
4808 && !NILP (current_buffer
->buffer_file_coding_system
))
4810 /* If we still have not decided a coding system, use the
4811 default value of buffer-file-coding-system. */
4812 val
= current_buffer
->buffer_file_coding_system
;
4813 using_default_coding
= 1;
4817 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4818 /* Confirm that VAL can surely encode the current region. */
4819 val
= call5 (Vselect_safe_coding_system_function
,
4820 start
, end
, val
, Qnil
, filename
);
4822 setup_coding_system (Fcheck_coding_system (val
), coding
);
4823 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4824 && !using_default_coding
)
4826 if (! EQ (default_buffer_file_coding
.symbol
,
4827 buffer_defaults
.buffer_file_coding_system
))
4828 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4829 &default_buffer_file_coding
);
4830 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4832 Lisp_Object subsidiaries
;
4834 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4835 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4836 if (VECTORP (subsidiaries
)
4837 && XVECTOR (subsidiaries
)->size
== 3)
4839 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4844 setup_raw_text_coding_system (coding
);
4845 goto done_setup_coding
;
4848 setup_coding_system (Fcheck_coding_system (val
), coding
);
4851 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4852 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4855 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4856 "r\nFWrite region to file: \ni\ni\ni\np",
4857 doc
: /* Write current region into specified file.
4858 When called from a program, requires three arguments:
4859 START, END and FILENAME. START and END are normally buffer positions
4860 specifying the part of the buffer to write.
4861 If START is nil, that means to use the entire buffer contents.
4862 If START is a string, then output that string to the file
4863 instead of any buffer contents; END is ignored.
4865 Optional fourth argument APPEND if non-nil means
4866 append to existing file contents (if any). If it is an integer,
4867 seek to that offset in the file before writing.
4868 Optional fifth argument VISIT, if t or a string, means
4869 set the last-save-file-modtime of buffer to this file's modtime
4870 and mark buffer not modified.
4871 If VISIT is a string, it is a second file name;
4872 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4873 VISIT is also the file name to lock and unlock for clash detection.
4874 If VISIT is neither t nor nil nor a string,
4875 that means do not display the \"Wrote file\" message.
4876 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4877 use for locking and unlocking, overriding FILENAME and VISIT.
4878 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4879 for an existing file with the same name. If MUSTBENEW is `excl',
4880 that means to get an error if the file already exists; never overwrite.
4881 If MUSTBENEW is neither nil nor `excl', that means ask for
4882 confirmation before overwriting, but do go ahead and overwrite the file
4883 if the user confirms.
4885 This does code conversion according to the value of
4886 `coding-system-for-write', `buffer-file-coding-system', or
4887 `file-coding-system-alist', and sets the variable
4888 `last-coding-system-used' to the coding system actually used. */)
4889 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4890 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4895 const unsigned char *fn
;
4898 int count
= SPECPDL_INDEX ();
4901 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4903 Lisp_Object handler
;
4904 Lisp_Object visit_file
;
4905 Lisp_Object annotations
;
4906 Lisp_Object encoded_filename
;
4907 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4908 int quietly
= !NILP (visit
);
4909 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4910 struct buffer
*given_buffer
;
4912 int buffer_file_type
= O_BINARY
;
4914 struct coding_system coding
;
4916 if (current_buffer
->base_buffer
&& visiting
)
4917 error ("Cannot do file visiting in an indirect buffer");
4919 if (!NILP (start
) && !STRINGP (start
))
4920 validate_region (&start
, &end
);
4922 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4924 filename
= Fexpand_file_name (filename
, Qnil
);
4926 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4927 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4929 if (STRINGP (visit
))
4930 visit_file
= Fexpand_file_name (visit
, Qnil
);
4932 visit_file
= filename
;
4934 if (NILP (lockname
))
4935 lockname
= visit_file
;
4939 /* If the file name has special constructs in it,
4940 call the corresponding file handler. */
4941 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4942 /* If FILENAME has no handler, see if VISIT has one. */
4943 if (NILP (handler
) && STRINGP (visit
))
4944 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4946 if (!NILP (handler
))
4949 val
= call6 (handler
, Qwrite_region
, start
, end
,
4950 filename
, append
, visit
);
4954 SAVE_MODIFF
= MODIFF
;
4955 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4956 current_buffer
->filename
= visit_file
;
4962 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4964 /* Special kludge to simplify auto-saving. */
4967 XSETFASTINT (start
, BEG
);
4968 XSETFASTINT (end
, Z
);
4972 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4973 count1
= SPECPDL_INDEX ();
4975 given_buffer
= current_buffer
;
4977 if (!STRINGP (start
))
4979 annotations
= build_annotations (start
, end
);
4981 if (current_buffer
!= given_buffer
)
4983 XSETFASTINT (start
, BEGV
);
4984 XSETFASTINT (end
, ZV
);
4990 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4992 /* Decide the coding-system to encode the data with.
4993 We used to make this choice before calling build_annotations, but that
4994 leads to problems when a write-annotate-function takes care of
4995 unsavable chars (as was the case with X-Symbol). */
4996 choose_write_coding_system (start
, end
, filename
,
4997 append
, visit
, lockname
, &coding
);
4998 Vlast_coding_system_used
= coding
.symbol
;
5000 given_buffer
= current_buffer
;
5001 if (! STRINGP (start
))
5003 annotations
= build_annotations_2 (start
, end
,
5004 coding
.pre_write_conversion
, annotations
);
5005 if (current_buffer
!= given_buffer
)
5007 XSETFASTINT (start
, BEGV
);
5008 XSETFASTINT (end
, ZV
);
5012 #ifdef CLASH_DETECTION
5015 #if 0 /* This causes trouble for GNUS. */
5016 /* If we've locked this file for some other buffer,
5017 query before proceeding. */
5018 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5019 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5022 lock_file (lockname
);
5024 #endif /* CLASH_DETECTION */
5026 encoded_filename
= ENCODE_FILE (filename
);
5028 fn
= SDATA (encoded_filename
);
5032 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5033 #else /* not DOS_NT */
5034 desc
= emacs_open (fn
, O_WRONLY
, 0);
5035 #endif /* not DOS_NT */
5037 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5039 if (auto_saving
) /* Overwrite any previous version of autosave file */
5041 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5042 desc
= emacs_open (fn
, O_RDWR
, 0);
5044 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5045 ? SDATA (current_buffer
->filename
) : 0,
5048 else /* Write to temporary name and rename if no errors */
5050 Lisp_Object temp_name
;
5051 temp_name
= Ffile_name_directory (filename
);
5053 if (!NILP (temp_name
))
5055 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5056 build_string ("$$SAVE$$")));
5057 fname
= SDATA (filename
);
5058 fn
= SDATA (temp_name
);
5059 desc
= creat_copy_attrs (fname
, fn
);
5062 /* If we can't open the temporary file, try creating a new
5063 version of the original file. VMS "creat" creates a
5064 new version rather than truncating an existing file. */
5067 desc
= creat (fn
, 0666);
5068 #if 0 /* This can clobber an existing file and fail to replace it,
5069 if the user runs out of space. */
5072 /* We can't make a new version;
5073 try to truncate and rewrite existing version if any. */
5075 desc
= emacs_open (fn
, O_RDWR
, 0);
5081 desc
= creat (fn
, 0666);
5085 desc
= emacs_open (fn
,
5086 O_WRONLY
| O_CREAT
| buffer_file_type
5087 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5088 S_IREAD
| S_IWRITE
);
5089 #else /* not DOS_NT */
5090 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5091 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5092 auto_saving
? auto_save_mode_bits
: 0666);
5093 #endif /* not DOS_NT */
5094 #endif /* not VMS */
5098 #ifdef CLASH_DETECTION
5100 if (!auto_saving
) unlock_file (lockname
);
5102 #endif /* CLASH_DETECTION */
5104 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5107 record_unwind_protect (close_file_unwind
, make_number (desc
));
5109 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5113 if (NUMBERP (append
))
5114 ret
= lseek (desc
, XINT (append
), 1);
5116 ret
= lseek (desc
, 0, 2);
5119 #ifdef CLASH_DETECTION
5120 if (!auto_saving
) unlock_file (lockname
);
5121 #endif /* CLASH_DETECTION */
5123 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5131 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5132 * if we do writes that don't end with a carriage return. Furthermore
5133 * it cannot handle writes of more then 16K. The modified
5134 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5135 * this EXCEPT for the last record (iff it doesn't end with a carriage
5136 * return). This implies that if your buffer doesn't end with a carriage
5137 * return, you get one free... tough. However it also means that if
5138 * we make two calls to sys_write (a la the following code) you can
5139 * get one at the gap as well. The easiest way to fix this (honest)
5140 * is to move the gap to the next newline (or the end of the buffer).
5145 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5146 move_gap (find_next_newline (GPT
, 1));
5148 /* Whether VMS or not, we must move the gap to the next of newline
5149 when we must put designation sequences at beginning of line. */
5150 if (INTEGERP (start
)
5151 && coding
.type
== coding_type_iso2022
5152 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5153 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5155 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5156 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5157 move_gap_both (PT
, PT_BYTE
);
5158 SET_PT_BOTH (opoint
, opoint_byte
);
5165 if (STRINGP (start
))
5167 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5168 &annotations
, &coding
);
5171 else if (XINT (start
) != XINT (end
))
5173 tem
= CHAR_TO_BYTE (XINT (start
));
5175 if (XINT (start
) < GPT
)
5177 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5178 min (GPT
, XINT (end
)) - XINT (start
),
5179 &annotations
, &coding
);
5183 if (XINT (end
) > GPT
&& !failure
)
5185 tem
= max (XINT (start
), GPT
);
5186 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5187 &annotations
, &coding
);
5193 /* If file was empty, still need to write the annotations */
5194 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5195 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5199 if (CODING_REQUIRE_FLUSHING (&coding
)
5200 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5203 /* We have to flush out a data. */
5204 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5205 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5212 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5213 Disk full in NFS may be reported here. */
5214 /* mib says that closing the file will try to write as fast as NFS can do
5215 it, and that means the fsync here is not crucial for autosave files. */
5216 if (!auto_saving
&& fsync (desc
) < 0)
5218 /* If fsync fails with EINTR, don't treat that as serious. */
5220 failure
= 1, save_errno
= errno
;
5224 /* Spurious "file has changed on disk" warnings have been
5225 observed on Suns as well.
5226 It seems that `close' can change the modtime, under nfs.
5228 (This has supposedly been fixed in Sunos 4,
5229 but who knows about all the other machines with NFS?) */
5232 /* On VMS and APOLLO, must do the stat after the close
5233 since closing changes the modtime. */
5236 /* Recall that #if defined does not work on VMS. */
5243 /* NFS can report a write failure now. */
5244 if (emacs_close (desc
) < 0)
5245 failure
= 1, save_errno
= errno
;
5248 /* If we wrote to a temporary name and had no errors, rename to real name. */
5252 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5260 /* Discard the unwind protect for close_file_unwind. */
5261 specpdl_ptr
= specpdl
+ count1
;
5262 /* Restore the original current buffer. */
5263 visit_file
= unbind_to (count
, visit_file
);
5265 #ifdef CLASH_DETECTION
5267 unlock_file (lockname
);
5268 #endif /* CLASH_DETECTION */
5270 /* Do this before reporting IO error
5271 to avoid a "file has changed on disk" warning on
5272 next attempt to save. */
5274 current_buffer
->modtime
= st
.st_mtime
;
5277 error ("IO error writing %s: %s", SDATA (filename
),
5278 emacs_strerror (save_errno
));
5282 SAVE_MODIFF
= MODIFF
;
5283 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5284 current_buffer
->filename
= visit_file
;
5285 update_mode_lines
++;
5290 && ! NILP (Fstring_equal (current_buffer
->filename
,
5291 current_buffer
->auto_save_file_name
)))
5292 SAVE_MODIFF
= MODIFF
;
5298 message_with_string ((INTEGERP (append
)
5308 Lisp_Object
merge ();
5310 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5311 doc
: /* Return t if (car A) is numerically less than (car B). */)
5315 return Flss (Fcar (a
), Fcar (b
));
5318 /* Build the complete list of annotations appropriate for writing out
5319 the text between START and END, by calling all the functions in
5320 write-region-annotate-functions and merging the lists they return.
5321 If one of these functions switches to a different buffer, we assume
5322 that buffer contains altered text. Therefore, the caller must
5323 make sure to restore the current buffer in all cases,
5324 as save-excursion would do. */
5327 build_annotations (start
, end
)
5328 Lisp_Object start
, end
;
5330 Lisp_Object annotations
;
5332 struct gcpro gcpro1
, gcpro2
;
5333 Lisp_Object original_buffer
;
5334 int i
, used_global
= 0;
5336 XSETBUFFER (original_buffer
, current_buffer
);
5339 p
= Vwrite_region_annotate_functions
;
5340 GCPRO2 (annotations
, p
);
5343 struct buffer
*given_buffer
= current_buffer
;
5344 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5345 { /* Use the global value of the hook. */
5348 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5350 p
= Fappend (2, arg
);
5353 Vwrite_region_annotations_so_far
= annotations
;
5354 res
= call2 (XCAR (p
), start
, end
);
5355 /* If the function makes a different buffer current,
5356 assume that means this buffer contains altered text to be output.
5357 Reset START and END from the buffer bounds
5358 and discard all previous annotations because they should have
5359 been dealt with by this function. */
5360 if (current_buffer
!= given_buffer
)
5362 XSETFASTINT (start
, BEGV
);
5363 XSETFASTINT (end
, ZV
);
5366 Flength (res
); /* Check basic validity of return value */
5367 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5371 /* Now do the same for annotation functions implied by the file-format */
5372 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
5373 p
= current_buffer
->auto_save_file_format
;
5375 p
= current_buffer
->file_format
;
5376 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5378 struct buffer
*given_buffer
= current_buffer
;
5380 Vwrite_region_annotations_so_far
= annotations
;
5382 /* Value is either a list of annotations or nil if the function
5383 has written annotations to a temporary buffer, which is now
5385 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5386 original_buffer
, make_number (i
));
5387 if (current_buffer
!= given_buffer
)
5389 XSETFASTINT (start
, BEGV
);
5390 XSETFASTINT (end
, ZV
);
5395 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5403 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5404 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5406 struct gcpro gcpro1
;
5409 GCPRO1 (annotations
);
5410 /* At last, do the same for the function PRE_WRITE_CONVERSION
5411 implied by the current coding-system. */
5412 if (!NILP (pre_write_conversion
))
5414 struct buffer
*given_buffer
= current_buffer
;
5415 Vwrite_region_annotations_so_far
= annotations
;
5416 res
= call2 (pre_write_conversion
, start
, end
);
5418 annotations
= (current_buffer
!= given_buffer
5420 : merge (annotations
, res
, Qcar_less_than_car
));
5427 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5428 If STRING is nil, POS is the character position in the current buffer.
5429 Intersperse with them the annotations from *ANNOT
5430 which fall within the range of POS to POS + NCHARS,
5431 each at its appropriate position.
5433 We modify *ANNOT by discarding elements as we use them up.
5435 The return value is negative in case of system call failure. */
5438 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5441 register int nchars
;
5444 struct coding_system
*coding
;
5448 int lastpos
= pos
+ nchars
;
5450 while (NILP (*annot
) || CONSP (*annot
))
5452 tem
= Fcar_safe (Fcar (*annot
));
5455 nextpos
= XFASTINT (tem
);
5457 /* If there are no more annotations in this range,
5458 output the rest of the range all at once. */
5459 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5460 return e_write (desc
, string
, pos
, lastpos
, coding
);
5462 /* Output buffer text up to the next annotation's position. */
5465 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5469 /* Output the annotation. */
5470 tem
= Fcdr (Fcar (*annot
));
5473 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5476 *annot
= Fcdr (*annot
);
5481 #ifndef WRITE_BUF_SIZE
5482 #define WRITE_BUF_SIZE (16 * 1024)
5485 /* Write text in the range START and END into descriptor DESC,
5486 encoding them with coding system CODING. If STRING is nil, START
5487 and END are character positions of the current buffer, else they
5488 are indexes to the string STRING. */
5491 e_write (desc
, string
, start
, end
, coding
)
5495 struct coding_system
*coding
;
5497 register char *addr
;
5498 register int nbytes
;
5499 char buf
[WRITE_BUF_SIZE
];
5503 coding
->composing
= COMPOSITION_DISABLED
;
5504 if (coding
->composing
!= COMPOSITION_DISABLED
)
5505 coding_save_composition (coding
, start
, end
, string
);
5507 if (STRINGP (string
))
5509 addr
= SDATA (string
);
5510 nbytes
= SBYTES (string
);
5511 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5513 else if (start
< end
)
5515 /* It is assured that the gap is not in the range START and END-1. */
5516 addr
= CHAR_POS_ADDR (start
);
5517 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5518 coding
->src_multibyte
5519 = !NILP (current_buffer
->enable_multibyte_characters
);
5525 coding
->src_multibyte
= 1;
5528 /* We used to have a code for handling selective display here. But,
5529 now it is handled within encode_coding. */
5534 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5535 if (coding
->produced
> 0)
5537 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5538 if (coding
->produced
)
5544 nbytes
-= coding
->consumed
;
5545 addr
+= coding
->consumed
;
5546 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5549 /* The source text ends by an incomplete multibyte form.
5550 There's no way other than write it out as is. */
5551 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5560 start
+= coding
->consumed_char
;
5561 if (coding
->cmp_data
)
5562 coding_adjust_composition_offset (coding
, start
);
5565 if (coding
->cmp_data
)
5566 coding_free_composition_data (coding
);
5571 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5572 Sverify_visited_file_modtime
, 1, 1, 0,
5573 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5574 This means that the file has not been changed since it was visited or saved.
5575 See Info node `(elisp)Modification Time' for more details. */)
5581 Lisp_Object handler
;
5582 Lisp_Object filename
;
5587 if (!STRINGP (b
->filename
)) return Qt
;
5588 if (b
->modtime
== 0) return Qt
;
5590 /* If the file name has special constructs in it,
5591 call the corresponding file handler. */
5592 handler
= Ffind_file_name_handler (b
->filename
,
5593 Qverify_visited_file_modtime
);
5594 if (!NILP (handler
))
5595 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5597 filename
= ENCODE_FILE (b
->filename
);
5599 if (stat (SDATA (filename
), &st
) < 0)
5601 /* If the file doesn't exist now and didn't exist before,
5602 we say that it isn't modified, provided the error is a tame one. */
5603 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5608 if (st
.st_mtime
== b
->modtime
5609 /* If both are positive, accept them if they are off by one second. */
5610 || (st
.st_mtime
> 0 && b
->modtime
> 0
5611 && (st
.st_mtime
== b
->modtime
+ 1
5612 || st
.st_mtime
== b
->modtime
- 1)))
5617 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5618 Sclear_visited_file_modtime
, 0, 0, 0,
5619 doc
: /* Clear out records of last mod time of visited file.
5620 Next attempt to save will certainly not complain of a discrepancy. */)
5623 current_buffer
->modtime
= 0;
5627 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5628 Svisited_file_modtime
, 0, 0, 0,
5629 doc
: /* Return the current buffer's recorded visited file modification time.
5630 The value is a list of the form (HIGH LOW), like the time values
5631 that `file-attributes' returns. If the current buffer has no recorded
5632 file modification time, this function returns 0.
5633 See Info node `(elisp)Modification Time' for more details. */)
5637 tcons
= long_to_cons ((unsigned long) current_buffer
->modtime
);
5639 return list2 (XCAR (tcons
), XCDR (tcons
));
5643 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5644 Sset_visited_file_modtime
, 0, 1, 0,
5645 doc
: /* Update buffer's recorded modification time from the visited file's time.
5646 Useful if the buffer was not read from the file normally
5647 or if the file itself has been changed for some known benign reason.
5648 An argument specifies the modification time value to use
5649 \(instead of that of the visited file), in the form of a list
5650 \(HIGH . LOW) or (HIGH LOW). */)
5652 Lisp_Object time_list
;
5654 if (!NILP (time_list
))
5655 current_buffer
->modtime
= cons_to_long (time_list
);
5658 register Lisp_Object filename
;
5660 Lisp_Object handler
;
5662 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5664 /* If the file name has special constructs in it,
5665 call the corresponding file handler. */
5666 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5667 if (!NILP (handler
))
5668 /* The handler can find the file name the same way we did. */
5669 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5671 filename
= ENCODE_FILE (filename
);
5673 if (stat (SDATA (filename
), &st
) >= 0)
5674 current_buffer
->modtime
= st
.st_mtime
;
5681 auto_save_error (error
)
5684 Lisp_Object args
[3], msg
;
5686 struct gcpro gcpro1
;
5690 args
[0] = build_string ("Auto-saving %s: %s");
5691 args
[1] = current_buffer
->name
;
5692 args
[2] = Ferror_message_string (error
);
5693 msg
= Fformat (3, args
);
5695 nbytes
= SBYTES (msg
);
5697 for (i
= 0; i
< 3; ++i
)
5700 message2 (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5702 message2_nolog (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5703 Fsleep_for (make_number (1), Qnil
);
5716 auto_save_mode_bits
= 0666;
5718 /* Get visited file's mode to become the auto save file's mode. */
5719 if (! NILP (current_buffer
->filename
))
5721 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5722 /* But make sure we can overwrite it later! */
5723 auto_save_mode_bits
= st
.st_mode
| 0600;
5724 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5726 /* Remote files don't cooperate with stat. */
5727 auto_save_mode_bits
= XINT (modes
) | 0600;
5731 Fwrite_region (Qnil
, Qnil
,
5732 current_buffer
->auto_save_file_name
,
5733 Qnil
, Qlambda
, Qnil
, Qnil
);
5737 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5742 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5743 | XFASTINT (XCDR (stream
))));
5748 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5751 minibuffer_auto_raise
= XINT (value
);
5756 do_auto_save_make_dir (dir
)
5759 return call2 (Qmake_directory
, dir
, Qt
);
5763 do_auto_save_eh (ignore
)
5769 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5770 doc
: /* Auto-save all buffers that need it.
5771 This is all buffers that have auto-saving enabled
5772 and are changed since last auto-saved.
5773 Auto-saving writes the buffer into a file
5774 so that your editing is not lost if the system crashes.
5775 This file is not the file you visited; that changes only when you save.
5776 Normally we run the normal hook `auto-save-hook' before saving.
5778 A non-nil NO-MESSAGE argument means do not print any message if successful.
5779 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5780 (no_message
, current_only
)
5781 Lisp_Object no_message
, current_only
;
5783 struct buffer
*old
= current_buffer
, *b
;
5784 Lisp_Object tail
, buf
;
5786 int do_handled_files
;
5789 Lisp_Object lispstream
;
5790 int count
= SPECPDL_INDEX ();
5791 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5792 int old_message_p
= 0;
5793 struct gcpro gcpro1
, gcpro2
;
5795 if (max_specpdl_size
< specpdl_size
+ 40)
5796 max_specpdl_size
= specpdl_size
+ 40;
5801 if (NILP (no_message
))
5803 old_message_p
= push_message ();
5804 record_unwind_protect (pop_message_unwind
, Qnil
);
5807 /* Ordinarily don't quit within this function,
5808 but don't make it impossible to quit (in case we get hung in I/O). */
5812 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5813 point to non-strings reached from Vbuffer_alist. */
5815 if (!NILP (Vrun_hooks
))
5816 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5818 if (STRINGP (Vauto_save_list_file_name
))
5820 Lisp_Object listfile
;
5822 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5824 /* Don't try to create the directory when shutting down Emacs,
5825 because creating the directory might signal an error, and
5826 that would leave Emacs in a strange state. */
5827 if (!NILP (Vrun_hooks
))
5831 GCPRO2 (dir
, listfile
);
5832 dir
= Ffile_name_directory (listfile
);
5833 if (NILP (Ffile_directory_p (dir
)))
5834 internal_condition_case_1 (do_auto_save_make_dir
,
5835 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5840 stream
= fopen (SDATA (listfile
), "w");
5843 /* Arrange to close that file whether or not we get an error.
5844 Also reset auto_saving to 0. */
5845 lispstream
= Fcons (Qnil
, Qnil
);
5846 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
5847 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
5858 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5859 record_unwind_protect (do_auto_save_unwind_1
,
5860 make_number (minibuffer_auto_raise
));
5861 minibuffer_auto_raise
= 0;
5864 /* On first pass, save all files that don't have handlers.
5865 On second pass, save all files that do have handlers.
5867 If Emacs is crashing, the handlers may tweak what is causing
5868 Emacs to crash in the first place, and it would be a shame if
5869 Emacs failed to autosave perfectly ordinary files because it
5870 couldn't handle some ange-ftp'd file. */
5872 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5873 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5875 buf
= XCDR (XCAR (tail
));
5878 /* Record all the buffers that have auto save mode
5879 in the special file that lists them. For each of these buffers,
5880 Record visited name (if any) and auto save name. */
5881 if (STRINGP (b
->auto_save_file_name
)
5882 && stream
!= NULL
&& do_handled_files
== 0)
5884 if (!NILP (b
->filename
))
5886 fwrite (SDATA (b
->filename
), 1,
5887 SBYTES (b
->filename
), stream
);
5889 putc ('\n', stream
);
5890 fwrite (SDATA (b
->auto_save_file_name
), 1,
5891 SBYTES (b
->auto_save_file_name
), stream
);
5892 putc ('\n', stream
);
5895 if (!NILP (current_only
)
5896 && b
!= current_buffer
)
5899 /* Don't auto-save indirect buffers.
5900 The base buffer takes care of it. */
5904 /* Check for auto save enabled
5905 and file changed since last auto save
5906 and file changed since last real save. */
5907 if (STRINGP (b
->auto_save_file_name
)
5908 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5909 && b
->auto_save_modified
< BUF_MODIFF (b
)
5910 /* -1 means we've turned off autosaving for a while--see below. */
5911 && XINT (b
->save_length
) >= 0
5912 && (do_handled_files
5913 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5916 EMACS_TIME before_time
, after_time
;
5918 EMACS_GET_TIME (before_time
);
5920 /* If we had a failure, don't try again for 20 minutes. */
5921 if (b
->auto_save_failure_time
>= 0
5922 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5925 if ((XFASTINT (b
->save_length
) * 10
5926 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5927 /* A short file is likely to change a large fraction;
5928 spare the user annoying messages. */
5929 && XFASTINT (b
->save_length
) > 5000
5930 /* These messages are frequent and annoying for `*mail*'. */
5931 && !EQ (b
->filename
, Qnil
)
5932 && NILP (no_message
))
5934 /* It has shrunk too much; turn off auto-saving here. */
5935 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5936 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5938 minibuffer_auto_raise
= 0;
5939 /* Turn off auto-saving until there's a real save,
5940 and prevent any more warnings. */
5941 XSETINT (b
->save_length
, -1);
5942 Fsleep_for (make_number (1), Qnil
);
5945 set_buffer_internal (b
);
5946 if (!auto_saved
&& NILP (no_message
))
5947 message1 ("Auto-saving...");
5948 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5950 b
->auto_save_modified
= BUF_MODIFF (b
);
5951 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5952 set_buffer_internal (old
);
5954 EMACS_GET_TIME (after_time
);
5956 /* If auto-save took more than 60 seconds,
5957 assume it was an NFS failure that got a timeout. */
5958 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5959 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5963 /* Prevent another auto save till enough input events come in. */
5964 record_auto_save ();
5966 if (auto_saved
&& NILP (no_message
))
5970 /* If we are going to restore an old message,
5971 give time to read ours. */
5972 sit_for (1, 0, 0, 0, 0);
5976 /* If we displayed a message and then restored a state
5977 with no message, leave a "done" message on the screen. */
5978 message1 ("Auto-saving...done");
5983 /* This restores the message-stack status. */
5984 unbind_to (count
, Qnil
);
5988 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5989 Sset_buffer_auto_saved
, 0, 0, 0,
5990 doc
: /* Mark current buffer as auto-saved with its current text.
5991 No auto-save file will be written until the buffer changes again. */)
5994 current_buffer
->auto_save_modified
= MODIFF
;
5995 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5996 current_buffer
->auto_save_failure_time
= -1;
6000 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
6001 Sclear_buffer_auto_save_failure
, 0, 0, 0,
6002 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
6005 current_buffer
->auto_save_failure_time
= -1;
6009 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6011 doc
: /* Return t if buffer has been auto-saved since last read in or saved. */)
6014 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6017 /* Reading and completing file names */
6018 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
6020 /* In the string VAL, change each $ to $$ and return the result. */
6023 double_dollars (val
)
6026 register const unsigned char *old
;
6027 register unsigned char *new;
6031 osize
= SBYTES (val
);
6033 /* Count the number of $ characters. */
6034 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
6035 if (*old
++ == '$') count
++;
6039 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
6042 for (n
= osize
; n
> 0; n
--)
6056 read_file_name_cleanup (arg
)
6059 return (current_buffer
->directory
= arg
);
6062 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
6064 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
6065 (string
, dir
, action
)
6066 Lisp_Object string
, dir
, action
;
6067 /* action is nil for complete, t for return list of completions,
6068 lambda for verify final value */
6070 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
6072 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
6074 CHECK_STRING (string
);
6081 /* No need to protect ACTION--we only compare it with t and nil. */
6082 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6084 if (SCHARS (string
) == 0)
6086 if (EQ (action
, Qlambda
))
6094 orig_string
= string
;
6095 string
= Fsubstitute_in_file_name (string
);
6096 changed
= NILP (Fstring_equal (string
, orig_string
));
6097 name
= Ffile_name_nondirectory (string
);
6098 val
= Ffile_name_directory (string
);
6100 realdir
= Fexpand_file_name (val
, realdir
);
6105 specdir
= Ffile_name_directory (string
);
6106 val
= Ffile_name_completion (name
, realdir
);
6111 return double_dollars (string
);
6115 if (!NILP (specdir
))
6116 val
= concat2 (specdir
, val
);
6118 return double_dollars (val
);
6121 #endif /* not VMS */
6125 if (EQ (action
, Qt
))
6127 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6131 if (NILP (Vread_file_name_predicate
)
6132 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6136 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6138 /* Brute-force speed up for directory checking:
6139 Discard strings which don't end in a slash. */
6140 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6142 Lisp_Object tem
= XCAR (all
);
6144 if (STRINGP (tem
) &&
6145 (len
= SCHARS (tem
), len
> 0) &&
6146 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6147 comp
= Fcons (tem
, comp
);
6153 /* Must do it the hard (and slow) way. */
6154 GCPRO3 (all
, comp
, specdir
);
6155 count
= SPECPDL_INDEX ();
6156 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6157 current_buffer
->directory
= realdir
;
6158 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6159 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
6160 comp
= Fcons (XCAR (all
), comp
);
6161 unbind_to (count
, Qnil
);
6164 return Fnreverse (comp
);
6167 /* Only other case actually used is ACTION = lambda */
6169 /* Supposedly this helps commands such as `cd' that read directory names,
6170 but can someone explain how it helps them? -- RMS */
6171 if (SCHARS (name
) == 0)
6174 string
= Fexpand_file_name (string
, dir
);
6175 if (!NILP (Vread_file_name_predicate
))
6176 return call1 (Vread_file_name_predicate
, string
);
6177 return Ffile_exists_p (string
);
6180 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
6181 Snext_read_file_uses_dialog_p
, 0, 0, 0,
6182 doc
: /* Return t if a call to `read-file-name' will use a dialog.
6183 The return value is only relevant for a call to `read-file-name' that happens
6184 before any other event (mouse or keypress) is handeled. */)
6187 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6188 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6197 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6198 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6199 Value is not expanded---you must call `expand-file-name' yourself.
6200 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6201 the same non-empty string that was inserted by this function.
6202 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6203 except that if INITIAL is specified, that combined with DIR is used.)
6204 If the user exits with an empty minibuffer, this function returns
6205 an empty string. (This can only happen if the user erased the
6206 pre-inserted contents or if `insert-default-directory' is nil.)
6207 Fourth arg MUSTMATCH non-nil means require existing file's name.
6208 Non-nil and non-t means also require confirmation after completion.
6209 Fifth arg INITIAL specifies text to start with.
6210 If optional sixth arg PREDICATE is non-nil, possible completions and
6211 the resulting file name must satisfy (funcall PREDICATE NAME).
6212 DIR should be an absolute directory name. It defaults to the value of
6213 `default-directory'.
6215 If this command was invoked with the mouse, use a file dialog box if
6216 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6217 provides a file dialog box.
6219 See also `read-file-name-completion-ignore-case'
6220 and `read-file-name-function'. */)
6221 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6222 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6224 Lisp_Object val
, insdef
, tem
;
6225 struct gcpro gcpro1
, gcpro2
;
6226 register char *homedir
;
6227 Lisp_Object decoded_homedir
;
6228 int replace_in_history
= 0;
6229 int add_to_history
= 0;
6233 dir
= current_buffer
->directory
;
6234 if (NILP (Ffile_name_absolute_p (dir
)))
6235 dir
= Fexpand_file_name (dir
, Qnil
);
6236 if (NILP (default_filename
))
6239 ? Fexpand_file_name (initial
, dir
)
6240 : current_buffer
->filename
);
6242 /* If dir starts with user's homedir, change that to ~. */
6243 homedir
= (char *) egetenv ("HOME");
6245 /* homedir can be NULL in temacs, since Vprocess_environment is not
6246 yet set up. We shouldn't crash in that case. */
6249 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6250 CORRECT_DIR_SEPS (homedir
);
6255 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6258 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6259 SBYTES (decoded_homedir
))
6260 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6262 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6263 dir
= concat2 (build_string ("~"), dir
);
6265 /* Likewise for default_filename. */
6267 && STRINGP (default_filename
)
6268 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6269 SBYTES (decoded_homedir
))
6270 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6273 = Fsubstring (default_filename
,
6274 make_number (SCHARS (decoded_homedir
)), Qnil
);
6275 default_filename
= concat2 (build_string ("~"), default_filename
);
6277 if (!NILP (default_filename
))
6279 CHECK_STRING (default_filename
);
6280 default_filename
= double_dollars (default_filename
);
6283 if (insert_default_directory
&& STRINGP (dir
))
6286 if (!NILP (initial
))
6288 Lisp_Object args
[2], pos
;
6292 insdef
= Fconcat (2, args
);
6293 pos
= make_number (SCHARS (double_dollars (dir
)));
6294 insdef
= Fcons (double_dollars (insdef
), pos
);
6297 insdef
= double_dollars (insdef
);
6299 else if (STRINGP (initial
))
6300 insdef
= Fcons (double_dollars (initial
), make_number (0));
6304 if (!NILP (Vread_file_name_function
))
6306 Lisp_Object args
[7];
6308 GCPRO2 (insdef
, default_filename
);
6309 args
[0] = Vread_file_name_function
;
6312 args
[3] = default_filename
;
6313 args
[4] = mustmatch
;
6315 args
[6] = predicate
;
6316 RETURN_UNGCPRO (Ffuncall (7, args
));
6319 count
= SPECPDL_INDEX ();
6320 specbind (intern ("completion-ignore-case"),
6321 read_file_name_completion_ignore_case
? Qt
: Qnil
);
6322 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6323 specbind (intern ("read-file-name-predicate"),
6324 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6326 GCPRO2 (insdef
, default_filename
);
6328 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6329 if (! NILP (Fnext_read_file_uses_dialog_p ()))
6331 /* If DIR contains a file name, split it. */
6333 file
= Ffile_name_nondirectory (dir
);
6334 if (SCHARS (file
) && NILP (default_filename
))
6336 default_filename
= file
;
6337 dir
= Ffile_name_directory (dir
);
6339 if (!NILP(default_filename
))
6340 default_filename
= Fexpand_file_name (default_filename
, dir
);
6341 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
,
6342 EQ (predicate
, Qfile_directory_p
) ? Qt
: Qnil
);
6347 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6348 dir
, mustmatch
, insdef
,
6349 Qfile_name_history
, default_filename
, Qnil
);
6351 tem
= Fsymbol_value (Qfile_name_history
);
6352 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6353 replace_in_history
= 1;
6355 /* If Fcompleting_read returned the inserted default string itself
6356 (rather than a new string with the same contents),
6357 it has to mean that the user typed RET with the minibuffer empty.
6358 In that case, we really want to return ""
6359 so that commands such as set-visited-file-name can distinguish. */
6360 if (EQ (val
, default_filename
))
6362 /* In this case, Fcompleting_read has not added an element
6363 to the history. Maybe we should. */
6364 if (! replace_in_history
)
6370 unbind_to (count
, Qnil
);
6373 error ("No file name specified");
6375 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6377 if (!NILP (tem
) && !NILP (default_filename
))
6378 val
= default_filename
;
6379 val
= Fsubstitute_in_file_name (val
);
6381 if (replace_in_history
)
6382 /* Replace what Fcompleting_read added to the history
6383 with what we will actually return. */
6385 Lisp_Object val1
= double_dollars (val
);
6386 tem
= Fsymbol_value (Qfile_name_history
);
6387 if (history_delete_duplicates
)
6388 XSETCDR (tem
, Fdelete (val1
, XCDR(tem
)));
6389 XSETCAR (tem
, val1
);
6391 else if (add_to_history
)
6393 /* Add the value to the history--but not if it matches
6394 the last value already there. */
6395 Lisp_Object val1
= double_dollars (val
);
6396 tem
= Fsymbol_value (Qfile_name_history
);
6397 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6399 if (history_delete_duplicates
) tem
= Fdelete (val1
, tem
);
6400 Fset (Qfile_name_history
, Fcons (val1
, tem
));
6411 /* Must be set before any path manipulation is performed. */
6412 XSETFASTINT (Vdirectory_sep_char
, '/');
6419 Qexpand_file_name
= intern ("expand-file-name");
6420 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6421 Qdirectory_file_name
= intern ("directory-file-name");
6422 Qfile_name_directory
= intern ("file-name-directory");
6423 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6424 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6425 Qfile_name_as_directory
= intern ("file-name-as-directory");
6426 Qcopy_file
= intern ("copy-file");
6427 Qmake_directory_internal
= intern ("make-directory-internal");
6428 Qmake_directory
= intern ("make-directory");
6429 Qdelete_directory
= intern ("delete-directory");
6430 Qdelete_file
= intern ("delete-file");
6431 Qrename_file
= intern ("rename-file");
6432 Qadd_name_to_file
= intern ("add-name-to-file");
6433 Qmake_symbolic_link
= intern ("make-symbolic-link");
6434 Qfile_exists_p
= intern ("file-exists-p");
6435 Qfile_executable_p
= intern ("file-executable-p");
6436 Qfile_readable_p
= intern ("file-readable-p");
6437 Qfile_writable_p
= intern ("file-writable-p");
6438 Qfile_symlink_p
= intern ("file-symlink-p");
6439 Qaccess_file
= intern ("access-file");
6440 Qfile_directory_p
= intern ("file-directory-p");
6441 Qfile_regular_p
= intern ("file-regular-p");
6442 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6443 Qfile_modes
= intern ("file-modes");
6444 Qset_file_modes
= intern ("set-file-modes");
6445 Qset_file_times
= intern ("set-file-times");
6446 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6447 Qinsert_file_contents
= intern ("insert-file-contents");
6448 Qwrite_region
= intern ("write-region");
6449 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6450 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6451 Qauto_save_coding
= intern ("auto-save-coding");
6453 staticpro (&Qexpand_file_name
);
6454 staticpro (&Qsubstitute_in_file_name
);
6455 staticpro (&Qdirectory_file_name
);
6456 staticpro (&Qfile_name_directory
);
6457 staticpro (&Qfile_name_nondirectory
);
6458 staticpro (&Qunhandled_file_name_directory
);
6459 staticpro (&Qfile_name_as_directory
);
6460 staticpro (&Qcopy_file
);
6461 staticpro (&Qmake_directory_internal
);
6462 staticpro (&Qmake_directory
);
6463 staticpro (&Qdelete_directory
);
6464 staticpro (&Qdelete_file
);
6465 staticpro (&Qrename_file
);
6466 staticpro (&Qadd_name_to_file
);
6467 staticpro (&Qmake_symbolic_link
);
6468 staticpro (&Qfile_exists_p
);
6469 staticpro (&Qfile_executable_p
);
6470 staticpro (&Qfile_readable_p
);
6471 staticpro (&Qfile_writable_p
);
6472 staticpro (&Qaccess_file
);
6473 staticpro (&Qfile_symlink_p
);
6474 staticpro (&Qfile_directory_p
);
6475 staticpro (&Qfile_regular_p
);
6476 staticpro (&Qfile_accessible_directory_p
);
6477 staticpro (&Qfile_modes
);
6478 staticpro (&Qset_file_modes
);
6479 staticpro (&Qset_file_times
);
6480 staticpro (&Qfile_newer_than_file_p
);
6481 staticpro (&Qinsert_file_contents
);
6482 staticpro (&Qwrite_region
);
6483 staticpro (&Qverify_visited_file_modtime
);
6484 staticpro (&Qset_visited_file_modtime
);
6485 staticpro (&Qauto_save_coding
);
6487 Qfile_name_history
= intern ("file-name-history");
6488 Fset (Qfile_name_history
, Qnil
);
6489 staticpro (&Qfile_name_history
);
6491 Qfile_error
= intern ("file-error");
6492 staticpro (&Qfile_error
);
6493 Qfile_already_exists
= intern ("file-already-exists");
6494 staticpro (&Qfile_already_exists
);
6495 Qfile_date_error
= intern ("file-date-error");
6496 staticpro (&Qfile_date_error
);
6497 Qexcl
= intern ("excl");
6501 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6502 staticpro (&Qfind_buffer_file_type
);
6505 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6506 doc
: /* *Coding system for encoding file names.
6507 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6508 Vfile_name_coding_system
= Qnil
;
6510 DEFVAR_LISP ("default-file-name-coding-system",
6511 &Vdefault_file_name_coding_system
,
6512 doc
: /* Default coding system for encoding file names.
6513 This variable is used only when `file-name-coding-system' is nil.
6515 This variable is set/changed by the command `set-language-environment'.
6516 User should not set this variable manually,
6517 instead use `file-name-coding-system' to get a constant encoding
6518 of file names regardless of the current language environment. */);
6519 Vdefault_file_name_coding_system
= Qnil
;
6521 Qformat_decode
= intern ("format-decode");
6522 staticpro (&Qformat_decode
);
6523 Qformat_annotate_function
= intern ("format-annotate-function");
6524 staticpro (&Qformat_annotate_function
);
6525 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6526 staticpro (&Qafter_insert_file_set_coding
);
6528 Qcar_less_than_car
= intern ("car-less-than-car");
6529 staticpro (&Qcar_less_than_car
);
6531 Fput (Qfile_error
, Qerror_conditions
,
6532 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6533 Fput (Qfile_error
, Qerror_message
,
6534 build_string ("File error"));
6536 Fput (Qfile_already_exists
, Qerror_conditions
,
6537 Fcons (Qfile_already_exists
,
6538 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6539 Fput (Qfile_already_exists
, Qerror_message
,
6540 build_string ("File already exists"));
6542 Fput (Qfile_date_error
, Qerror_conditions
,
6543 Fcons (Qfile_date_error
,
6544 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6545 Fput (Qfile_date_error
, Qerror_message
,
6546 build_string ("Cannot set file date"));
6548 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6549 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6550 Vread_file_name_function
= Qnil
;
6552 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6553 doc
: /* Current predicate used by `read-file-name-internal'. */);
6554 Vread_file_name_predicate
= Qnil
;
6556 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case
,
6557 doc
: /* *Non-nil means when reading a file name completion ignores case. */);
6558 #if defined VMS || defined DOS_NT || defined MAC_OS
6559 read_file_name_completion_ignore_case
= 1;
6561 read_file_name_completion_ignore_case
= 0;
6564 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6565 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6566 If the initial minibuffer contents are non-empty, you can usually
6567 request a default filename by typing RETURN without editing. For some
6568 commands, exiting with an empty minibuffer has a special meaning,
6569 such as making the current buffer visit no file in the case of
6570 `set-visited-file-name'.
6571 If this variable is non-nil, the minibuffer contents are always
6572 initially non-empty and typing RETURN without editing will fetch the
6573 default name, if one is provided. Note however that this default name
6574 is not necessarily the name originally inserted in the minibuffer, if
6575 that is just the default directory.
6576 If this variable is nil, the minibuffer often starts out empty. In
6577 that case you may have to explicitly fetch the next history element to
6578 request the default name. */);
6579 insert_default_directory
= 1;
6581 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6582 doc
: /* *Non-nil means write new files with record format `stmlf'.
6583 nil means use format `var'. This variable is meaningful only on VMS. */);
6584 vms_stmlf_recfm
= 0;
6586 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6587 doc
: /* Directory separator character for built-in functions that return file names.
6588 The value is always ?/. Don't use this variable, just use `/'. */);
6590 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6591 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6592 If a file name matches REGEXP, then all I/O on that file is done by calling
6595 The first argument given to HANDLER is the name of the I/O primitive
6596 to be handled; the remaining arguments are the arguments that were
6597 passed to that primitive. For example, if you do
6598 (file-exists-p FILENAME)
6599 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6600 (funcall HANDLER 'file-exists-p FILENAME)
6601 The function `find-file-name-handler' checks this list for a handler
6602 for its argument. */);
6603 Vfile_name_handler_alist
= Qnil
;
6605 DEFVAR_LISP ("set-auto-coding-function",
6606 &Vset_auto_coding_function
,
6607 doc
: /* If non-nil, a function to call to decide a coding system of file.
6608 Two arguments are passed to this function: the file name
6609 and the length of a file contents following the point.
6610 This function should return a coding system to decode the file contents.
6611 It should check the file name against `auto-coding-alist'.
6612 If no coding system is decided, it should check a coding system
6613 specified in the heading lines with the format:
6614 -*- ... coding: CODING-SYSTEM; ... -*-
6615 or local variable spec of the tailing lines with `coding:' tag. */);
6616 Vset_auto_coding_function
= Qnil
;
6618 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6619 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6620 Each is passed one argument, the number of characters inserted.
6621 It should return the new character count, and leave point the same.
6622 If `insert-file-contents' is intercepted by a handler from
6623 `file-name-handler-alist', that handler is responsible for calling the
6624 functions in `after-insert-file-functions' if appropriate. */);
6625 Vafter_insert_file_functions
= Qnil
;
6627 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6628 doc
: /* A list of functions to be called at the start of `write-region'.
6629 Each is passed two arguments, START and END as for `write-region'.
6630 These are usually two numbers but not always; see the documentation
6631 for `write-region'. The function should return a list of pairs
6632 of the form (POSITION . STRING), consisting of strings to be effectively
6633 inserted at the specified positions of the file being written (1 means to
6634 insert before the first byte written). The POSITIONs must be sorted into
6635 increasing order. If there are several functions in the list, the several
6636 lists are merged destructively. Alternatively, the function can return
6637 with a different buffer current; in that case it should pay attention
6638 to the annotations returned by previous functions and listed in
6639 `write-region-annotations-so-far'.*/);
6640 Vwrite_region_annotate_functions
= Qnil
;
6641 staticpro (&Qwrite_region_annotate_functions
);
6642 Qwrite_region_annotate_functions
6643 = intern ("write-region-annotate-functions");
6645 DEFVAR_LISP ("write-region-annotations-so-far",
6646 &Vwrite_region_annotations_so_far
,
6647 doc
: /* When an annotation function is called, this holds the previous annotations.
6648 These are the annotations made by other annotation functions
6649 that were already called. See also `write-region-annotate-functions'. */);
6650 Vwrite_region_annotations_so_far
= Qnil
;
6652 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6653 doc
: /* A list of file name handlers that temporarily should not be used.
6654 This applies only to the operation `inhibit-file-name-operation'. */);
6655 Vinhibit_file_name_handlers
= Qnil
;
6657 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6658 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6659 Vinhibit_file_name_operation
= Qnil
;
6661 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6662 doc
: /* File name in which we write a list of all auto save file names.
6663 This variable is initialized automatically from `auto-save-list-file-prefix'
6664 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6665 a non-nil value. */);
6666 Vauto_save_list_file_name
= Qnil
;
6668 defsubr (&Sfind_file_name_handler
);
6669 defsubr (&Sfile_name_directory
);
6670 defsubr (&Sfile_name_nondirectory
);
6671 defsubr (&Sunhandled_file_name_directory
);
6672 defsubr (&Sfile_name_as_directory
);
6673 defsubr (&Sdirectory_file_name
);
6674 defsubr (&Smake_temp_name
);
6675 defsubr (&Sexpand_file_name
);
6676 defsubr (&Ssubstitute_in_file_name
);
6677 defsubr (&Scopy_file
);
6678 defsubr (&Smake_directory_internal
);
6679 defsubr (&Sdelete_directory
);
6680 defsubr (&Sdelete_file
);
6681 defsubr (&Srename_file
);
6682 defsubr (&Sadd_name_to_file
);
6684 defsubr (&Smake_symbolic_link
);
6685 #endif /* S_IFLNK */
6687 defsubr (&Sdefine_logical_name
);
6690 defsubr (&Ssysnetunam
);
6691 #endif /* HPUX_NET */
6692 defsubr (&Sfile_name_absolute_p
);
6693 defsubr (&Sfile_exists_p
);
6694 defsubr (&Sfile_executable_p
);
6695 defsubr (&Sfile_readable_p
);
6696 defsubr (&Sfile_writable_p
);
6697 defsubr (&Saccess_file
);
6698 defsubr (&Sfile_symlink_p
);
6699 defsubr (&Sfile_directory_p
);
6700 defsubr (&Sfile_accessible_directory_p
);
6701 defsubr (&Sfile_regular_p
);
6702 defsubr (&Sfile_modes
);
6703 defsubr (&Sset_file_modes
);
6704 defsubr (&Sset_file_times
);
6705 defsubr (&Sset_default_file_modes
);
6706 defsubr (&Sdefault_file_modes
);
6707 defsubr (&Sfile_newer_than_file_p
);
6708 defsubr (&Sinsert_file_contents
);
6709 defsubr (&Swrite_region
);
6710 defsubr (&Scar_less_than_car
);
6711 defsubr (&Sverify_visited_file_modtime
);
6712 defsubr (&Sclear_visited_file_modtime
);
6713 defsubr (&Svisited_file_modtime
);
6714 defsubr (&Sset_visited_file_modtime
);
6715 defsubr (&Sdo_auto_save
);
6716 defsubr (&Sset_buffer_auto_saved
);
6717 defsubr (&Sclear_buffer_auto_save_failure
);
6718 defsubr (&Srecent_auto_save_p
);
6720 defsubr (&Sread_file_name_internal
);
6721 defsubr (&Sread_file_name
);
6722 defsubr (&Snext_read_file_uses_dialog_p
);
6725 defsubr (&Sunix_sync
);
6729 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6730 (do not change this comment) */