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
);
1125 name
= FILE_SYSTEM_CASE (name
);
1129 /* We will force directory separators to be either all \ or /, so make
1130 a local copy to modify, even if there ends up being no change. */
1131 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1133 /* Note if special escape prefix is present, but remove for now. */
1134 if (nm
[0] == '/' && nm
[1] == ':')
1140 /* Find and remove drive specifier if present; this makes nm absolute
1141 even if the rest of the name appears to be relative. Only look for
1142 drive specifier at the beginning. */
1143 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1150 /* If we see "c://somedir", we want to strip the first slash after the
1151 colon when stripping the drive letter. Otherwise, this expands to
1153 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1155 #endif /* WINDOWSNT */
1159 /* Discard any previous drive specifier if nm is now in UNC format. */
1160 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1166 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1167 none are found, we can probably return right away. We will avoid
1168 allocating a new string if name is already fully expanded. */
1170 IS_DIRECTORY_SEP (nm
[0])
1172 && drive
&& !is_escaped
1175 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1182 /* If it turns out that the filename we want to return is just a
1183 suffix of FILENAME, we don't need to go through and edit
1184 things; we just need to construct a new string using data
1185 starting at the middle of FILENAME. If we set lose to a
1186 non-zero value, that means we've discovered that we can't do
1193 /* Since we know the name is absolute, we can assume that each
1194 element starts with a "/". */
1196 /* "." and ".." are hairy. */
1197 if (IS_DIRECTORY_SEP (p
[0])
1199 && (IS_DIRECTORY_SEP (p
[2])
1201 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1204 /* We want to replace multiple `/' in a row with a single
1207 && IS_DIRECTORY_SEP (p
[0])
1208 && IS_DIRECTORY_SEP (p
[1]))
1215 /* if dev:[dir]/, move nm to / */
1216 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1217 nm
= (brack
? brack
+ 1 : colon
+ 1);
1218 lbrack
= rbrack
= 0;
1225 #ifdef NO_HYPHENS_IN_FILENAMES
1226 if (lbrack
== rbrack
)
1228 /* Avoid clobbering negative version numbers. */
1233 #endif /* NO_HYPHENS_IN_FILENAMES */
1234 if (lbrack
> rbrack
&&
1235 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1236 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1238 #ifdef NO_HYPHENS_IN_FILENAMES
1241 #endif /* NO_HYPHENS_IN_FILENAMES */
1242 /* count open brackets, reset close bracket pointer */
1243 if (p
[0] == '[' || p
[0] == '<')
1244 lbrack
++, brack
= 0;
1245 /* count close brackets, set close bracket pointer */
1246 if (p
[0] == ']' || p
[0] == '>')
1247 rbrack
++, brack
= p
;
1248 /* detect ][ or >< */
1249 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1251 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1252 nm
= p
+ 1, lose
= 1;
1253 if (p
[0] == ':' && (colon
|| slash
))
1254 /* if dev1:[dir]dev2:, move nm to dev2: */
1260 /* if /name/dev:, move nm to dev: */
1263 /* if node::dev:, move colon following dev */
1264 else if (colon
&& colon
[-1] == ':')
1266 /* if dev1:dev2:, move nm to dev2: */
1267 else if (colon
&& colon
[-1] != ':')
1272 if (p
[0] == ':' && !colon
)
1278 if (lbrack
== rbrack
)
1281 else if (p
[0] == '.')
1289 if (index (nm
, '/'))
1291 nm
= sys_translate_unix (nm
);
1292 return make_specified_string (nm
, -1, strlen (nm
),
1293 STRING_MULTIBYTE (name
));
1297 /* Make sure directories are all separated with / or \ as
1298 desired, but avoid allocation of a new string when not
1300 CORRECT_DIR_SEPS (nm
);
1302 if (IS_DIRECTORY_SEP (nm
[1]))
1304 if (strcmp (nm
, SDATA (name
)) != 0)
1305 name
= make_specified_string (nm
, -1, strlen (nm
),
1306 STRING_MULTIBYTE (name
));
1310 /* drive must be set, so this is okay */
1311 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1315 name
= make_specified_string (nm
, -1, p
- nm
,
1316 STRING_MULTIBYTE (name
));
1317 temp
[0] = DRIVE_LETTER (drive
);
1318 name
= concat2 (build_string (temp
), name
);
1321 #else /* not DOS_NT */
1322 if (nm
== SDATA (name
))
1324 return make_specified_string (nm
, -1, strlen (nm
),
1325 STRING_MULTIBYTE (name
));
1326 #endif /* not DOS_NT */
1330 /* At this point, nm might or might not be an absolute file name. We
1331 need to expand ~ or ~user if present, otherwise prefix nm with
1332 default_directory if nm is not absolute, and finally collapse /./
1333 and /foo/../ sequences.
1335 We set newdir to be the appropriate prefix if one is needed:
1336 - the relevant user directory if nm starts with ~ or ~user
1337 - the specified drive's working dir (DOS/NT only) if nm does not
1339 - the value of default_directory.
1341 Note that these prefixes are not guaranteed to be absolute (except
1342 for the working dir of a drive). Therefore, to ensure we always
1343 return an absolute name, if the final prefix is not absolute we
1344 append it to the current working directory. */
1348 if (nm
[0] == '~') /* prefix ~ */
1350 if (IS_DIRECTORY_SEP (nm
[1])
1354 || nm
[1] == 0) /* ~ by itself */
1356 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1357 newdir
= (unsigned char *) "";
1360 collapse_newdir
= 0;
1363 nm
++; /* Don't leave the slash in nm. */
1366 else /* ~user/filename */
1368 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1373 o
= (unsigned char *) alloca (p
- nm
+ 1);
1374 bcopy ((char *) nm
, o
, p
- nm
);
1377 pw
= (struct passwd
*) getpwnam (o
+ 1);
1380 newdir
= (unsigned char *) pw
-> pw_dir
;
1382 nm
= p
+ 1; /* skip the terminator */
1386 collapse_newdir
= 0;
1391 /* If we don't find a user of that name, leave the name
1392 unchanged; don't move nm forward to p. */
1397 /* On DOS and Windows, nm is absolute if a drive name was specified;
1398 use the drive's current directory as the prefix if needed. */
1399 if (!newdir
&& drive
)
1401 /* Get default directory if needed to make nm absolute. */
1402 if (!IS_DIRECTORY_SEP (nm
[0]))
1404 newdir
= alloca (MAXPATHLEN
+ 1);
1405 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1410 /* Either nm starts with /, or drive isn't mounted. */
1411 newdir
= alloca (4);
1412 newdir
[0] = DRIVE_LETTER (drive
);
1420 /* Finally, if no prefix has been specified and nm is not absolute,
1421 then it must be expanded relative to default_directory. */
1425 /* /... alone is not absolute on DOS and Windows. */
1426 && !IS_DIRECTORY_SEP (nm
[0])
1429 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1436 newdir
= SDATA (default_directory
);
1438 /* Note if special escape prefix is present, but remove for now. */
1439 if (newdir
[0] == '/' && newdir
[1] == ':')
1450 /* First ensure newdir is an absolute name. */
1452 /* Detect MSDOS file names with drive specifiers. */
1453 ! (IS_DRIVE (newdir
[0])
1454 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1456 /* Detect Windows file names in UNC format. */
1457 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1461 /* Effectively, let newdir be (expand-file-name newdir cwd).
1462 Because of the admonition against calling expand-file-name
1463 when we have pointers into lisp strings, we accomplish this
1464 indirectly by prepending newdir to nm if necessary, and using
1465 cwd (or the wd of newdir's drive) as the new newdir. */
1467 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1472 if (!IS_DIRECTORY_SEP (nm
[0]))
1474 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1475 file_name_as_directory (tmp
, newdir
);
1479 newdir
= alloca (MAXPATHLEN
+ 1);
1482 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1489 /* Strip off drive name from prefix, if present. */
1490 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1496 /* Keep only a prefix from newdir if nm starts with slash
1497 (//server/share for UNC, nothing otherwise). */
1498 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1501 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1503 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1505 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1507 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1519 /* Get rid of any slash at the end of newdir, unless newdir is
1520 just / or // (an incomplete UNC name). */
1521 length
= strlen (newdir
);
1522 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1524 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1528 unsigned char *temp
= (unsigned char *) alloca (length
);
1529 bcopy (newdir
, temp
, length
- 1);
1530 temp
[length
- 1] = 0;
1538 /* Now concatenate the directory and name to new space in the stack frame */
1539 tlen
+= strlen (nm
) + 1;
1541 /* Reserve space for drive specifier and escape prefix, since either
1542 or both may need to be inserted. (The Microsoft x86 compiler
1543 produces incorrect code if the following two lines are combined.) */
1544 target
= (unsigned char *) alloca (tlen
+ 4);
1546 #else /* not DOS_NT */
1547 target
= (unsigned char *) alloca (tlen
);
1548 #endif /* not DOS_NT */
1554 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1557 /* If newdir is effectively "C:/", then the drive letter will have
1558 been stripped and newdir will be "/". Concatenating with an
1559 absolute directory in nm produces "//", which will then be
1560 incorrectly treated as a network share. Ignore newdir in
1561 this case (keeping the drive letter). */
1562 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1563 && newdir
[1] == '\0'))
1565 strcpy (target
, newdir
);
1569 file_name_as_directory (target
, newdir
);
1572 strcat (target
, nm
);
1574 if (index (target
, '/'))
1575 strcpy (target
, sys_translate_unix (target
));
1578 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1580 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1589 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1595 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1596 /* brackets are offset from each other by 2 */
1599 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1600 /* convert [foo][bar] to [bar] */
1601 while (o
[-1] != '[' && o
[-1] != '<')
1603 else if (*p
== '-' && *o
!= '.')
1606 else if (p
[0] == '-' && o
[-1] == '.' &&
1607 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1608 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1612 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1613 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1615 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1617 /* else [foo.-] ==> [-] */
1621 #ifdef NO_HYPHENS_IN_FILENAMES
1623 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1624 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1626 #endif /* NO_HYPHENS_IN_FILENAMES */
1630 if (!IS_DIRECTORY_SEP (*p
))
1634 else if (IS_DIRECTORY_SEP (p
[0])
1636 && (IS_DIRECTORY_SEP (p
[2])
1639 /* If "/." is the entire filename, keep the "/". Otherwise,
1640 just delete the whole "/.". */
1641 if (o
== target
&& p
[2] == '\0')
1645 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1646 /* `/../' is the "superroot" on certain file systems. */
1648 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1650 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1652 /* Keep initial / only if this is the whole name. */
1653 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1658 && IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1]))
1660 /* Collapse multiple `/' in a row. */
1662 while (IS_DIRECTORY_SEP (*p
))
1669 #endif /* not VMS */
1673 /* At last, set drive name. */
1675 /* Except for network file name. */
1676 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1677 #endif /* WINDOWSNT */
1679 if (!drive
) abort ();
1681 target
[0] = DRIVE_LETTER (drive
);
1684 /* Reinsert the escape prefix if required. */
1691 CORRECT_DIR_SEPS (target
);
1694 result
= make_specified_string (target
, -1, o
- target
,
1695 STRING_MULTIBYTE (name
));
1697 /* Again look to see if the file name has special constructs in it
1698 and perhaps call the corresponding file handler. This is needed
1699 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1700 the ".." component gives us "/user@host:/bar/../baz" which needs
1701 to be expanded again. */
1702 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1703 if (!NILP (handler
))
1704 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1710 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1711 This is the old version of expand-file-name, before it was thoroughly
1712 rewritten for Emacs 10.31. We leave this version here commented-out,
1713 because the code is very complex and likely to have subtle bugs. If
1714 bugs _are_ found, it might be of interest to look at the old code and
1715 see what did it do in the relevant situation.
1717 Don't remove this code: it's true that it will be accessible via CVS,
1718 but a few years from deletion, people will forget it is there. */
1720 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1721 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1722 "Convert FILENAME to absolute, and canonicalize it.\n\
1723 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1724 (does not start with slash); if DEFAULT is nil or missing,\n\
1725 the current buffer's value of default-directory is used.\n\
1726 Filenames containing `.' or `..' as components are simplified;\n\
1727 initial `~/' expands to your home directory.\n\
1728 See also the function `substitute-in-file-name'.")
1730 Lisp_Object name
, defalt
;
1734 register unsigned char *newdir
, *p
, *o
;
1736 unsigned char *target
;
1740 unsigned char * colon
= 0;
1741 unsigned char * close
= 0;
1742 unsigned char * slash
= 0;
1743 unsigned char * brack
= 0;
1744 int lbrack
= 0, rbrack
= 0;
1748 CHECK_STRING (name
);
1751 /* Filenames on VMS are always upper case. */
1752 name
= Fupcase (name
);
1757 /* If nm is absolute, flush ...// and detect /./ and /../.
1758 If no /./ or /../ we can return right away. */
1770 if (p
[0] == '/' && p
[1] == '/'
1772 /* // at start of filename is meaningful on Apollo system. */
1777 if (p
[0] == '/' && p
[1] == '~')
1778 nm
= p
+ 1, lose
= 1;
1779 if (p
[0] == '/' && p
[1] == '.'
1780 && (p
[2] == '/' || p
[2] == 0
1781 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1787 /* if dev:[dir]/, move nm to / */
1788 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1789 nm
= (brack
? brack
+ 1 : colon
+ 1);
1790 lbrack
= rbrack
= 0;
1798 /* VMS pre V4.4,convert '-'s in filenames. */
1799 if (lbrack
== rbrack
)
1801 if (dots
< 2) /* this is to allow negative version numbers */
1806 if (lbrack
> rbrack
&&
1807 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1808 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1814 /* count open brackets, reset close bracket pointer */
1815 if (p
[0] == '[' || p
[0] == '<')
1816 lbrack
++, brack
= 0;
1817 /* count close brackets, set close bracket pointer */
1818 if (p
[0] == ']' || p
[0] == '>')
1819 rbrack
++, brack
= p
;
1820 /* detect ][ or >< */
1821 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1823 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1824 nm
= p
+ 1, lose
= 1;
1825 if (p
[0] == ':' && (colon
|| slash
))
1826 /* if dev1:[dir]dev2:, move nm to dev2: */
1832 /* If /name/dev:, move nm to dev: */
1835 /* If node::dev:, move colon following dev */
1836 else if (colon
&& colon
[-1] == ':')
1838 /* If dev1:dev2:, move nm to dev2: */
1839 else if (colon
&& colon
[-1] != ':')
1844 if (p
[0] == ':' && !colon
)
1850 if (lbrack
== rbrack
)
1853 else if (p
[0] == '.')
1861 if (index (nm
, '/'))
1862 return build_string (sys_translate_unix (nm
));
1864 if (nm
== SDATA (name
))
1866 return build_string (nm
);
1870 /* Now determine directory to start with and put it in NEWDIR */
1874 if (nm
[0] == '~') /* prefix ~ */
1879 || nm
[1] == 0)/* ~/filename */
1881 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1882 newdir
= (unsigned char *) "";
1885 nm
++; /* Don't leave the slash in nm. */
1888 else /* ~user/filename */
1890 /* Get past ~ to user */
1891 unsigned char *user
= nm
+ 1;
1892 /* Find end of name. */
1893 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1894 int len
= ptr
? ptr
- user
: strlen (user
);
1896 unsigned char *ptr1
= index (user
, ':');
1897 if (ptr1
!= 0 && ptr1
- user
< len
)
1900 /* Copy the user name into temp storage. */
1901 o
= (unsigned char *) alloca (len
+ 1);
1902 bcopy ((char *) user
, o
, len
);
1905 /* Look up the user name. */
1906 pw
= (struct passwd
*) getpwnam (o
+ 1);
1908 error ("\"%s\" isn't a registered user", o
+ 1);
1910 newdir
= (unsigned char *) pw
->pw_dir
;
1912 /* Discard the user name from NM. */
1919 #endif /* not VMS */
1923 defalt
= current_buffer
->directory
;
1924 CHECK_STRING (defalt
);
1925 newdir
= SDATA (defalt
);
1928 /* Now concatenate the directory and name to new space in the stack frame */
1930 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1931 target
= (unsigned char *) alloca (tlen
);
1937 if (nm
[0] == 0 || nm
[0] == '/')
1938 strcpy (target
, newdir
);
1941 file_name_as_directory (target
, newdir
);
1944 strcat (target
, nm
);
1946 if (index (target
, '/'))
1947 strcpy (target
, sys_translate_unix (target
));
1950 /* Now canonicalize by removing /. and /foo/.. if they appear */
1958 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1964 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1965 /* brackets are offset from each other by 2 */
1968 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1969 /* convert [foo][bar] to [bar] */
1970 while (o
[-1] != '[' && o
[-1] != '<')
1972 else if (*p
== '-' && *o
!= '.')
1975 else if (p
[0] == '-' && o
[-1] == '.' &&
1976 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1977 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1981 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1982 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1984 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1986 /* else [foo.-] ==> [-] */
1992 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1993 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2003 else if (!strncmp (p
, "//", 2)
2005 /* // at start of filename is meaningful in Apollo system. */
2013 else if (p
[0] == '/' && p
[1] == '.' &&
2014 (p
[2] == '/' || p
[2] == 0))
2016 else if (!strncmp (p
, "/..", 3)
2017 /* `/../' is the "superroot" on certain file systems. */
2019 && (p
[3] == '/' || p
[3] == 0))
2021 while (o
!= target
&& *--o
!= '/')
2024 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2028 if (o
== target
&& *o
== '/')
2036 #endif /* not VMS */
2039 return make_string (target
, o
- target
);
2043 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2044 Ssubstitute_in_file_name
, 1, 1, 0,
2045 doc
: /* Substitute environment variables referred to in FILENAME.
2046 `$FOO' where FOO is an environment variable name means to substitute
2047 the value of that variable. The variable name should be terminated
2048 with a character not a letter, digit or underscore; otherwise, enclose
2049 the entire variable name in braces.
2050 If `/~' appears, all of FILENAME through that `/' is discarded.
2052 On VMS, `$' substitution is not done; this function does little and only
2053 duplicates what `expand-file-name' does. */)
2055 Lisp_Object filename
;
2059 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2060 unsigned char *target
= NULL
;
2062 int substituted
= 0;
2065 Lisp_Object handler
;
2067 CHECK_STRING (filename
);
2069 /* If the file name has special constructs in it,
2070 call the corresponding file handler. */
2071 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2072 if (!NILP (handler
))
2073 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2075 nm
= SDATA (filename
);
2077 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2078 CORRECT_DIR_SEPS (nm
);
2079 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2081 endp
= nm
+ SBYTES (filename
);
2083 /* If /~ or // appears, discard everything through first slash. */
2085 for (p
= nm
; p
!= endp
; p
++)
2088 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2089 /* // at start of file name is meaningful in Apollo,
2090 WindowsNT and Cygwin systems. */
2091 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
2092 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2093 || IS_DIRECTORY_SEP (p
[0])
2094 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2099 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2101 || IS_DIRECTORY_SEP (p
[-1])))
2103 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2108 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2110 o
= (unsigned char *) alloca (s
- p
+ 1);
2111 bcopy ((char *) p
, o
, s
- p
);
2114 pw
= (struct passwd
*) getpwnam (o
+ 1);
2116 /* If we have ~/ or ~user and `user' exists, discard
2117 everything up to ~. But if `user' does not exist, leave
2118 ~user alone, it might be a literal file name. */
2119 if (IS_DIRECTORY_SEP (p
[0]) || s
== p
+ 1 || pw
)
2126 /* see comment in expand-file-name about drive specifiers */
2127 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2128 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
2137 return make_specified_string (nm
, -1, strlen (nm
),
2138 STRING_MULTIBYTE (filename
));
2141 /* See if any variables are substituted into the string
2142 and find the total length of their values in `total' */
2144 for (p
= nm
; p
!= endp
;)
2154 /* "$$" means a single "$" */
2163 while (p
!= endp
&& *p
!= '}') p
++;
2164 if (*p
!= '}') goto missingclose
;
2170 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2174 /* Copy out the variable name */
2175 target
= (unsigned char *) alloca (s
- o
+ 1);
2176 strncpy (target
, o
, s
- o
);
2179 strupr (target
); /* $home == $HOME etc. */
2182 /* Get variable value */
2183 o
= (unsigned char *) egetenv (target
);
2186 total
+= strlen (o
);
2196 /* If substitution required, recopy the string and do it */
2197 /* Make space in stack frame for the new copy */
2198 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2201 /* Copy the rest of the name through, replacing $ constructs with values */
2218 while (p
!= endp
&& *p
!= '}') p
++;
2219 if (*p
!= '}') goto missingclose
;
2225 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2229 /* Copy out the variable name */
2230 target
= (unsigned char *) alloca (s
- o
+ 1);
2231 strncpy (target
, o
, s
- o
);
2234 strupr (target
); /* $home == $HOME etc. */
2237 /* Get variable value */
2238 o
= (unsigned char *) egetenv (target
);
2242 strcpy (x
, target
); x
+= strlen (target
);
2244 else if (STRING_MULTIBYTE (filename
))
2246 /* If the original string is multibyte,
2247 convert what we substitute into multibyte. */
2250 int c
= unibyte_char_to_multibyte (*o
++);
2251 x
+= CHAR_STRING (c
, x
);
2263 /* If /~ or // appears, discard everything through first slash. */
2265 for (p
= xnm
; p
!= x
; p
++)
2267 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2268 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
2269 #else /* not (APOLLO || WINDOWSNT || CYGWIN) */
2270 || IS_DIRECTORY_SEP (p
[0])
2271 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2273 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2276 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
2277 && p
> xnm
&& IS_DIRECTORY_SEP (p
[-1]))
2281 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2284 error ("Bad format environment-variable substitution");
2286 error ("Missing \"}\" in environment-variable substitution");
2288 error ("Substituting nonexistent environment variable \"%s\"", target
);
2291 #endif /* not VMS */
2295 /* A slightly faster and more convenient way to get
2296 (directory-file-name (expand-file-name FOO)). */
2299 expand_and_dir_to_file (filename
, defdir
)
2300 Lisp_Object filename
, defdir
;
2302 register Lisp_Object absname
;
2304 absname
= Fexpand_file_name (filename
, defdir
);
2307 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2308 if (c
== ':' || c
== ']' || c
== '>')
2309 absname
= Fdirectory_file_name (absname
);
2312 /* Remove final slash, if any (unless this is the root dir).
2313 stat behaves differently depending! */
2314 if (SCHARS (absname
) > 1
2315 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2316 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2317 /* We cannot take shortcuts; they might be wrong for magic file names. */
2318 absname
= Fdirectory_file_name (absname
);
2323 /* Signal an error if the file ABSNAME already exists.
2324 If INTERACTIVE is nonzero, ask the user whether to proceed,
2325 and bypass the error if the user says to go ahead.
2326 QUERYSTRING is a name for the action that is being considered
2329 *STATPTR is used to store the stat information if the file exists.
2330 If the file does not exist, STATPTR->st_mode is set to 0.
2331 If STATPTR is null, we don't store into it.
2333 If QUICK is nonzero, we ask for y or n, not yes or no. */
2336 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2337 Lisp_Object absname
;
2338 unsigned char *querystring
;
2340 struct stat
*statptr
;
2343 register Lisp_Object tem
, encoded_filename
;
2344 struct stat statbuf
;
2345 struct gcpro gcpro1
;
2347 encoded_filename
= ENCODE_FILE (absname
);
2349 /* stat is a good way to tell whether the file exists,
2350 regardless of what access permissions it has. */
2351 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
2354 Fsignal (Qfile_already_exists
,
2355 Fcons (build_string ("File already exists"),
2356 Fcons (absname
, Qnil
)));
2358 tem
= format2 ("File %s already exists; %s anyway? ",
2359 absname
, build_string (querystring
));
2361 tem
= Fy_or_n_p (tem
);
2363 tem
= do_yes_or_no_p (tem
);
2366 Fsignal (Qfile_already_exists
,
2367 Fcons (build_string ("File already exists"),
2368 Fcons (absname
, Qnil
)));
2375 statptr
->st_mode
= 0;
2380 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2381 "fCopy file: \nFCopy %s to file: \np\nP",
2382 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2383 If NEWNAME names a directory, copy FILE there.
2384 Signals a `file-already-exists' error if file NEWNAME already exists,
2385 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
2386 A number as third arg means request confirmation if NEWNAME already exists.
2387 This is what happens in interactive use with M-x.
2388 Always sets the file modes of the output file to match the input file.
2389 Fourth arg KEEP-TIME non-nil means give the output file the same
2390 last-modified time as the old one. (This works on only some systems.)
2391 A prefix arg makes KEEP-TIME non-nil. */)
2392 (file
, newname
, ok_if_already_exists
, keep_time
)
2393 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
;
2396 char buf
[16 * 1024];
2397 struct stat st
, out_st
;
2398 Lisp_Object handler
;
2399 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2400 int count
= SPECPDL_INDEX ();
2401 int input_file_statable_p
;
2402 Lisp_Object encoded_file
, encoded_newname
;
2404 encoded_file
= encoded_newname
= Qnil
;
2405 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2406 CHECK_STRING (file
);
2407 CHECK_STRING (newname
);
2409 if (!NILP (Ffile_directory_p (newname
)))
2410 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2412 newname
= Fexpand_file_name (newname
, Qnil
);
2414 file
= Fexpand_file_name (file
, Qnil
);
2416 /* If the input file name has special constructs in it,
2417 call the corresponding file handler. */
2418 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2419 /* Likewise for output file name. */
2421 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2422 if (!NILP (handler
))
2423 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2424 ok_if_already_exists
, keep_time
));
2426 encoded_file
= ENCODE_FILE (file
);
2427 encoded_newname
= ENCODE_FILE (newname
);
2429 if (NILP (ok_if_already_exists
)
2430 || INTEGERP (ok_if_already_exists
))
2431 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2432 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2433 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2437 if (!CopyFile (SDATA (encoded_file
),
2438 SDATA (encoded_newname
),
2440 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2441 /* CopyFile retains the timestamp by default. */
2442 else if (NILP (keep_time
))
2448 EMACS_GET_TIME (now
);
2449 filename
= SDATA (encoded_newname
);
2451 /* Ensure file is writable while its modified time is set. */
2452 attributes
= GetFileAttributes (filename
);
2453 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2454 if (set_file_times (filename
, now
, now
))
2456 /* Restore original attributes. */
2457 SetFileAttributes (filename
, attributes
);
2458 Fsignal (Qfile_date_error
,
2459 Fcons (build_string ("Cannot set file date"),
2460 Fcons (newname
, Qnil
)));
2462 /* Restore original attributes. */
2463 SetFileAttributes (filename
, attributes
);
2465 #else /* not WINDOWSNT */
2467 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2471 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2473 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2475 /* We can only copy regular files and symbolic links. Other files are not
2477 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2479 #if !defined (DOS_NT) || __DJGPP__ > 1
2480 if (out_st
.st_mode
!= 0
2481 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2484 report_file_error ("Input and output files are the same",
2485 Fcons (file
, Fcons (newname
, Qnil
)));
2489 #if defined (S_ISREG) && defined (S_ISLNK)
2490 if (input_file_statable_p
)
2492 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2494 #if defined (EISDIR)
2495 /* Get a better looking error message. */
2498 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2501 #endif /* S_ISREG && S_ISLNK */
2504 /* Create the copy file with the same record format as the input file */
2505 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2508 /* System's default file type was set to binary by _fmode in emacs.c. */
2509 ofd
= creat (SDATA (encoded_newname
), S_IREAD
| S_IWRITE
);
2510 #else /* not MSDOS */
2511 ofd
= creat (SDATA (encoded_newname
), 0666);
2512 #endif /* not MSDOS */
2515 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2517 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2521 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2522 if (emacs_write (ofd
, buf
, n
) != n
)
2523 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2526 /* Closing the output clobbers the file times on some systems. */
2527 if (emacs_close (ofd
) < 0)
2528 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2530 if (input_file_statable_p
)
2532 if (!NILP (keep_time
))
2534 EMACS_TIME atime
, mtime
;
2535 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2536 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2537 if (set_file_times (SDATA (encoded_newname
),
2539 Fsignal (Qfile_date_error
,
2540 Fcons (build_string ("Cannot set file date"),
2541 Fcons (newname
, Qnil
)));
2544 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2546 #if defined (__DJGPP__) && __DJGPP__ > 1
2547 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2548 and if it can't, it tells so. Otherwise, under MSDOS we usually
2549 get only the READ bit, which will make the copied file read-only,
2550 so it's better not to chmod at all. */
2551 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2552 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2553 #endif /* DJGPP version 2 or newer */
2558 #endif /* WINDOWSNT */
2560 /* Discard the unwind protects. */
2561 specpdl_ptr
= specpdl
+ count
;
2567 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2568 Smake_directory_internal
, 1, 1, 0,
2569 doc
: /* Create a new directory named DIRECTORY. */)
2571 Lisp_Object directory
;
2573 const unsigned char *dir
;
2574 Lisp_Object handler
;
2575 Lisp_Object encoded_dir
;
2577 CHECK_STRING (directory
);
2578 directory
= Fexpand_file_name (directory
, Qnil
);
2580 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2581 if (!NILP (handler
))
2582 return call2 (handler
, Qmake_directory_internal
, directory
);
2584 encoded_dir
= ENCODE_FILE (directory
);
2586 dir
= SDATA (encoded_dir
);
2589 if (mkdir (dir
) != 0)
2591 if (mkdir (dir
, 0777) != 0)
2593 report_file_error ("Creating directory", Flist (1, &directory
));
2598 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2599 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2601 Lisp_Object directory
;
2603 const unsigned char *dir
;
2604 Lisp_Object handler
;
2605 Lisp_Object encoded_dir
;
2607 CHECK_STRING (directory
);
2608 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2610 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2611 if (!NILP (handler
))
2612 return call2 (handler
, Qdelete_directory
, directory
);
2614 encoded_dir
= ENCODE_FILE (directory
);
2616 dir
= SDATA (encoded_dir
);
2618 if (rmdir (dir
) != 0)
2619 report_file_error ("Removing directory", Flist (1, &directory
));
2624 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2625 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2626 If file has multiple names, it continues to exist with the other names. */)
2628 Lisp_Object filename
;
2630 Lisp_Object handler
;
2631 Lisp_Object encoded_file
;
2632 struct gcpro gcpro1
;
2635 if (!NILP (Ffile_directory_p (filename
))
2636 && NILP (Ffile_symlink_p (filename
)))
2637 Fsignal (Qfile_error
,
2638 Fcons (build_string ("Removing old name: is a directory"),
2639 Fcons (filename
, Qnil
)));
2641 filename
= Fexpand_file_name (filename
, Qnil
);
2643 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2644 if (!NILP (handler
))
2645 return call2 (handler
, Qdelete_file
, filename
);
2647 encoded_file
= ENCODE_FILE (filename
);
2649 if (0 > unlink (SDATA (encoded_file
)))
2650 report_file_error ("Removing old name", Flist (1, &filename
));
2655 internal_delete_file_1 (ignore
)
2661 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2664 internal_delete_file (filename
)
2665 Lisp_Object filename
;
2667 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2668 Qt
, internal_delete_file_1
));
2671 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2672 "fRename file: \nFRename %s to file: \np",
2673 doc
: /* Rename FILE as NEWNAME. Both args strings.
2674 If file has names other than FILE, it continues to have those names.
2675 Signals a `file-already-exists' error if a file NEWNAME already exists
2676 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2677 A number as third arg means request confirmation if NEWNAME already exists.
2678 This is what happens in interactive use with M-x. */)
2679 (file
, newname
, ok_if_already_exists
)
2680 Lisp_Object file
, newname
, ok_if_already_exists
;
2683 Lisp_Object args
[2];
2685 Lisp_Object handler
;
2686 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2687 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2689 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2690 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2691 CHECK_STRING (file
);
2692 CHECK_STRING (newname
);
2693 file
= Fexpand_file_name (file
, Qnil
);
2694 newname
= Fexpand_file_name (newname
, Qnil
);
2696 /* If the file name has special constructs in it,
2697 call the corresponding file handler. */
2698 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2700 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2701 if (!NILP (handler
))
2702 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2703 file
, newname
, ok_if_already_exists
));
2705 encoded_file
= ENCODE_FILE (file
);
2706 encoded_newname
= ENCODE_FILE (newname
);
2709 /* If the file names are identical but for the case, don't ask for
2710 confirmation: they simply want to change the letter-case of the
2712 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2714 if (NILP (ok_if_already_exists
)
2715 || INTEGERP (ok_if_already_exists
))
2716 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2717 INTEGERP (ok_if_already_exists
), 0, 0);
2719 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2721 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2722 || 0 > unlink (SDATA (encoded_file
)))
2728 symlink_target
= Ffile_symlink_p (file
);
2729 if (! NILP (symlink_target
))
2730 Fmake_symbolic_link (symlink_target
, newname
,
2731 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2734 Fcopy_file (file
, newname
,
2735 /* We have already prompted if it was an integer,
2736 so don't have copy-file prompt again. */
2737 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2738 Fdelete_file (file
);
2745 report_file_error ("Renaming", Flist (2, args
));
2748 report_file_error ("Renaming", Flist (2, &file
));
2755 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2756 "fAdd name to file: \nFName to add to %s: \np",
2757 doc
: /* Give FILE additional name NEWNAME. Both args strings.
2758 Signals a `file-already-exists' error if a file NEWNAME already exists
2759 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2760 A number as third arg means request confirmation if NEWNAME already exists.
2761 This is what happens in interactive use with M-x. */)
2762 (file
, newname
, ok_if_already_exists
)
2763 Lisp_Object file
, newname
, ok_if_already_exists
;
2766 Lisp_Object args
[2];
2768 Lisp_Object handler
;
2769 Lisp_Object encoded_file
, encoded_newname
;
2770 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2772 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2773 encoded_file
= encoded_newname
= Qnil
;
2774 CHECK_STRING (file
);
2775 CHECK_STRING (newname
);
2776 file
= Fexpand_file_name (file
, Qnil
);
2777 newname
= Fexpand_file_name (newname
, Qnil
);
2779 /* If the file name has special constructs in it,
2780 call the corresponding file handler. */
2781 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2782 if (!NILP (handler
))
2783 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2784 newname
, ok_if_already_exists
));
2786 /* If the new name has special constructs in it,
2787 call the corresponding file handler. */
2788 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2789 if (!NILP (handler
))
2790 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2791 newname
, ok_if_already_exists
));
2793 encoded_file
= ENCODE_FILE (file
);
2794 encoded_newname
= ENCODE_FILE (newname
);
2796 if (NILP (ok_if_already_exists
)
2797 || INTEGERP (ok_if_already_exists
))
2798 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2799 INTEGERP (ok_if_already_exists
), 0, 0);
2801 unlink (SDATA (newname
));
2802 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2807 report_file_error ("Adding new name", Flist (2, args
));
2809 report_file_error ("Adding new name", Flist (2, &file
));
2818 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2819 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2820 doc
: /* Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2821 Signals a `file-already-exists' error if a file LINKNAME already exists
2822 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2823 A number as third arg means request confirmation if LINKNAME already exists.
2824 This happens for interactive use with M-x. */)
2825 (filename
, linkname
, ok_if_already_exists
)
2826 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2829 Lisp_Object args
[2];
2831 Lisp_Object handler
;
2832 Lisp_Object encoded_filename
, encoded_linkname
;
2833 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2835 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2836 encoded_filename
= encoded_linkname
= Qnil
;
2837 CHECK_STRING (filename
);
2838 CHECK_STRING (linkname
);
2839 /* If the link target has a ~, we must expand it to get
2840 a truly valid file name. Otherwise, do not expand;
2841 we want to permit links to relative file names. */
2842 if (SREF (filename
, 0) == '~')
2843 filename
= Fexpand_file_name (filename
, Qnil
);
2844 linkname
= Fexpand_file_name (linkname
, Qnil
);
2846 /* If the file name has special constructs in it,
2847 call the corresponding file handler. */
2848 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2849 if (!NILP (handler
))
2850 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2851 linkname
, ok_if_already_exists
));
2853 /* If the new link name has special constructs in it,
2854 call the corresponding file handler. */
2855 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2856 if (!NILP (handler
))
2857 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2858 linkname
, ok_if_already_exists
));
2860 encoded_filename
= ENCODE_FILE (filename
);
2861 encoded_linkname
= ENCODE_FILE (linkname
);
2863 if (NILP (ok_if_already_exists
)
2864 || INTEGERP (ok_if_already_exists
))
2865 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2866 INTEGERP (ok_if_already_exists
), 0, 0);
2867 if (0 > symlink (SDATA (encoded_filename
),
2868 SDATA (encoded_linkname
)))
2870 /* If we didn't complain already, silently delete existing file. */
2871 if (errno
== EEXIST
)
2873 unlink (SDATA (encoded_linkname
));
2874 if (0 <= symlink (SDATA (encoded_filename
),
2875 SDATA (encoded_linkname
)))
2885 report_file_error ("Making symbolic link", Flist (2, args
));
2887 report_file_error ("Making symbolic link", Flist (2, &filename
));
2893 #endif /* S_IFLNK */
2897 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2898 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2899 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2900 If STRING is nil or a null string, the logical name NAME is deleted. */)
2905 CHECK_STRING (name
);
2907 delete_logical_name (SDATA (name
));
2910 CHECK_STRING (string
);
2912 if (SCHARS (string
) == 0)
2913 delete_logical_name (SDATA (name
));
2915 define_logical_name (SDATA (name
), SDATA (string
));
2924 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2925 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2927 Lisp_Object path
, login
;
2931 CHECK_STRING (path
);
2932 CHECK_STRING (login
);
2934 netresult
= netunam (SDATA (path
), SDATA (login
));
2936 if (netresult
== -1)
2941 #endif /* HPUX_NET */
2943 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2945 doc
: /* Return t if file FILENAME specifies an absolute file name.
2946 On Unix, this is a name starting with a `/' or a `~'. */)
2948 Lisp_Object filename
;
2950 const unsigned char *ptr
;
2952 CHECK_STRING (filename
);
2953 ptr
= SDATA (filename
);
2954 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2956 /* ??? This criterion is probably wrong for '<'. */
2957 || index (ptr
, ':') || index (ptr
, '<')
2958 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2962 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2970 /* Return nonzero if file FILENAME exists and can be executed. */
2973 check_executable (filename
)
2977 int len
= strlen (filename
);
2980 if (stat (filename
, &st
) < 0)
2982 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2983 return ((st
.st_mode
& S_IEXEC
) != 0);
2985 return (S_ISREG (st
.st_mode
)
2987 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2988 || stricmp (suffix
, ".exe") == 0
2989 || stricmp (suffix
, ".bat") == 0)
2990 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2991 #endif /* not WINDOWSNT */
2992 #else /* not DOS_NT */
2993 #ifdef HAVE_EUIDACCESS
2994 return (euidaccess (filename
, 1) >= 0);
2996 /* Access isn't quite right because it uses the real uid
2997 and we really want to test with the effective uid.
2998 But Unix doesn't give us a right way to do it. */
2999 return (access (filename
, 1) >= 0);
3001 #endif /* not DOS_NT */
3004 /* Return nonzero if file FILENAME exists and can be written. */
3007 check_writable (filename
)
3012 if (stat (filename
, &st
) < 0)
3014 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3015 #else /* not MSDOS */
3016 #ifdef HAVE_EUIDACCESS
3017 return (euidaccess (filename
, 2) >= 0);
3019 /* Access isn't quite right because it uses the real uid
3020 and we really want to test with the effective uid.
3021 But Unix doesn't give us a right way to do it.
3022 Opening with O_WRONLY could work for an ordinary file,
3023 but would lose for directories. */
3024 return (access (filename
, 2) >= 0);
3026 #endif /* not MSDOS */
3029 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3030 doc
: /* Return t if file FILENAME exists. (This does not mean you can read it.)
3031 See also `file-readable-p' and `file-attributes'. */)
3033 Lisp_Object filename
;
3035 Lisp_Object absname
;
3036 Lisp_Object handler
;
3037 struct stat statbuf
;
3039 CHECK_STRING (filename
);
3040 absname
= Fexpand_file_name (filename
, Qnil
);
3042 /* If the file name has special constructs in it,
3043 call the corresponding file handler. */
3044 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3045 if (!NILP (handler
))
3046 return call2 (handler
, Qfile_exists_p
, absname
);
3048 absname
= ENCODE_FILE (absname
);
3050 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3053 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3054 doc
: /* Return t if FILENAME can be executed by you.
3055 For a directory, this means you can access files in that directory. */)
3057 Lisp_Object filename
;
3059 Lisp_Object absname
;
3060 Lisp_Object handler
;
3062 CHECK_STRING (filename
);
3063 absname
= Fexpand_file_name (filename
, Qnil
);
3065 /* If the file name has special constructs in it,
3066 call the corresponding file handler. */
3067 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3068 if (!NILP (handler
))
3069 return call2 (handler
, Qfile_executable_p
, absname
);
3071 absname
= ENCODE_FILE (absname
);
3073 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3076 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3077 doc
: /* Return t if file FILENAME exists and you can read it.
3078 See also `file-exists-p' and `file-attributes'. */)
3080 Lisp_Object filename
;
3082 Lisp_Object absname
;
3083 Lisp_Object handler
;
3086 struct stat statbuf
;
3088 CHECK_STRING (filename
);
3089 absname
= Fexpand_file_name (filename
, Qnil
);
3091 /* If the file name has special constructs in it,
3092 call the corresponding file handler. */
3093 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3094 if (!NILP (handler
))
3095 return call2 (handler
, Qfile_readable_p
, absname
);
3097 absname
= ENCODE_FILE (absname
);
3099 #if defined(DOS_NT) || defined(macintosh)
3100 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3102 if (access (SDATA (absname
), 0) == 0)
3105 #else /* not DOS_NT and not macintosh */
3107 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3108 /* Opening a fifo without O_NONBLOCK can wait.
3109 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3110 except in the case of a fifo, on a system which handles it. */
3111 desc
= stat (SDATA (absname
), &statbuf
);
3114 if (S_ISFIFO (statbuf
.st_mode
))
3115 flags
|= O_NONBLOCK
;
3117 desc
= emacs_open (SDATA (absname
), flags
, 0);
3122 #endif /* not DOS_NT and not macintosh */
3125 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3127 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3128 doc
: /* Return t if file FILENAME can be written or created by you. */)
3130 Lisp_Object filename
;
3132 Lisp_Object absname
, dir
, encoded
;
3133 Lisp_Object handler
;
3134 struct stat statbuf
;
3136 CHECK_STRING (filename
);
3137 absname
= Fexpand_file_name (filename
, Qnil
);
3139 /* If the file name has special constructs in it,
3140 call the corresponding file handler. */
3141 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3142 if (!NILP (handler
))
3143 return call2 (handler
, Qfile_writable_p
, absname
);
3145 encoded
= ENCODE_FILE (absname
);
3146 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3147 return (check_writable (SDATA (encoded
))
3150 dir
= Ffile_name_directory (absname
);
3153 dir
= Fdirectory_file_name (dir
);
3157 dir
= Fdirectory_file_name (dir
);
3160 dir
= ENCODE_FILE (dir
);
3162 /* The read-only attribute of the parent directory doesn't affect
3163 whether a file or directory can be created within it. Some day we
3164 should check ACLs though, which do affect this. */
3165 if (stat (SDATA (dir
), &statbuf
) < 0)
3167 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3169 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3174 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3175 doc
: /* Access file FILENAME, and get an error if that does not work.
3176 The second argument STRING is used in the error message.
3177 If there is no error, we return nil. */)
3179 Lisp_Object filename
, string
;
3181 Lisp_Object handler
, encoded_filename
, absname
;
3184 CHECK_STRING (filename
);
3185 absname
= Fexpand_file_name (filename
, Qnil
);
3187 CHECK_STRING (string
);
3189 /* If the file name has special constructs in it,
3190 call the corresponding file handler. */
3191 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3192 if (!NILP (handler
))
3193 return call3 (handler
, Qaccess_file
, absname
, string
);
3195 encoded_filename
= ENCODE_FILE (absname
);
3197 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3199 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3205 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3206 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3207 The value is the link target, as a string.
3208 Otherwise returns nil. */)
3210 Lisp_Object filename
;
3212 Lisp_Object handler
;
3214 CHECK_STRING (filename
);
3215 filename
= Fexpand_file_name (filename
, Qnil
);
3217 /* If the file name has special constructs in it,
3218 call the corresponding file handler. */
3219 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3220 if (!NILP (handler
))
3221 return call2 (handler
, Qfile_symlink_p
, filename
);
3230 filename
= ENCODE_FILE (filename
);
3237 buf
= (char *) xrealloc (buf
, bufsize
);
3238 bzero (buf
, bufsize
);
3241 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3245 /* HP-UX reports ERANGE if buffer is too small. */
3246 if (errno
== ERANGE
)
3256 while (valsize
>= bufsize
);
3258 val
= make_string (buf
, valsize
);
3259 if (buf
[0] == '/' && index (buf
, ':'))
3260 val
= concat2 (build_string ("/:"), val
);
3262 val
= DECODE_FILE (val
);
3265 #else /* not S_IFLNK */
3267 #endif /* not S_IFLNK */
3270 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3271 doc
: /* Return t if FILENAME names an existing directory.
3272 Symbolic links to directories count as directories.
3273 See `file-symlink-p' to distinguish symlinks. */)
3275 Lisp_Object filename
;
3277 register Lisp_Object absname
;
3279 Lisp_Object handler
;
3281 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3283 /* If the file name has special constructs in it,
3284 call the corresponding file handler. */
3285 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3286 if (!NILP (handler
))
3287 return call2 (handler
, Qfile_directory_p
, absname
);
3289 absname
= ENCODE_FILE (absname
);
3291 if (stat (SDATA (absname
), &st
) < 0)
3293 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3296 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3297 doc
: /* Return t if file FILENAME names a directory you can open.
3298 For the value to be t, FILENAME must specify the name of a directory as a file,
3299 and the directory must allow you to open files in it. In order to use a
3300 directory as a buffer's current directory, this predicate must return true.
3301 A directory name spec may be given instead; then the value is t
3302 if the directory so specified exists and really is a readable and
3303 searchable directory. */)
3305 Lisp_Object filename
;
3307 Lisp_Object handler
;
3309 struct gcpro gcpro1
;
3311 /* If the file name has special constructs in it,
3312 call the corresponding file handler. */
3313 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3314 if (!NILP (handler
))
3315 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3318 tem
= (NILP (Ffile_directory_p (filename
))
3319 || NILP (Ffile_executable_p (filename
)));
3321 return tem
? Qnil
: Qt
;
3324 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3325 doc
: /* Return t if file FILENAME is the name of a regular file.
3326 This is the sort of file that holds an ordinary stream of data bytes. */)
3328 Lisp_Object filename
;
3330 register Lisp_Object absname
;
3332 Lisp_Object handler
;
3334 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3336 /* If the file name has special constructs in it,
3337 call the corresponding file handler. */
3338 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3339 if (!NILP (handler
))
3340 return call2 (handler
, Qfile_regular_p
, absname
);
3342 absname
= ENCODE_FILE (absname
);
3347 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3349 /* Tell stat to use expensive method to get accurate info. */
3350 Vw32_get_true_file_attributes
= Qt
;
3351 result
= stat (SDATA (absname
), &st
);
3352 Vw32_get_true_file_attributes
= tem
;
3356 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3359 if (stat (SDATA (absname
), &st
) < 0)
3361 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3365 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3366 doc
: /* Return mode bits of file named FILENAME, as an integer.
3367 Return nil, if file does not exist or is not accessible. */)
3369 Lisp_Object filename
;
3371 Lisp_Object absname
;
3373 Lisp_Object handler
;
3375 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3377 /* If the file name has special constructs in it,
3378 call the corresponding file handler. */
3379 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3380 if (!NILP (handler
))
3381 return call2 (handler
, Qfile_modes
, absname
);
3383 absname
= ENCODE_FILE (absname
);
3385 if (stat (SDATA (absname
), &st
) < 0)
3387 #if defined (MSDOS) && __DJGPP__ < 2
3388 if (check_executable (SDATA (absname
)))
3389 st
.st_mode
|= S_IEXEC
;
3390 #endif /* MSDOS && __DJGPP__ < 2 */
3392 return make_number (st
.st_mode
& 07777);
3395 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3396 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3397 Only the 12 low bits of MODE are used. */)
3399 Lisp_Object filename
, mode
;
3401 Lisp_Object absname
, encoded_absname
;
3402 Lisp_Object handler
;
3404 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3405 CHECK_NUMBER (mode
);
3407 /* If the file name has special constructs in it,
3408 call the corresponding file handler. */
3409 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3410 if (!NILP (handler
))
3411 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3413 encoded_absname
= ENCODE_FILE (absname
);
3415 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3416 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3421 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3422 doc
: /* Set the file permission bits for newly created files.
3423 The argument MODE should be an integer; only the low 9 bits are used.
3424 This setting is inherited by subprocesses. */)
3428 CHECK_NUMBER (mode
);
3430 umask ((~ XINT (mode
)) & 0777);
3435 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3436 doc
: /* Return the default file protection for created files.
3437 The value is an integer. */)
3443 realmask
= umask (0);
3446 XSETINT (value
, (~ realmask
) & 0777);
3450 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3452 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3453 doc
: /* Set times of file FILENAME to TIME.
3454 Set both access and modification times.
3455 Return t on success, else nil.
3456 Use the current time if TIME is nil. TIME is in the format of
3459 Lisp_Object filename
, time
;
3461 Lisp_Object absname
, encoded_absname
;
3462 Lisp_Object handler
;
3466 if (! lisp_time_argument (time
, &sec
, &usec
))
3467 error ("Invalid time specification");
3469 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3471 /* If the file name has special constructs in it,
3472 call the corresponding file handler. */
3473 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3474 if (!NILP (handler
))
3475 return call3 (handler
, Qset_file_times
, absname
, time
);
3477 encoded_absname
= ENCODE_FILE (absname
);
3482 EMACS_SET_SECS (t
, sec
);
3483 EMACS_SET_USECS (t
, usec
);
3485 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3490 /* Setting times on a directory always fails. */
3491 if (stat (SDATA (encoded_absname
), &st
) == 0
3492 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3495 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3508 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3509 doc
: /* Tell Unix to finish all pending disk updates. */)
3518 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3519 doc
: /* Return t if file FILE1 is newer than file FILE2.
3520 If FILE1 does not exist, the answer is nil;
3521 otherwise, if FILE2 does not exist, the answer is t. */)
3523 Lisp_Object file1
, file2
;
3525 Lisp_Object absname1
, absname2
;
3528 Lisp_Object handler
;
3529 struct gcpro gcpro1
, gcpro2
;
3531 CHECK_STRING (file1
);
3532 CHECK_STRING (file2
);
3535 GCPRO2 (absname1
, file2
);
3536 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3537 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3540 /* If the file name has special constructs in it,
3541 call the corresponding file handler. */
3542 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3544 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3545 if (!NILP (handler
))
3546 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3548 GCPRO2 (absname1
, absname2
);
3549 absname1
= ENCODE_FILE (absname1
);
3550 absname2
= ENCODE_FILE (absname2
);
3553 if (stat (SDATA (absname1
), &st
) < 0)
3556 mtime1
= st
.st_mtime
;
3558 if (stat (SDATA (absname2
), &st
) < 0)
3561 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3565 Lisp_Object Qfind_buffer_file_type
;
3568 #ifndef READ_BUF_SIZE
3569 #define READ_BUF_SIZE (64 << 10)
3572 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3574 /* This function is called after Lisp functions to decide a coding
3575 system are called, or when they cause an error. Before they are
3576 called, the current buffer is set unibyte and it contains only a
3577 newly inserted text (thus the buffer was empty before the
3580 The functions may set markers, overlays, text properties, or even
3581 alter the buffer contents, change the current buffer.
3583 Here, we reset all those changes by:
3584 o set back the current buffer.
3585 o move all markers and overlays to BEG.
3586 o remove all text properties.
3587 o set back the buffer multibyteness. */
3590 decide_coding_unwind (unwind_data
)
3591 Lisp_Object unwind_data
;
3593 Lisp_Object multibyte
, undo_list
, buffer
;
3595 multibyte
= XCAR (unwind_data
);
3596 unwind_data
= XCDR (unwind_data
);
3597 undo_list
= XCAR (unwind_data
);
3598 buffer
= XCDR (unwind_data
);
3600 if (current_buffer
!= XBUFFER (buffer
))
3601 set_buffer_internal (XBUFFER (buffer
));
3602 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3603 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3604 BUF_INTERVALS (current_buffer
) = 0;
3605 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3607 /* Now we are safe to change the buffer's multibyteness directly. */
3608 current_buffer
->enable_multibyte_characters
= multibyte
;
3609 current_buffer
->undo_list
= undo_list
;
3615 /* Used to pass values from insert-file-contents to read_non_regular. */
3617 static int non_regular_fd
;
3618 static int non_regular_inserted
;
3619 static int non_regular_nbytes
;
3622 /* Read from a non-regular file.
3623 Read non_regular_trytry bytes max from non_regular_fd.
3624 Non_regular_inserted specifies where to put the read bytes.
3625 Value is the number of bytes read. */
3634 nbytes
= emacs_read (non_regular_fd
,
3635 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3636 non_regular_nbytes
);
3638 return make_number (nbytes
);
3642 /* Condition-case handler used when reading from non-regular files
3643 in insert-file-contents. */
3646 read_non_regular_quit ()
3652 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3654 doc
: /* Insert contents of file FILENAME after point.
3655 Returns list of absolute file name and number of characters inserted.
3656 If second argument VISIT is non-nil, the buffer's visited filename
3657 and last save file modtime are set, and it is marked unmodified.
3658 If visiting and the file does not exist, visiting is completed
3659 before the error is signaled.
3660 The optional third and fourth arguments BEG and END
3661 specify what portion of the file to insert.
3662 These arguments count bytes in the file, not characters in the buffer.
3663 If VISIT is non-nil, BEG and END must be nil.
3665 If optional fifth argument REPLACE is non-nil,
3666 it means replace the current buffer contents (in the accessible portion)
3667 with the file contents. This is better than simply deleting and inserting
3668 the whole thing because (1) it preserves some marker positions
3669 and (2) it puts less data in the undo list.
3670 When REPLACE is non-nil, the value is the number of characters actually read,
3671 which is often less than the number of characters to be read.
3673 This does code conversion according to the value of
3674 `coding-system-for-read' or `file-coding-system-alist',
3675 and sets the variable `last-coding-system-used' to the coding system
3677 (filename
, visit
, beg
, end
, replace
)
3678 Lisp_Object filename
, visit
, beg
, end
, replace
;
3683 register int how_much
;
3684 register int unprocessed
;
3685 int count
= SPECPDL_INDEX ();
3686 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3687 Lisp_Object handler
, val
, insval
, orig_filename
;
3690 int not_regular
= 0;
3691 unsigned char read_buf
[READ_BUF_SIZE
];
3692 struct coding_system coding
;
3693 unsigned char buffer
[1 << 14];
3694 int replace_handled
= 0;
3695 int set_coding_system
= 0;
3696 int coding_system_decided
= 0;
3699 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3700 error ("Cannot do file visiting in an indirect buffer");
3702 if (!NILP (current_buffer
->read_only
))
3703 Fbarf_if_buffer_read_only ();
3707 orig_filename
= Qnil
;
3709 GCPRO4 (filename
, val
, p
, orig_filename
);
3711 CHECK_STRING (filename
);
3712 filename
= Fexpand_file_name (filename
, Qnil
);
3714 /* If the file name has special constructs in it,
3715 call the corresponding file handler. */
3716 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3717 if (!NILP (handler
))
3719 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3720 visit
, beg
, end
, replace
);
3721 if (CONSP (val
) && CONSP (XCDR (val
)))
3722 inserted
= XINT (XCAR (XCDR (val
)));
3726 orig_filename
= filename
;
3727 filename
= ENCODE_FILE (filename
);
3733 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3735 /* Tell stat to use expensive method to get accurate info. */
3736 Vw32_get_true_file_attributes
= Qt
;
3737 total
= stat (SDATA (filename
), &st
);
3738 Vw32_get_true_file_attributes
= tem
;
3743 if (stat (SDATA (filename
), &st
) < 0)
3745 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3746 || fstat (fd
, &st
) < 0)
3747 #endif /* not APOLLO */
3748 #endif /* WINDOWSNT */
3750 if (fd
>= 0) emacs_close (fd
);
3753 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3756 if (!NILP (Vcoding_system_for_read
))
3757 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3762 /* This code will need to be changed in order to work on named
3763 pipes, and it's probably just not worth it. So we should at
3764 least signal an error. */
3765 if (!S_ISREG (st
.st_mode
))
3772 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3773 Fsignal (Qfile_error
,
3774 Fcons (build_string ("not a regular file"),
3775 Fcons (orig_filename
, Qnil
)));
3780 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3783 /* Replacement should preserve point as it preserves markers. */
3784 if (!NILP (replace
))
3785 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3787 record_unwind_protect (close_file_unwind
, make_number (fd
));
3789 /* Supposedly happens on VMS. */
3790 /* Can happen on any platform that uses long as type of off_t, but allows
3791 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3792 give a message suitable for the latter case. */
3793 if (! not_regular
&& st
.st_size
< 0)
3794 error ("Maximum buffer size exceeded");
3796 /* Prevent redisplay optimizations. */
3797 current_buffer
->clip_changed
= 1;
3801 if (!NILP (beg
) || !NILP (end
))
3802 error ("Attempt to visit less than an entire file");
3803 if (BEG
< Z
&& NILP (replace
))
3804 error ("Cannot do file visiting in a non-empty buffer");
3810 XSETFASTINT (beg
, 0);
3818 XSETINT (end
, st
.st_size
);
3820 /* Arithmetic overflow can occur if an Emacs integer cannot
3821 represent the file size, or if the calculations below
3822 overflow. The calculations below double the file size
3823 twice, so check that it can be multiplied by 4 safely. */
3824 if (XINT (end
) != st
.st_size
3825 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3826 error ("Maximum buffer size exceeded");
3828 /* The file size returned from stat may be zero, but data
3829 may be readable nonetheless, for example when this is a
3830 file in the /proc filesystem. */
3831 if (st
.st_size
== 0)
3832 XSETINT (end
, READ_BUF_SIZE
);
3836 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3838 /* We use emacs-mule for auto saving... */
3839 setup_coding_system (Qemacs_mule
, &coding
);
3840 /* ... but with the special flag to indicate to read in a
3841 multibyte sequence for eight-bit-control char as is. */
3843 coding
.src_multibyte
= 0;
3844 coding
.dst_multibyte
3845 = !NILP (current_buffer
->enable_multibyte_characters
);
3846 coding
.eol_type
= CODING_EOL_LF
;
3847 coding_system_decided
= 1;
3851 /* Decide the coding system to use for reading the file now
3852 because we can't use an optimized method for handling
3853 `coding:' tag if the current buffer is not empty. */
3857 if (!NILP (Vcoding_system_for_read
))
3858 val
= Vcoding_system_for_read
;
3861 /* Don't try looking inside a file for a coding system
3862 specification if it is not seekable. */
3863 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3865 /* Find a coding system specified in the heading two
3866 lines or in the tailing several lines of the file.
3867 We assume that the 1K-byte and 3K-byte for heading
3868 and tailing respectively are sufficient for this
3872 if (st
.st_size
<= (1024 * 4))
3873 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3876 nread
= emacs_read (fd
, read_buf
, 1024);
3879 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3880 report_file_error ("Setting file position",
3881 Fcons (orig_filename
, Qnil
));
3882 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3887 error ("IO error reading %s: %s",
3888 SDATA (orig_filename
), emacs_strerror (errno
));
3891 struct buffer
*prev
= current_buffer
;
3895 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3897 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3898 buf
= XBUFFER (buffer
);
3900 delete_all_overlays (buf
);
3901 buf
->directory
= current_buffer
->directory
;
3902 buf
->read_only
= Qnil
;
3903 buf
->filename
= Qnil
;
3904 buf
->undo_list
= Qt
;
3905 eassert (buf
->overlays_before
== NULL
);
3906 eassert (buf
->overlays_after
== NULL
);
3908 set_buffer_internal (buf
);
3910 buf
->enable_multibyte_characters
= Qnil
;
3912 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3913 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3914 val
= call2 (Vset_auto_coding_function
,
3915 filename
, make_number (nread
));
3916 set_buffer_internal (prev
);
3918 /* Discard the unwind protect for recovering the
3922 /* Rewind the file for the actual read done later. */
3923 if (lseek (fd
, 0, 0) < 0)
3924 report_file_error ("Setting file position",
3925 Fcons (orig_filename
, Qnil
));
3931 /* If we have not yet decided a coding system, check
3932 file-coding-system-alist. */
3933 Lisp_Object args
[6], coding_systems
;
3935 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3936 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3937 coding_systems
= Ffind_operation_coding_system (6, args
);
3938 if (CONSP (coding_systems
))
3939 val
= XCAR (coding_systems
);
3943 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3944 /* Ensure we set Vlast_coding_system_used. */
3945 set_coding_system
= 1;
3947 if (NILP (current_buffer
->enable_multibyte_characters
)
3949 /* We must suppress all character code conversion except for
3950 end-of-line conversion. */
3951 setup_raw_text_coding_system (&coding
);
3953 coding
.src_multibyte
= 0;
3954 coding
.dst_multibyte
3955 = !NILP (current_buffer
->enable_multibyte_characters
);
3956 coding_system_decided
= 1;
3959 /* If requested, replace the accessible part of the buffer
3960 with the file contents. Avoid replacing text at the
3961 beginning or end of the buffer that matches the file contents;
3962 that preserves markers pointing to the unchanged parts.
3964 Here we implement this feature in an optimized way
3965 for the case where code conversion is NOT needed.
3966 The following if-statement handles the case of conversion
3967 in a less optimal way.
3969 If the code conversion is "automatic" then we try using this
3970 method and hope for the best.
3971 But if we discover the need for conversion, we give up on this method
3972 and let the following if-statement handle the replace job. */
3975 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
3977 /* same_at_start and same_at_end count bytes,
3978 because file access counts bytes
3979 and BEG and END count bytes. */
3980 int same_at_start
= BEGV_BYTE
;
3981 int same_at_end
= ZV_BYTE
;
3983 /* There is still a possibility we will find the need to do code
3984 conversion. If that happens, we set this variable to 1 to
3985 give up on handling REPLACE in the optimized way. */
3986 int giveup_match_end
= 0;
3988 if (XINT (beg
) != 0)
3990 if (lseek (fd
, XINT (beg
), 0) < 0)
3991 report_file_error ("Setting file position",
3992 Fcons (orig_filename
, Qnil
));
3997 /* Count how many chars at the start of the file
3998 match the text at the beginning of the buffer. */
4003 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4005 error ("IO error reading %s: %s",
4006 SDATA (orig_filename
), emacs_strerror (errno
));
4007 else if (nread
== 0)
4010 if (coding
.type
== coding_type_undecided
)
4011 detect_coding (&coding
, buffer
, nread
);
4012 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
4013 /* We found that the file should be decoded somehow.
4014 Let's give up here. */
4016 giveup_match_end
= 1;
4020 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
4021 detect_eol (&coding
, buffer
, nread
);
4022 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
4023 && coding
.eol_type
!= CODING_EOL_LF
)
4024 /* We found that the format of eol should be decoded.
4025 Let's give up here. */
4027 giveup_match_end
= 1;
4032 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4033 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4034 same_at_start
++, bufpos
++;
4035 /* If we found a discrepancy, stop the scan.
4036 Otherwise loop around and scan the next bufferful. */
4037 if (bufpos
!= nread
)
4041 /* If the file matches the buffer completely,
4042 there's no need to replace anything. */
4043 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4047 /* Truncate the buffer to the size of the file. */
4048 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4053 /* Count how many chars at the end of the file
4054 match the text at the end of the buffer. But, if we have
4055 already found that decoding is necessary, don't waste time. */
4056 while (!giveup_match_end
)
4058 int total_read
, nread
, bufpos
, curpos
, trial
;
4060 /* At what file position are we now scanning? */
4061 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4062 /* If the entire file matches the buffer tail, stop the scan. */
4065 /* How much can we scan in the next step? */
4066 trial
= min (curpos
, sizeof buffer
);
4067 if (lseek (fd
, curpos
- trial
, 0) < 0)
4068 report_file_error ("Setting file position",
4069 Fcons (orig_filename
, Qnil
));
4071 total_read
= nread
= 0;
4072 while (total_read
< trial
)
4074 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4076 error ("IO error reading %s: %s",
4077 SDATA (orig_filename
), emacs_strerror (errno
));
4078 else if (nread
== 0)
4080 total_read
+= nread
;
4083 /* Scan this bufferful from the end, comparing with
4084 the Emacs buffer. */
4085 bufpos
= total_read
;
4087 /* Compare with same_at_start to avoid counting some buffer text
4088 as matching both at the file's beginning and at the end. */
4089 while (bufpos
> 0 && same_at_end
> same_at_start
4090 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4091 same_at_end
--, bufpos
--;
4093 /* If we found a discrepancy, stop the scan.
4094 Otherwise loop around and scan the preceding bufferful. */
4097 /* If this discrepancy is because of code conversion,
4098 we cannot use this method; giveup and try the other. */
4099 if (same_at_end
> same_at_start
4100 && FETCH_BYTE (same_at_end
- 1) >= 0200
4101 && ! NILP (current_buffer
->enable_multibyte_characters
)
4102 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4103 giveup_match_end
= 1;
4112 if (! giveup_match_end
)
4116 /* We win! We can handle REPLACE the optimized way. */
4118 /* Extend the start of non-matching text area to multibyte
4119 character boundary. */
4120 if (! NILP (current_buffer
->enable_multibyte_characters
))
4121 while (same_at_start
> BEGV_BYTE
4122 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4125 /* Extend the end of non-matching text area to multibyte
4126 character boundary. */
4127 if (! NILP (current_buffer
->enable_multibyte_characters
))
4128 while (same_at_end
< ZV_BYTE
4129 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4132 /* Don't try to reuse the same piece of text twice. */
4133 overlap
= (same_at_start
- BEGV_BYTE
4134 - (same_at_end
+ st
.st_size
- ZV
));
4136 same_at_end
+= overlap
;
4138 /* Arrange to read only the nonmatching middle part of the file. */
4139 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4140 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4142 del_range_byte (same_at_start
, same_at_end
, 0);
4143 /* Insert from the file at the proper position. */
4144 temp
= BYTE_TO_CHAR (same_at_start
);
4145 SET_PT_BOTH (temp
, same_at_start
);
4147 /* If display currently starts at beginning of line,
4148 keep it that way. */
4149 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4150 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4152 replace_handled
= 1;
4156 /* If requested, replace the accessible part of the buffer
4157 with the file contents. Avoid replacing text at the
4158 beginning or end of the buffer that matches the file contents;
4159 that preserves markers pointing to the unchanged parts.
4161 Here we implement this feature for the case where code conversion
4162 is needed, in a simple way that needs a lot of memory.
4163 The preceding if-statement handles the case of no conversion
4164 in a more optimized way. */
4165 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4167 int same_at_start
= BEGV_BYTE
;
4168 int same_at_end
= ZV_BYTE
;
4171 /* Make sure that the gap is large enough. */
4172 int bufsize
= 2 * st
.st_size
;
4173 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4176 /* First read the whole file, performing code conversion into
4177 CONVERSION_BUFFER. */
4179 if (lseek (fd
, XINT (beg
), 0) < 0)
4181 xfree (conversion_buffer
);
4182 report_file_error ("Setting file position",
4183 Fcons (orig_filename
, Qnil
));
4186 total
= st
.st_size
; /* Total bytes in the file. */
4187 how_much
= 0; /* Bytes read from file so far. */
4188 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4189 unprocessed
= 0; /* Bytes not processed in previous loop. */
4191 while (how_much
< total
)
4193 /* try is reserved in some compilers (Microsoft C) */
4194 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4195 unsigned char *destination
= read_buf
+ unprocessed
;
4198 /* Allow quitting out of the actual I/O. */
4201 this = emacs_read (fd
, destination
, trytry
);
4204 if (this < 0 || this + unprocessed
== 0)
4212 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4214 int require
, result
;
4216 this += unprocessed
;
4218 /* If we are using more space than estimated,
4219 make CONVERSION_BUFFER bigger. */
4220 require
= decoding_buffer_size (&coding
, this);
4221 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4223 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4224 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4227 /* Convert this batch with results in CONVERSION_BUFFER. */
4228 if (how_much
>= total
) /* This is the last block. */
4229 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4230 if (coding
.composing
!= COMPOSITION_DISABLED
)
4231 coding_allocate_composition_data (&coding
, BEGV
);
4232 result
= decode_coding (&coding
, read_buf
,
4233 conversion_buffer
+ inserted
,
4234 this, bufsize
- inserted
);
4236 /* Save for next iteration whatever we didn't convert. */
4237 unprocessed
= this - coding
.consumed
;
4238 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4239 if (!NILP (current_buffer
->enable_multibyte_characters
))
4240 this = coding
.produced
;
4242 this = str_as_unibyte (conversion_buffer
+ inserted
,
4249 /* At this point, INSERTED is how many characters (i.e. bytes)
4250 are present in CONVERSION_BUFFER.
4251 HOW_MUCH should equal TOTAL,
4252 or should be <= 0 if we couldn't read the file. */
4256 xfree (conversion_buffer
);
4257 coding_free_composition_data (&coding
);
4259 error ("IO error reading %s: %s",
4260 SDATA (orig_filename
), emacs_strerror (errno
));
4261 else if (how_much
== -2)
4262 error ("maximum buffer size exceeded");
4265 /* Compare the beginning of the converted file
4266 with the buffer text. */
4269 while (bufpos
< inserted
&& same_at_start
< same_at_end
4270 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4271 same_at_start
++, bufpos
++;
4273 /* If the file matches the buffer completely,
4274 there's no need to replace anything. */
4276 if (bufpos
== inserted
)
4278 xfree (conversion_buffer
);
4279 coding_free_composition_data (&coding
);
4282 /* Truncate the buffer to the size of the file. */
4283 del_range_byte (same_at_start
, same_at_end
, 0);
4288 /* Extend the start of non-matching text area to multibyte
4289 character boundary. */
4290 if (! NILP (current_buffer
->enable_multibyte_characters
))
4291 while (same_at_start
> BEGV_BYTE
4292 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4295 /* Scan this bufferful from the end, comparing with
4296 the Emacs buffer. */
4299 /* Compare with same_at_start to avoid counting some buffer text
4300 as matching both at the file's beginning and at the end. */
4301 while (bufpos
> 0 && same_at_end
> same_at_start
4302 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4303 same_at_end
--, bufpos
--;
4305 /* Extend the end of non-matching text area to multibyte
4306 character boundary. */
4307 if (! NILP (current_buffer
->enable_multibyte_characters
))
4308 while (same_at_end
< ZV_BYTE
4309 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4312 /* Don't try to reuse the same piece of text twice. */
4313 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4315 same_at_end
+= overlap
;
4317 /* If display currently starts at beginning of line,
4318 keep it that way. */
4319 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4320 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4322 /* Replace the chars that we need to replace,
4323 and update INSERTED to equal the number of bytes
4324 we are taking from the file. */
4325 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4327 if (same_at_end
!= same_at_start
)
4329 del_range_byte (same_at_start
, same_at_end
, 0);
4331 same_at_start
= GPT_BYTE
;
4335 temp
= BYTE_TO_CHAR (same_at_start
);
4337 /* Insert from the file at the proper position. */
4338 SET_PT_BOTH (temp
, same_at_start
);
4339 insert_1 (conversion_buffer
+ same_at_start
- BEGV_BYTE
, inserted
,
4341 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4342 coding_restore_composition (&coding
, Fcurrent_buffer ());
4343 coding_free_composition_data (&coding
);
4345 /* Set `inserted' to the number of inserted characters. */
4346 inserted
= PT
- temp
;
4348 xfree (conversion_buffer
);
4357 register Lisp_Object temp
;
4359 total
= XINT (end
) - XINT (beg
);
4361 /* Make sure point-max won't overflow after this insertion. */
4362 XSETINT (temp
, total
);
4363 if (total
!= XINT (temp
))
4364 error ("Maximum buffer size exceeded");
4367 /* For a special file, all we can do is guess. */
4368 total
= READ_BUF_SIZE
;
4370 if (NILP (visit
) && total
> 0)
4371 prepare_to_modify_buffer (PT
, PT
, NULL
);
4374 if (GAP_SIZE
< total
)
4375 make_gap (total
- GAP_SIZE
);
4377 if (XINT (beg
) != 0 || !NILP (replace
))
4379 if (lseek (fd
, XINT (beg
), 0) < 0)
4380 report_file_error ("Setting file position",
4381 Fcons (orig_filename
, Qnil
));
4384 /* In the following loop, HOW_MUCH contains the total bytes read so
4385 far for a regular file, and not changed for a special file. But,
4386 before exiting the loop, it is set to a negative value if I/O
4390 /* Total bytes inserted. */
4393 /* Here, we don't do code conversion in the loop. It is done by
4394 code_convert_region after all data are read into the buffer. */
4396 int gap_size
= GAP_SIZE
;
4398 while (how_much
< total
)
4400 /* try is reserved in some compilers (Microsoft C) */
4401 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4408 /* Maybe make more room. */
4409 if (gap_size
< trytry
)
4411 make_gap (total
- gap_size
);
4412 gap_size
= GAP_SIZE
;
4415 /* Read from the file, capturing `quit'. When an
4416 error occurs, end the loop, and arrange for a quit
4417 to be signaled after decoding the text we read. */
4418 non_regular_fd
= fd
;
4419 non_regular_inserted
= inserted
;
4420 non_regular_nbytes
= trytry
;
4421 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4422 read_non_regular_quit
);
4433 /* Allow quitting out of the actual I/O. We don't make text
4434 part of the buffer until all the reading is done, so a C-g
4435 here doesn't do any harm. */
4438 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4450 /* For a regular file, where TOTAL is the real size,
4451 count HOW_MUCH to compare with it.
4452 For a special file, where TOTAL is just a buffer size,
4453 so don't bother counting in HOW_MUCH.
4454 (INSERTED is where we count the number of characters inserted.) */
4461 /* Make the text read part of the buffer. */
4462 GAP_SIZE
-= inserted
;
4464 GPT_BYTE
+= inserted
;
4466 ZV_BYTE
+= inserted
;
4471 /* Put an anchor to ensure multi-byte form ends at gap. */
4476 /* Discard the unwind protect for closing the file. */
4480 error ("IO error reading %s: %s",
4481 SDATA (orig_filename
), emacs_strerror (errno
));
4485 if (! coding_system_decided
)
4487 /* The coding system is not yet decided. Decide it by an
4488 optimized method for handling `coding:' tag.
4490 Note that we can get here only if the buffer was empty
4491 before the insertion. */
4495 if (!NILP (Vcoding_system_for_read
))
4496 val
= Vcoding_system_for_read
;
4499 /* Since we are sure that the current buffer was empty
4500 before the insertion, we can toggle
4501 enable-multibyte-characters directly here without taking
4502 care of marker adjustment and byte combining problem. By
4503 this way, we can run Lisp program safely before decoding
4504 the inserted text. */
4505 Lisp_Object unwind_data
;
4506 int count
= SPECPDL_INDEX ();
4508 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4509 Fcons (current_buffer
->undo_list
,
4510 Fcurrent_buffer ()));
4511 current_buffer
->enable_multibyte_characters
= Qnil
;
4512 current_buffer
->undo_list
= Qt
;
4513 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4515 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4517 val
= call2 (Vset_auto_coding_function
,
4518 filename
, make_number (inserted
));
4523 /* If the coding system is not yet decided, check
4524 file-coding-system-alist. */
4525 Lisp_Object args
[6], coding_systems
;
4527 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4528 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4529 coding_systems
= Ffind_operation_coding_system (6, args
);
4530 if (CONSP (coding_systems
))
4531 val
= XCAR (coding_systems
);
4533 unbind_to (count
, Qnil
);
4534 inserted
= Z_BYTE
- BEG_BYTE
;
4537 /* The following kludgy code is to avoid some compiler bug.
4539 setup_coding_system (val, &coding);
4542 struct coding_system temp_coding
;
4543 setup_coding_system (Fcheck_coding_system (val
), &temp_coding
);
4544 bcopy (&temp_coding
, &coding
, sizeof coding
);
4546 /* Ensure we set Vlast_coding_system_used. */
4547 set_coding_system
= 1;
4549 if (NILP (current_buffer
->enable_multibyte_characters
)
4551 /* We must suppress all character code conversion except for
4552 end-of-line conversion. */
4553 setup_raw_text_coding_system (&coding
);
4554 coding
.src_multibyte
= 0;
4555 coding
.dst_multibyte
4556 = !NILP (current_buffer
->enable_multibyte_characters
);
4560 /* Can't do this if part of the buffer might be preserved. */
4562 && (coding
.type
== coding_type_no_conversion
4563 || coding
.type
== coding_type_raw_text
))
4565 /* Visiting a file with these coding system makes the buffer
4567 current_buffer
->enable_multibyte_characters
= Qnil
;
4568 coding
.dst_multibyte
= 0;
4571 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4573 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4575 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4577 inserted
= coding
.produced_char
;
4580 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4584 /* Now INSERTED is measured in characters. */
4587 /* Use the conversion type to determine buffer-file-type
4588 (find-buffer-file-type is now used to help determine the
4590 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4591 || coding
.eol_type
== CODING_EOL_LF
)
4592 && ! CODING_REQUIRE_DECODING (&coding
))
4593 current_buffer
->buffer_file_type
= Qt
;
4595 current_buffer
->buffer_file_type
= Qnil
;
4602 if (!EQ (current_buffer
->undo_list
, Qt
))
4603 current_buffer
->undo_list
= Qnil
;
4605 stat (SDATA (filename
), &st
);
4610 current_buffer
->modtime
= st
.st_mtime
;
4611 current_buffer
->filename
= orig_filename
;
4614 SAVE_MODIFF
= MODIFF
;
4615 current_buffer
->auto_save_modified
= MODIFF
;
4616 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4617 #ifdef CLASH_DETECTION
4620 if (!NILP (current_buffer
->file_truename
))
4621 unlock_file (current_buffer
->file_truename
);
4622 unlock_file (filename
);
4624 #endif /* CLASH_DETECTION */
4626 Fsignal (Qfile_error
,
4627 Fcons (build_string ("not a regular file"),
4628 Fcons (orig_filename
, Qnil
)));
4631 if (set_coding_system
)
4632 Vlast_coding_system_used
= coding
.symbol
;
4634 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4636 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4638 if (! NILP (insval
))
4640 CHECK_NUMBER (insval
);
4641 inserted
= XFASTINT (insval
);
4645 /* Decode file format */
4648 int empty_undo_list_p
= 0;
4650 /* If we're anyway going to discard undo information, don't
4651 record it in the first place. The buffer's undo list at this
4652 point is either nil or t when visiting a file. */
4655 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4656 current_buffer
->undo_list
= Qt
;
4659 insval
= call3 (Qformat_decode
,
4660 Qnil
, make_number (inserted
), visit
);
4661 CHECK_NUMBER (insval
);
4662 inserted
= XFASTINT (insval
);
4665 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4668 /* Call after-change hooks for the inserted text, aside from the case
4669 of normal visiting (not with REPLACE), which is done in a new buffer
4670 "before" the buffer is changed. */
4671 if (inserted
> 0 && total
> 0
4672 && (NILP (visit
) || !NILP (replace
)))
4674 signal_after_change (PT
, 0, inserted
);
4675 update_compositions (PT
, PT
, CHECK_BORDER
);
4678 p
= Vafter_insert_file_functions
;
4681 insval
= call1 (XCAR (p
), make_number (inserted
));
4684 CHECK_NUMBER (insval
);
4685 inserted
= XFASTINT (insval
);
4692 && current_buffer
->modtime
== -1)
4694 /* If visiting nonexistent file, return nil. */
4695 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4699 Fsignal (Qquit
, Qnil
);
4701 /* ??? Retval needs to be dealt with in all cases consistently. */
4703 val
= Fcons (orig_filename
,
4704 Fcons (make_number (inserted
),
4707 RETURN_UNGCPRO (unbind_to (count
, val
));
4710 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4711 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4712 Lisp_Object
, Lisp_Object
));
4714 /* If build_annotations switched buffers, switch back to BUF.
4715 Kill the temporary buffer that was selected in the meantime.
4717 Since this kill only the last temporary buffer, some buffers remain
4718 not killed if build_annotations switched buffers more than once.
4722 build_annotations_unwind (buf
)
4727 if (XBUFFER (buf
) == current_buffer
)
4729 tembuf
= Fcurrent_buffer ();
4731 Fkill_buffer (tembuf
);
4735 /* Decide the coding-system to encode the data with. */
4738 choose_write_coding_system (start
, end
, filename
,
4739 append
, visit
, lockname
, coding
)
4740 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4741 struct coding_system
*coding
;
4746 && NILP (Fstring_equal (current_buffer
->filename
,
4747 current_buffer
->auto_save_file_name
)))
4749 /* We use emacs-mule for auto saving... */
4750 setup_coding_system (Qemacs_mule
, coding
);
4751 /* ... but with the special flag to indicate not to strip off
4752 leading code of eight-bit-control chars. */
4754 goto done_setup_coding
;
4756 else if (!NILP (Vcoding_system_for_write
))
4758 val
= Vcoding_system_for_write
;
4759 if (coding_system_require_warning
4760 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4761 /* Confirm that VAL can surely encode the current region. */
4762 val
= call5 (Vselect_safe_coding_system_function
,
4763 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4768 /* If the variable `buffer-file-coding-system' is set locally,
4769 it means that the file was read with some kind of code
4770 conversion or the variable is explicitly set by users. We
4771 had better write it out with the same coding system even if
4772 `enable-multibyte-characters' is nil.
4774 If it is not set locally, we anyway have to convert EOL
4775 format if the default value of `buffer-file-coding-system'
4776 tells that it is not Unix-like (LF only) format. */
4777 int using_default_coding
= 0;
4778 int force_raw_text
= 0;
4780 val
= current_buffer
->buffer_file_coding_system
;
4782 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4785 if (NILP (current_buffer
->enable_multibyte_characters
))
4791 /* Check file-coding-system-alist. */
4792 Lisp_Object args
[7], coding_systems
;
4794 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4795 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4797 coding_systems
= Ffind_operation_coding_system (7, args
);
4798 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4799 val
= XCDR (coding_systems
);
4803 && !NILP (current_buffer
->buffer_file_coding_system
))
4805 /* If we still have not decided a coding system, use the
4806 default value of buffer-file-coding-system. */
4807 val
= current_buffer
->buffer_file_coding_system
;
4808 using_default_coding
= 1;
4812 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4813 /* Confirm that VAL can surely encode the current region. */
4814 val
= call5 (Vselect_safe_coding_system_function
,
4815 start
, end
, val
, Qnil
, filename
);
4817 setup_coding_system (Fcheck_coding_system (val
), coding
);
4818 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4819 && !using_default_coding
)
4821 if (! EQ (default_buffer_file_coding
.symbol
,
4822 buffer_defaults
.buffer_file_coding_system
))
4823 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4824 &default_buffer_file_coding
);
4825 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4827 Lisp_Object subsidiaries
;
4829 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4830 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4831 if (VECTORP (subsidiaries
)
4832 && XVECTOR (subsidiaries
)->size
== 3)
4834 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4839 setup_raw_text_coding_system (coding
);
4840 goto done_setup_coding
;
4843 setup_coding_system (Fcheck_coding_system (val
), coding
);
4846 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4847 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4850 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4851 "r\nFWrite region to file: \ni\ni\ni\np",
4852 doc
: /* Write current region into specified file.
4853 When called from a program, requires three arguments:
4854 START, END and FILENAME. START and END are normally buffer positions
4855 specifying the part of the buffer to write.
4856 If START is nil, that means to use the entire buffer contents.
4857 If START is a string, then output that string to the file
4858 instead of any buffer contents; END is ignored.
4860 Optional fourth argument APPEND if non-nil means
4861 append to existing file contents (if any). If it is an integer,
4862 seek to that offset in the file before writing.
4863 Optional fifth argument VISIT, if t or a string, means
4864 set the last-save-file-modtime of buffer to this file's modtime
4865 and mark buffer not modified.
4866 If VISIT is a string, it is a second file name;
4867 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4868 VISIT is also the file name to lock and unlock for clash detection.
4869 If VISIT is neither t nor nil nor a string,
4870 that means do not display the \"Wrote file\" message.
4871 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4872 use for locking and unlocking, overriding FILENAME and VISIT.
4873 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4874 for an existing file with the same name. If MUSTBENEW is `excl',
4875 that means to get an error if the file already exists; never overwrite.
4876 If MUSTBENEW is neither nil nor `excl', that means ask for
4877 confirmation before overwriting, but do go ahead and overwrite the file
4878 if the user confirms.
4880 This does code conversion according to the value of
4881 `coding-system-for-write', `buffer-file-coding-system', or
4882 `file-coding-system-alist', and sets the variable
4883 `last-coding-system-used' to the coding system actually used. */)
4884 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4885 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4890 const unsigned char *fn
;
4893 int count
= SPECPDL_INDEX ();
4896 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4898 Lisp_Object handler
;
4899 Lisp_Object visit_file
;
4900 Lisp_Object annotations
;
4901 Lisp_Object encoded_filename
;
4902 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4903 int quietly
= !NILP (visit
);
4904 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4905 struct buffer
*given_buffer
;
4907 int buffer_file_type
= O_BINARY
;
4909 struct coding_system coding
;
4911 if (current_buffer
->base_buffer
&& visiting
)
4912 error ("Cannot do file visiting in an indirect buffer");
4914 if (!NILP (start
) && !STRINGP (start
))
4915 validate_region (&start
, &end
);
4917 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4919 filename
= Fexpand_file_name (filename
, Qnil
);
4921 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4922 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4924 if (STRINGP (visit
))
4925 visit_file
= Fexpand_file_name (visit
, Qnil
);
4927 visit_file
= filename
;
4929 if (NILP (lockname
))
4930 lockname
= visit_file
;
4934 /* If the file name has special constructs in it,
4935 call the corresponding file handler. */
4936 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4937 /* If FILENAME has no handler, see if VISIT has one. */
4938 if (NILP (handler
) && STRINGP (visit
))
4939 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4941 if (!NILP (handler
))
4944 val
= call6 (handler
, Qwrite_region
, start
, end
,
4945 filename
, append
, visit
);
4949 SAVE_MODIFF
= MODIFF
;
4950 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4951 current_buffer
->filename
= visit_file
;
4957 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4959 /* Special kludge to simplify auto-saving. */
4962 XSETFASTINT (start
, BEG
);
4963 XSETFASTINT (end
, Z
);
4967 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4968 count1
= SPECPDL_INDEX ();
4970 given_buffer
= current_buffer
;
4972 if (!STRINGP (start
))
4974 annotations
= build_annotations (start
, end
);
4976 if (current_buffer
!= given_buffer
)
4978 XSETFASTINT (start
, BEGV
);
4979 XSETFASTINT (end
, ZV
);
4985 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4987 /* Decide the coding-system to encode the data with.
4988 We used to make this choice before calling build_annotations, but that
4989 leads to problems when a write-annotate-function takes care of
4990 unsavable chars (as was the case with X-Symbol). */
4991 choose_write_coding_system (start
, end
, filename
,
4992 append
, visit
, lockname
, &coding
);
4993 Vlast_coding_system_used
= coding
.symbol
;
4995 given_buffer
= current_buffer
;
4996 if (! STRINGP (start
))
4998 annotations
= build_annotations_2 (start
, end
,
4999 coding
.pre_write_conversion
, annotations
);
5000 if (current_buffer
!= given_buffer
)
5002 XSETFASTINT (start
, BEGV
);
5003 XSETFASTINT (end
, ZV
);
5007 #ifdef CLASH_DETECTION
5010 #if 0 /* This causes trouble for GNUS. */
5011 /* If we've locked this file for some other buffer,
5012 query before proceeding. */
5013 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5014 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5017 lock_file (lockname
);
5019 #endif /* CLASH_DETECTION */
5021 encoded_filename
= ENCODE_FILE (filename
);
5023 fn
= SDATA (encoded_filename
);
5027 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5028 #else /* not DOS_NT */
5029 desc
= emacs_open (fn
, O_WRONLY
, 0);
5030 #endif /* not DOS_NT */
5032 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5034 if (auto_saving
) /* Overwrite any previous version of autosave file */
5036 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5037 desc
= emacs_open (fn
, O_RDWR
, 0);
5039 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5040 ? SDATA (current_buffer
->filename
) : 0,
5043 else /* Write to temporary name and rename if no errors */
5045 Lisp_Object temp_name
;
5046 temp_name
= Ffile_name_directory (filename
);
5048 if (!NILP (temp_name
))
5050 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5051 build_string ("$$SAVE$$")));
5052 fname
= SDATA (filename
);
5053 fn
= SDATA (temp_name
);
5054 desc
= creat_copy_attrs (fname
, fn
);
5057 /* If we can't open the temporary file, try creating a new
5058 version of the original file. VMS "creat" creates a
5059 new version rather than truncating an existing file. */
5062 desc
= creat (fn
, 0666);
5063 #if 0 /* This can clobber an existing file and fail to replace it,
5064 if the user runs out of space. */
5067 /* We can't make a new version;
5068 try to truncate and rewrite existing version if any. */
5070 desc
= emacs_open (fn
, O_RDWR
, 0);
5076 desc
= creat (fn
, 0666);
5080 desc
= emacs_open (fn
,
5081 O_WRONLY
| O_CREAT
| buffer_file_type
5082 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5083 S_IREAD
| S_IWRITE
);
5084 #else /* not DOS_NT */
5085 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5086 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5087 auto_saving
? auto_save_mode_bits
: 0666);
5088 #endif /* not DOS_NT */
5089 #endif /* not VMS */
5093 #ifdef CLASH_DETECTION
5095 if (!auto_saving
) unlock_file (lockname
);
5097 #endif /* CLASH_DETECTION */
5099 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5102 record_unwind_protect (close_file_unwind
, make_number (desc
));
5104 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5108 if (NUMBERP (append
))
5109 ret
= lseek (desc
, XINT (append
), 1);
5111 ret
= lseek (desc
, 0, 2);
5114 #ifdef CLASH_DETECTION
5115 if (!auto_saving
) unlock_file (lockname
);
5116 #endif /* CLASH_DETECTION */
5118 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5126 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5127 * if we do writes that don't end with a carriage return. Furthermore
5128 * it cannot handle writes of more then 16K. The modified
5129 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5130 * this EXCEPT for the last record (iff it doesn't end with a carriage
5131 * return). This implies that if your buffer doesn't end with a carriage
5132 * return, you get one free... tough. However it also means that if
5133 * we make two calls to sys_write (a la the following code) you can
5134 * get one at the gap as well. The easiest way to fix this (honest)
5135 * is to move the gap to the next newline (or the end of the buffer).
5140 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5141 move_gap (find_next_newline (GPT
, 1));
5143 /* Whether VMS or not, we must move the gap to the next of newline
5144 when we must put designation sequences at beginning of line. */
5145 if (INTEGERP (start
)
5146 && coding
.type
== coding_type_iso2022
5147 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5148 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5150 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5151 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5152 move_gap_both (PT
, PT_BYTE
);
5153 SET_PT_BOTH (opoint
, opoint_byte
);
5160 if (STRINGP (start
))
5162 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5163 &annotations
, &coding
);
5166 else if (XINT (start
) != XINT (end
))
5168 tem
= CHAR_TO_BYTE (XINT (start
));
5170 if (XINT (start
) < GPT
)
5172 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5173 min (GPT
, XINT (end
)) - XINT (start
),
5174 &annotations
, &coding
);
5178 if (XINT (end
) > GPT
&& !failure
)
5180 tem
= max (XINT (start
), GPT
);
5181 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5182 &annotations
, &coding
);
5188 /* If file was empty, still need to write the annotations */
5189 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5190 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5194 if (CODING_REQUIRE_FLUSHING (&coding
)
5195 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5198 /* We have to flush out a data. */
5199 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5200 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5207 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5208 Disk full in NFS may be reported here. */
5209 /* mib says that closing the file will try to write as fast as NFS can do
5210 it, and that means the fsync here is not crucial for autosave files. */
5211 if (!auto_saving
&& fsync (desc
) < 0)
5213 /* If fsync fails with EINTR, don't treat that as serious. */
5215 failure
= 1, save_errno
= errno
;
5219 /* Spurious "file has changed on disk" warnings have been
5220 observed on Suns as well.
5221 It seems that `close' can change the modtime, under nfs.
5223 (This has supposedly been fixed in Sunos 4,
5224 but who knows about all the other machines with NFS?) */
5227 /* On VMS and APOLLO, must do the stat after the close
5228 since closing changes the modtime. */
5231 /* Recall that #if defined does not work on VMS. */
5238 /* NFS can report a write failure now. */
5239 if (emacs_close (desc
) < 0)
5240 failure
= 1, save_errno
= errno
;
5243 /* If we wrote to a temporary name and had no errors, rename to real name. */
5247 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5255 /* Discard the unwind protect for close_file_unwind. */
5256 specpdl_ptr
= specpdl
+ count1
;
5257 /* Restore the original current buffer. */
5258 visit_file
= unbind_to (count
, visit_file
);
5260 #ifdef CLASH_DETECTION
5262 unlock_file (lockname
);
5263 #endif /* CLASH_DETECTION */
5265 /* Do this before reporting IO error
5266 to avoid a "file has changed on disk" warning on
5267 next attempt to save. */
5269 current_buffer
->modtime
= st
.st_mtime
;
5272 error ("IO error writing %s: %s", SDATA (filename
),
5273 emacs_strerror (save_errno
));
5277 SAVE_MODIFF
= MODIFF
;
5278 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5279 current_buffer
->filename
= visit_file
;
5280 update_mode_lines
++;
5285 && ! NILP (Fstring_equal (current_buffer
->filename
,
5286 current_buffer
->auto_save_file_name
)))
5287 SAVE_MODIFF
= MODIFF
;
5293 message_with_string ((INTEGERP (append
)
5303 Lisp_Object
merge ();
5305 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5306 doc
: /* Return t if (car A) is numerically less than (car B). */)
5310 return Flss (Fcar (a
), Fcar (b
));
5313 /* Build the complete list of annotations appropriate for writing out
5314 the text between START and END, by calling all the functions in
5315 write-region-annotate-functions and merging the lists they return.
5316 If one of these functions switches to a different buffer, we assume
5317 that buffer contains altered text. Therefore, the caller must
5318 make sure to restore the current buffer in all cases,
5319 as save-excursion would do. */
5322 build_annotations (start
, end
)
5323 Lisp_Object start
, end
;
5325 Lisp_Object annotations
;
5327 struct gcpro gcpro1
, gcpro2
;
5328 Lisp_Object original_buffer
;
5329 int i
, used_global
= 0;
5331 XSETBUFFER (original_buffer
, current_buffer
);
5334 p
= Vwrite_region_annotate_functions
;
5335 GCPRO2 (annotations
, p
);
5338 struct buffer
*given_buffer
= current_buffer
;
5339 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5340 { /* Use the global value of the hook. */
5343 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5345 p
= Fappend (2, arg
);
5348 Vwrite_region_annotations_so_far
= annotations
;
5349 res
= call2 (XCAR (p
), start
, end
);
5350 /* If the function makes a different buffer current,
5351 assume that means this buffer contains altered text to be output.
5352 Reset START and END from the buffer bounds
5353 and discard all previous annotations because they should have
5354 been dealt with by this function. */
5355 if (current_buffer
!= given_buffer
)
5357 XSETFASTINT (start
, BEGV
);
5358 XSETFASTINT (end
, ZV
);
5361 Flength (res
); /* Check basic validity of return value */
5362 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5366 /* Now do the same for annotation functions implied by the file-format */
5367 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
5368 p
= current_buffer
->auto_save_file_format
;
5370 p
= current_buffer
->file_format
;
5371 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5373 struct buffer
*given_buffer
= current_buffer
;
5375 Vwrite_region_annotations_so_far
= annotations
;
5377 /* Value is either a list of annotations or nil if the function
5378 has written annotations to a temporary buffer, which is now
5380 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5381 original_buffer
, make_number (i
));
5382 if (current_buffer
!= given_buffer
)
5384 XSETFASTINT (start
, BEGV
);
5385 XSETFASTINT (end
, ZV
);
5390 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5398 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5399 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5401 struct gcpro gcpro1
;
5404 GCPRO1 (annotations
);
5405 /* At last, do the same for the function PRE_WRITE_CONVERSION
5406 implied by the current coding-system. */
5407 if (!NILP (pre_write_conversion
))
5409 struct buffer
*given_buffer
= current_buffer
;
5410 Vwrite_region_annotations_so_far
= annotations
;
5411 res
= call2 (pre_write_conversion
, start
, end
);
5413 annotations
= (current_buffer
!= given_buffer
5415 : merge (annotations
, res
, Qcar_less_than_car
));
5422 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5423 If STRING is nil, POS is the character position in the current buffer.
5424 Intersperse with them the annotations from *ANNOT
5425 which fall within the range of POS to POS + NCHARS,
5426 each at its appropriate position.
5428 We modify *ANNOT by discarding elements as we use them up.
5430 The return value is negative in case of system call failure. */
5433 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5436 register int nchars
;
5439 struct coding_system
*coding
;
5443 int lastpos
= pos
+ nchars
;
5445 while (NILP (*annot
) || CONSP (*annot
))
5447 tem
= Fcar_safe (Fcar (*annot
));
5450 nextpos
= XFASTINT (tem
);
5452 /* If there are no more annotations in this range,
5453 output the rest of the range all at once. */
5454 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5455 return e_write (desc
, string
, pos
, lastpos
, coding
);
5457 /* Output buffer text up to the next annotation's position. */
5460 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5464 /* Output the annotation. */
5465 tem
= Fcdr (Fcar (*annot
));
5468 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5471 *annot
= Fcdr (*annot
);
5476 #ifndef WRITE_BUF_SIZE
5477 #define WRITE_BUF_SIZE (16 * 1024)
5480 /* Write text in the range START and END into descriptor DESC,
5481 encoding them with coding system CODING. If STRING is nil, START
5482 and END are character positions of the current buffer, else they
5483 are indexes to the string STRING. */
5486 e_write (desc
, string
, start
, end
, coding
)
5490 struct coding_system
*coding
;
5492 register char *addr
;
5493 register int nbytes
;
5494 char buf
[WRITE_BUF_SIZE
];
5498 coding
->composing
= COMPOSITION_DISABLED
;
5499 if (coding
->composing
!= COMPOSITION_DISABLED
)
5500 coding_save_composition (coding
, start
, end
, string
);
5502 if (STRINGP (string
))
5504 addr
= SDATA (string
);
5505 nbytes
= SBYTES (string
);
5506 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5508 else if (start
< end
)
5510 /* It is assured that the gap is not in the range START and END-1. */
5511 addr
= CHAR_POS_ADDR (start
);
5512 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5513 coding
->src_multibyte
5514 = !NILP (current_buffer
->enable_multibyte_characters
);
5520 coding
->src_multibyte
= 1;
5523 /* We used to have a code for handling selective display here. But,
5524 now it is handled within encode_coding. */
5529 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5530 if (coding
->produced
> 0)
5532 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5533 if (coding
->produced
)
5539 nbytes
-= coding
->consumed
;
5540 addr
+= coding
->consumed
;
5541 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5544 /* The source text ends by an incomplete multibyte form.
5545 There's no way other than write it out as is. */
5546 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5555 start
+= coding
->consumed_char
;
5556 if (coding
->cmp_data
)
5557 coding_adjust_composition_offset (coding
, start
);
5560 if (coding
->cmp_data
)
5561 coding_free_composition_data (coding
);
5566 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5567 Sverify_visited_file_modtime
, 1, 1, 0,
5568 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5569 This means that the file has not been changed since it was visited or saved.
5570 See Info node `(elisp)Modification Time' for more details. */)
5576 Lisp_Object handler
;
5577 Lisp_Object filename
;
5582 if (!STRINGP (b
->filename
)) return Qt
;
5583 if (b
->modtime
== 0) return Qt
;
5585 /* If the file name has special constructs in it,
5586 call the corresponding file handler. */
5587 handler
= Ffind_file_name_handler (b
->filename
,
5588 Qverify_visited_file_modtime
);
5589 if (!NILP (handler
))
5590 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5592 filename
= ENCODE_FILE (b
->filename
);
5594 if (stat (SDATA (filename
), &st
) < 0)
5596 /* If the file doesn't exist now and didn't exist before,
5597 we say that it isn't modified, provided the error is a tame one. */
5598 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5603 if (st
.st_mtime
== b
->modtime
5604 /* If both are positive, accept them if they are off by one second. */
5605 || (st
.st_mtime
> 0 && b
->modtime
> 0
5606 && (st
.st_mtime
== b
->modtime
+ 1
5607 || st
.st_mtime
== b
->modtime
- 1)))
5612 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5613 Sclear_visited_file_modtime
, 0, 0, 0,
5614 doc
: /* Clear out records of last mod time of visited file.
5615 Next attempt to save will certainly not complain of a discrepancy. */)
5618 current_buffer
->modtime
= 0;
5622 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5623 Svisited_file_modtime
, 0, 0, 0,
5624 doc
: /* Return the current buffer's recorded visited file modification time.
5625 The value is a list of the form (HIGH LOW), like the time values
5626 that `file-attributes' returns. If the current buffer has no recorded
5627 file modification time, this function returns 0.
5628 See Info node `(elisp)Modification Time' for more details. */)
5632 tcons
= long_to_cons ((unsigned long) current_buffer
->modtime
);
5634 return list2 (XCAR (tcons
), XCDR (tcons
));
5638 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5639 Sset_visited_file_modtime
, 0, 1, 0,
5640 doc
: /* Update buffer's recorded modification time from the visited file's time.
5641 Useful if the buffer was not read from the file normally
5642 or if the file itself has been changed for some known benign reason.
5643 An argument specifies the modification time value to use
5644 \(instead of that of the visited file), in the form of a list
5645 \(HIGH . LOW) or (HIGH LOW). */)
5647 Lisp_Object time_list
;
5649 if (!NILP (time_list
))
5650 current_buffer
->modtime
= cons_to_long (time_list
);
5653 register Lisp_Object filename
;
5655 Lisp_Object handler
;
5657 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5659 /* If the file name has special constructs in it,
5660 call the corresponding file handler. */
5661 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5662 if (!NILP (handler
))
5663 /* The handler can find the file name the same way we did. */
5664 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5666 filename
= ENCODE_FILE (filename
);
5668 if (stat (SDATA (filename
), &st
) >= 0)
5669 current_buffer
->modtime
= st
.st_mtime
;
5676 auto_save_error (error
)
5679 Lisp_Object args
[3], msg
;
5681 struct gcpro gcpro1
;
5685 args
[0] = build_string ("Auto-saving %s: %s");
5686 args
[1] = current_buffer
->name
;
5687 args
[2] = Ferror_message_string (error
);
5688 msg
= Fformat (3, args
);
5690 nbytes
= SBYTES (msg
);
5692 for (i
= 0; i
< 3; ++i
)
5695 message2 (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5697 message2_nolog (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5698 Fsleep_for (make_number (1), Qnil
);
5711 auto_save_mode_bits
= 0666;
5713 /* Get visited file's mode to become the auto save file's mode. */
5714 if (! NILP (current_buffer
->filename
))
5716 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5717 /* But make sure we can overwrite it later! */
5718 auto_save_mode_bits
= st
.st_mode
| 0600;
5719 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5721 /* Remote files don't cooperate with stat. */
5722 auto_save_mode_bits
= XINT (modes
) | 0600;
5726 Fwrite_region (Qnil
, Qnil
,
5727 current_buffer
->auto_save_file_name
,
5728 Qnil
, Qlambda
, Qnil
, Qnil
);
5732 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5737 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5738 | XFASTINT (XCDR (stream
))));
5743 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5746 minibuffer_auto_raise
= XINT (value
);
5751 do_auto_save_make_dir (dir
)
5754 return call2 (Qmake_directory
, dir
, Qt
);
5758 do_auto_save_eh (ignore
)
5764 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5765 doc
: /* Auto-save all buffers that need it.
5766 This is all buffers that have auto-saving enabled
5767 and are changed since last auto-saved.
5768 Auto-saving writes the buffer into a file
5769 so that your editing is not lost if the system crashes.
5770 This file is not the file you visited; that changes only when you save.
5771 Normally we run the normal hook `auto-save-hook' before saving.
5773 A non-nil NO-MESSAGE argument means do not print any message if successful.
5774 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5775 (no_message
, current_only
)
5776 Lisp_Object no_message
, current_only
;
5778 struct buffer
*old
= current_buffer
, *b
;
5779 Lisp_Object tail
, buf
;
5781 int do_handled_files
;
5784 Lisp_Object lispstream
;
5785 int count
= SPECPDL_INDEX ();
5786 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5787 int old_message_p
= 0;
5788 struct gcpro gcpro1
, gcpro2
;
5790 if (max_specpdl_size
< specpdl_size
+ 40)
5791 max_specpdl_size
= specpdl_size
+ 40;
5796 if (NILP (no_message
))
5798 old_message_p
= push_message ();
5799 record_unwind_protect (pop_message_unwind
, Qnil
);
5802 /* Ordinarily don't quit within this function,
5803 but don't make it impossible to quit (in case we get hung in I/O). */
5807 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5808 point to non-strings reached from Vbuffer_alist. */
5810 if (!NILP (Vrun_hooks
))
5811 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5813 if (STRINGP (Vauto_save_list_file_name
))
5815 Lisp_Object listfile
;
5817 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5819 /* Don't try to create the directory when shutting down Emacs,
5820 because creating the directory might signal an error, and
5821 that would leave Emacs in a strange state. */
5822 if (!NILP (Vrun_hooks
))
5826 GCPRO2 (dir
, listfile
);
5827 dir
= Ffile_name_directory (listfile
);
5828 if (NILP (Ffile_directory_p (dir
)))
5829 internal_condition_case_1 (do_auto_save_make_dir
,
5830 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5835 stream
= fopen (SDATA (listfile
), "w");
5838 /* Arrange to close that file whether or not we get an error.
5839 Also reset auto_saving to 0. */
5840 lispstream
= Fcons (Qnil
, Qnil
);
5841 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
5842 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
5853 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5854 record_unwind_protect (do_auto_save_unwind_1
,
5855 make_number (minibuffer_auto_raise
));
5856 minibuffer_auto_raise
= 0;
5859 /* On first pass, save all files that don't have handlers.
5860 On second pass, save all files that do have handlers.
5862 If Emacs is crashing, the handlers may tweak what is causing
5863 Emacs to crash in the first place, and it would be a shame if
5864 Emacs failed to autosave perfectly ordinary files because it
5865 couldn't handle some ange-ftp'd file. */
5867 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5868 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5870 buf
= XCDR (XCAR (tail
));
5873 /* Record all the buffers that have auto save mode
5874 in the special file that lists them. For each of these buffers,
5875 Record visited name (if any) and auto save name. */
5876 if (STRINGP (b
->auto_save_file_name
)
5877 && stream
!= NULL
&& do_handled_files
== 0)
5879 if (!NILP (b
->filename
))
5881 fwrite (SDATA (b
->filename
), 1,
5882 SBYTES (b
->filename
), stream
);
5884 putc ('\n', stream
);
5885 fwrite (SDATA (b
->auto_save_file_name
), 1,
5886 SBYTES (b
->auto_save_file_name
), stream
);
5887 putc ('\n', stream
);
5890 if (!NILP (current_only
)
5891 && b
!= current_buffer
)
5894 /* Don't auto-save indirect buffers.
5895 The base buffer takes care of it. */
5899 /* Check for auto save enabled
5900 and file changed since last auto save
5901 and file changed since last real save. */
5902 if (STRINGP (b
->auto_save_file_name
)
5903 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5904 && b
->auto_save_modified
< BUF_MODIFF (b
)
5905 /* -1 means we've turned off autosaving for a while--see below. */
5906 && XINT (b
->save_length
) >= 0
5907 && (do_handled_files
5908 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5911 EMACS_TIME before_time
, after_time
;
5913 EMACS_GET_TIME (before_time
);
5915 /* If we had a failure, don't try again for 20 minutes. */
5916 if (b
->auto_save_failure_time
>= 0
5917 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5920 if ((XFASTINT (b
->save_length
) * 10
5921 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5922 /* A short file is likely to change a large fraction;
5923 spare the user annoying messages. */
5924 && XFASTINT (b
->save_length
) > 5000
5925 /* These messages are frequent and annoying for `*mail*'. */
5926 && !EQ (b
->filename
, Qnil
)
5927 && NILP (no_message
))
5929 /* It has shrunk too much; turn off auto-saving here. */
5930 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5931 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5933 minibuffer_auto_raise
= 0;
5934 /* Turn off auto-saving until there's a real save,
5935 and prevent any more warnings. */
5936 XSETINT (b
->save_length
, -1);
5937 Fsleep_for (make_number (1), Qnil
);
5940 set_buffer_internal (b
);
5941 if (!auto_saved
&& NILP (no_message
))
5942 message1 ("Auto-saving...");
5943 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5945 b
->auto_save_modified
= BUF_MODIFF (b
);
5946 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5947 set_buffer_internal (old
);
5949 EMACS_GET_TIME (after_time
);
5951 /* If auto-save took more than 60 seconds,
5952 assume it was an NFS failure that got a timeout. */
5953 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5954 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5958 /* Prevent another auto save till enough input events come in. */
5959 record_auto_save ();
5961 if (auto_saved
&& NILP (no_message
))
5965 /* If we are going to restore an old message,
5966 give time to read ours. */
5967 sit_for (1, 0, 0, 0, 0);
5971 /* If we displayed a message and then restored a state
5972 with no message, leave a "done" message on the screen. */
5973 message1 ("Auto-saving...done");
5978 /* This restores the message-stack status. */
5979 unbind_to (count
, Qnil
);
5983 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5984 Sset_buffer_auto_saved
, 0, 0, 0,
5985 doc
: /* Mark current buffer as auto-saved with its current text.
5986 No auto-save file will be written until the buffer changes again. */)
5989 current_buffer
->auto_save_modified
= MODIFF
;
5990 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5991 current_buffer
->auto_save_failure_time
= -1;
5995 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5996 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5997 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
6000 current_buffer
->auto_save_failure_time
= -1;
6004 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6006 doc
: /* Return t if buffer has been auto-saved since last read in or saved. */)
6009 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6012 /* Reading and completing file names */
6013 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
6015 /* In the string VAL, change each $ to $$ and return the result. */
6018 double_dollars (val
)
6021 register const unsigned char *old
;
6022 register unsigned char *new;
6026 osize
= SBYTES (val
);
6028 /* Count the number of $ characters. */
6029 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
6030 if (*old
++ == '$') count
++;
6034 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
6037 for (n
= osize
; n
> 0; n
--)
6051 read_file_name_cleanup (arg
)
6054 return (current_buffer
->directory
= arg
);
6057 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
6059 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
6060 (string
, dir
, action
)
6061 Lisp_Object string
, dir
, action
;
6062 /* action is nil for complete, t for return list of completions,
6063 lambda for verify final value */
6065 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
6067 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
6069 CHECK_STRING (string
);
6076 /* No need to protect ACTION--we only compare it with t and nil. */
6077 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6079 if (SCHARS (string
) == 0)
6081 if (EQ (action
, Qlambda
))
6089 orig_string
= string
;
6090 string
= Fsubstitute_in_file_name (string
);
6091 changed
= NILP (Fstring_equal (string
, orig_string
));
6092 name
= Ffile_name_nondirectory (string
);
6093 val
= Ffile_name_directory (string
);
6095 realdir
= Fexpand_file_name (val
, realdir
);
6100 specdir
= Ffile_name_directory (string
);
6101 val
= Ffile_name_completion (name
, realdir
);
6106 return double_dollars (string
);
6110 if (!NILP (specdir
))
6111 val
= concat2 (specdir
, val
);
6113 return double_dollars (val
);
6116 #endif /* not VMS */
6120 if (EQ (action
, Qt
))
6122 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6126 if (NILP (Vread_file_name_predicate
)
6127 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6131 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6133 /* Brute-force speed up for directory checking:
6134 Discard strings which don't end in a slash. */
6135 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6137 Lisp_Object tem
= XCAR (all
);
6139 if (STRINGP (tem
) &&
6140 (len
= SCHARS (tem
), len
> 0) &&
6141 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6142 comp
= Fcons (tem
, comp
);
6148 /* Must do it the hard (and slow) way. */
6149 GCPRO3 (all
, comp
, specdir
);
6150 count
= SPECPDL_INDEX ();
6151 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6152 current_buffer
->directory
= realdir
;
6153 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6154 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
6155 comp
= Fcons (XCAR (all
), comp
);
6156 unbind_to (count
, Qnil
);
6159 return Fnreverse (comp
);
6162 /* Only other case actually used is ACTION = lambda */
6164 /* Supposedly this helps commands such as `cd' that read directory names,
6165 but can someone explain how it helps them? -- RMS */
6166 if (SCHARS (name
) == 0)
6169 string
= Fexpand_file_name (string
, dir
);
6170 if (!NILP (Vread_file_name_predicate
))
6171 return call1 (Vread_file_name_predicate
, string
);
6172 return Ffile_exists_p (string
);
6175 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
6176 Snext_read_file_uses_dialog_p
, 0, 0, 0,
6177 doc
: /* Return t if a call to `read-file-name' will use a dialog.
6178 The return value is only relevant for a call to `read-file-name' that happens
6179 before any other event (mouse or keypress) is handeled. */)
6182 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6183 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6192 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6193 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6194 Value is not expanded---you must call `expand-file-name' yourself.
6195 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6196 the same non-empty string that was inserted by this function.
6197 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6198 except that if INITIAL is specified, that combined with DIR is used.)
6199 If the user exits with an empty minibuffer, this function returns
6200 an empty string. (This can only happen if the user erased the
6201 pre-inserted contents or if `insert-default-directory' is nil.)
6202 Fourth arg MUSTMATCH non-nil means require existing file's name.
6203 Non-nil and non-t means also require confirmation after completion.
6204 Fifth arg INITIAL specifies text to start with.
6205 If optional sixth arg PREDICATE is non-nil, possible completions and
6206 the resulting file name must satisfy (funcall PREDICATE NAME).
6207 DIR should be an absolute directory name. It defaults to the value of
6208 `default-directory'.
6210 If this command was invoked with the mouse, use a file dialog box if
6211 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6212 provides a file dialog box.
6214 See also `read-file-name-completion-ignore-case'
6215 and `read-file-name-function'. */)
6216 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6217 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6219 Lisp_Object val
, insdef
, tem
;
6220 struct gcpro gcpro1
, gcpro2
;
6221 register char *homedir
;
6222 Lisp_Object decoded_homedir
;
6223 int replace_in_history
= 0;
6224 int add_to_history
= 0;
6228 dir
= current_buffer
->directory
;
6229 if (NILP (Ffile_name_absolute_p (dir
)))
6230 dir
= Fexpand_file_name (dir
, Qnil
);
6231 if (NILP (default_filename
))
6234 ? Fexpand_file_name (initial
, dir
)
6235 : current_buffer
->filename
);
6237 /* If dir starts with user's homedir, change that to ~. */
6238 homedir
= (char *) egetenv ("HOME");
6240 /* homedir can be NULL in temacs, since Vprocess_environment is not
6241 yet set up. We shouldn't crash in that case. */
6244 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6245 CORRECT_DIR_SEPS (homedir
);
6250 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6253 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6254 SBYTES (decoded_homedir
))
6255 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6257 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6258 dir
= concat2 (build_string ("~"), dir
);
6260 /* Likewise for default_filename. */
6262 && STRINGP (default_filename
)
6263 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6264 SBYTES (decoded_homedir
))
6265 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6268 = Fsubstring (default_filename
,
6269 make_number (SCHARS (decoded_homedir
)), Qnil
);
6270 default_filename
= concat2 (build_string ("~"), default_filename
);
6272 if (!NILP (default_filename
))
6274 CHECK_STRING (default_filename
);
6275 default_filename
= double_dollars (default_filename
);
6278 if (insert_default_directory
&& STRINGP (dir
))
6281 if (!NILP (initial
))
6283 Lisp_Object args
[2], pos
;
6287 insdef
= Fconcat (2, args
);
6288 pos
= make_number (SCHARS (double_dollars (dir
)));
6289 insdef
= Fcons (double_dollars (insdef
), pos
);
6292 insdef
= double_dollars (insdef
);
6294 else if (STRINGP (initial
))
6295 insdef
= Fcons (double_dollars (initial
), make_number (0));
6299 if (!NILP (Vread_file_name_function
))
6301 Lisp_Object args
[7];
6303 GCPRO2 (insdef
, default_filename
);
6304 args
[0] = Vread_file_name_function
;
6307 args
[3] = default_filename
;
6308 args
[4] = mustmatch
;
6310 args
[6] = predicate
;
6311 RETURN_UNGCPRO (Ffuncall (7, args
));
6314 count
= SPECPDL_INDEX ();
6315 specbind (intern ("completion-ignore-case"),
6316 read_file_name_completion_ignore_case
? Qt
: Qnil
);
6317 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6318 specbind (intern ("read-file-name-predicate"),
6319 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6321 GCPRO2 (insdef
, default_filename
);
6323 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6324 if (! NILP (Fnext_read_file_uses_dialog_p ()))
6326 /* If DIR contains a file name, split it. */
6328 file
= Ffile_name_nondirectory (dir
);
6329 if (SCHARS (file
) && NILP (default_filename
))
6331 default_filename
= file
;
6332 dir
= Ffile_name_directory (dir
);
6334 if (!NILP(default_filename
))
6335 default_filename
= Fexpand_file_name (default_filename
, dir
);
6336 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
,
6337 EQ (predicate
, Qfile_directory_p
) ? Qt
: Qnil
);
6342 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6343 dir
, mustmatch
, insdef
,
6344 Qfile_name_history
, default_filename
, Qnil
);
6346 tem
= Fsymbol_value (Qfile_name_history
);
6347 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6348 replace_in_history
= 1;
6350 /* If Fcompleting_read returned the inserted default string itself
6351 (rather than a new string with the same contents),
6352 it has to mean that the user typed RET with the minibuffer empty.
6353 In that case, we really want to return ""
6354 so that commands such as set-visited-file-name can distinguish. */
6355 if (EQ (val
, default_filename
))
6357 /* In this case, Fcompleting_read has not added an element
6358 to the history. Maybe we should. */
6359 if (! replace_in_history
)
6365 unbind_to (count
, Qnil
);
6368 error ("No file name specified");
6370 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6372 if (!NILP (tem
) && !NILP (default_filename
))
6373 val
= default_filename
;
6374 val
= Fsubstitute_in_file_name (val
);
6376 if (replace_in_history
)
6377 /* Replace what Fcompleting_read added to the history
6378 with what we will actually return. */
6380 Lisp_Object val1
= double_dollars (val
);
6381 tem
= Fsymbol_value (Qfile_name_history
);
6382 if (history_delete_duplicates
)
6383 XSETCDR (tem
, Fdelete (val1
, XCDR(tem
)));
6384 XSETCAR (tem
, val1
);
6386 else if (add_to_history
)
6388 /* Add the value to the history--but not if it matches
6389 the last value already there. */
6390 Lisp_Object val1
= double_dollars (val
);
6391 tem
= Fsymbol_value (Qfile_name_history
);
6392 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6394 if (history_delete_duplicates
) tem
= Fdelete (val1
, tem
);
6395 Fset (Qfile_name_history
, Fcons (val1
, tem
));
6406 /* Must be set before any path manipulation is performed. */
6407 XSETFASTINT (Vdirectory_sep_char
, '/');
6414 Qexpand_file_name
= intern ("expand-file-name");
6415 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6416 Qdirectory_file_name
= intern ("directory-file-name");
6417 Qfile_name_directory
= intern ("file-name-directory");
6418 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6419 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6420 Qfile_name_as_directory
= intern ("file-name-as-directory");
6421 Qcopy_file
= intern ("copy-file");
6422 Qmake_directory_internal
= intern ("make-directory-internal");
6423 Qmake_directory
= intern ("make-directory");
6424 Qdelete_directory
= intern ("delete-directory");
6425 Qdelete_file
= intern ("delete-file");
6426 Qrename_file
= intern ("rename-file");
6427 Qadd_name_to_file
= intern ("add-name-to-file");
6428 Qmake_symbolic_link
= intern ("make-symbolic-link");
6429 Qfile_exists_p
= intern ("file-exists-p");
6430 Qfile_executable_p
= intern ("file-executable-p");
6431 Qfile_readable_p
= intern ("file-readable-p");
6432 Qfile_writable_p
= intern ("file-writable-p");
6433 Qfile_symlink_p
= intern ("file-symlink-p");
6434 Qaccess_file
= intern ("access-file");
6435 Qfile_directory_p
= intern ("file-directory-p");
6436 Qfile_regular_p
= intern ("file-regular-p");
6437 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6438 Qfile_modes
= intern ("file-modes");
6439 Qset_file_modes
= intern ("set-file-modes");
6440 Qset_file_times
= intern ("set-file-times");
6441 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6442 Qinsert_file_contents
= intern ("insert-file-contents");
6443 Qwrite_region
= intern ("write-region");
6444 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6445 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6446 Qauto_save_coding
= intern ("auto-save-coding");
6448 staticpro (&Qexpand_file_name
);
6449 staticpro (&Qsubstitute_in_file_name
);
6450 staticpro (&Qdirectory_file_name
);
6451 staticpro (&Qfile_name_directory
);
6452 staticpro (&Qfile_name_nondirectory
);
6453 staticpro (&Qunhandled_file_name_directory
);
6454 staticpro (&Qfile_name_as_directory
);
6455 staticpro (&Qcopy_file
);
6456 staticpro (&Qmake_directory_internal
);
6457 staticpro (&Qmake_directory
);
6458 staticpro (&Qdelete_directory
);
6459 staticpro (&Qdelete_file
);
6460 staticpro (&Qrename_file
);
6461 staticpro (&Qadd_name_to_file
);
6462 staticpro (&Qmake_symbolic_link
);
6463 staticpro (&Qfile_exists_p
);
6464 staticpro (&Qfile_executable_p
);
6465 staticpro (&Qfile_readable_p
);
6466 staticpro (&Qfile_writable_p
);
6467 staticpro (&Qaccess_file
);
6468 staticpro (&Qfile_symlink_p
);
6469 staticpro (&Qfile_directory_p
);
6470 staticpro (&Qfile_regular_p
);
6471 staticpro (&Qfile_accessible_directory_p
);
6472 staticpro (&Qfile_modes
);
6473 staticpro (&Qset_file_modes
);
6474 staticpro (&Qset_file_times
);
6475 staticpro (&Qfile_newer_than_file_p
);
6476 staticpro (&Qinsert_file_contents
);
6477 staticpro (&Qwrite_region
);
6478 staticpro (&Qverify_visited_file_modtime
);
6479 staticpro (&Qset_visited_file_modtime
);
6480 staticpro (&Qauto_save_coding
);
6482 Qfile_name_history
= intern ("file-name-history");
6483 Fset (Qfile_name_history
, Qnil
);
6484 staticpro (&Qfile_name_history
);
6486 Qfile_error
= intern ("file-error");
6487 staticpro (&Qfile_error
);
6488 Qfile_already_exists
= intern ("file-already-exists");
6489 staticpro (&Qfile_already_exists
);
6490 Qfile_date_error
= intern ("file-date-error");
6491 staticpro (&Qfile_date_error
);
6492 Qexcl
= intern ("excl");
6496 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6497 staticpro (&Qfind_buffer_file_type
);
6500 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6501 doc
: /* *Coding system for encoding file names.
6502 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6503 Vfile_name_coding_system
= Qnil
;
6505 DEFVAR_LISP ("default-file-name-coding-system",
6506 &Vdefault_file_name_coding_system
,
6507 doc
: /* Default coding system for encoding file names.
6508 This variable is used only when `file-name-coding-system' is nil.
6510 This variable is set/changed by the command `set-language-environment'.
6511 User should not set this variable manually,
6512 instead use `file-name-coding-system' to get a constant encoding
6513 of file names regardless of the current language environment. */);
6514 Vdefault_file_name_coding_system
= Qnil
;
6516 Qformat_decode
= intern ("format-decode");
6517 staticpro (&Qformat_decode
);
6518 Qformat_annotate_function
= intern ("format-annotate-function");
6519 staticpro (&Qformat_annotate_function
);
6520 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6521 staticpro (&Qafter_insert_file_set_coding
);
6523 Qcar_less_than_car
= intern ("car-less-than-car");
6524 staticpro (&Qcar_less_than_car
);
6526 Fput (Qfile_error
, Qerror_conditions
,
6527 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6528 Fput (Qfile_error
, Qerror_message
,
6529 build_string ("File error"));
6531 Fput (Qfile_already_exists
, Qerror_conditions
,
6532 Fcons (Qfile_already_exists
,
6533 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6534 Fput (Qfile_already_exists
, Qerror_message
,
6535 build_string ("File already exists"));
6537 Fput (Qfile_date_error
, Qerror_conditions
,
6538 Fcons (Qfile_date_error
,
6539 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6540 Fput (Qfile_date_error
, Qerror_message
,
6541 build_string ("Cannot set file date"));
6543 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6544 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6545 Vread_file_name_function
= Qnil
;
6547 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6548 doc
: /* Current predicate used by `read-file-name-internal'. */);
6549 Vread_file_name_predicate
= Qnil
;
6551 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case
,
6552 doc
: /* *Non-nil means when reading a file name completion ignores case. */);
6553 #if defined VMS || defined DOS_NT || defined MAC_OS
6554 read_file_name_completion_ignore_case
= 1;
6556 read_file_name_completion_ignore_case
= 0;
6559 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6560 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6561 If the initial minibuffer contents are non-empty, you can usually
6562 request a default filename by typing RETURN without editing. For some
6563 commands, exiting with an empty minibuffer has a special meaning,
6564 such as making the current buffer visit no file in the case of
6565 `set-visited-file-name'.
6566 If this variable is non-nil, the minibuffer contents are always
6567 initially non-empty and typing RETURN without editing will fetch the
6568 default name, if one is provided. Note however that this default name
6569 is not necessarily the name originally inserted in the minibuffer, if
6570 that is just the default directory.
6571 If this variable is nil, the minibuffer often starts out empty. In
6572 that case you may have to explicitly fetch the next history element to
6573 request the default name. */);
6574 insert_default_directory
= 1;
6576 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6577 doc
: /* *Non-nil means write new files with record format `stmlf'.
6578 nil means use format `var'. This variable is meaningful only on VMS. */);
6579 vms_stmlf_recfm
= 0;
6581 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6582 doc
: /* Directory separator character for built-in functions that return file names.
6583 The value is always ?/. Don't use this variable, just use `/'. */);
6585 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6586 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6587 If a file name matches REGEXP, then all I/O on that file is done by calling
6590 The first argument given to HANDLER is the name of the I/O primitive
6591 to be handled; the remaining arguments are the arguments that were
6592 passed to that primitive. For example, if you do
6593 (file-exists-p FILENAME)
6594 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6595 (funcall HANDLER 'file-exists-p FILENAME)
6596 The function `find-file-name-handler' checks this list for a handler
6597 for its argument. */);
6598 Vfile_name_handler_alist
= Qnil
;
6600 DEFVAR_LISP ("set-auto-coding-function",
6601 &Vset_auto_coding_function
,
6602 doc
: /* If non-nil, a function to call to decide a coding system of file.
6603 Two arguments are passed to this function: the file name
6604 and the length of a file contents following the point.
6605 This function should return a coding system to decode the file contents.
6606 It should check the file name against `auto-coding-alist'.
6607 If no coding system is decided, it should check a coding system
6608 specified in the heading lines with the format:
6609 -*- ... coding: CODING-SYSTEM; ... -*-
6610 or local variable spec of the tailing lines with `coding:' tag. */);
6611 Vset_auto_coding_function
= Qnil
;
6613 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6614 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6615 Each is passed one argument, the number of characters inserted.
6616 It should return the new character count, and leave point the same.
6617 If `insert-file-contents' is intercepted by a handler from
6618 `file-name-handler-alist', that handler is responsible for calling the
6619 functions in `after-insert-file-functions' if appropriate. */);
6620 Vafter_insert_file_functions
= Qnil
;
6622 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6623 doc
: /* A list of functions to be called at the start of `write-region'.
6624 Each is passed two arguments, START and END as for `write-region'.
6625 These are usually two numbers but not always; see the documentation
6626 for `write-region'. The function should return a list of pairs
6627 of the form (POSITION . STRING), consisting of strings to be effectively
6628 inserted at the specified positions of the file being written (1 means to
6629 insert before the first byte written). The POSITIONs must be sorted into
6630 increasing order. If there are several functions in the list, the several
6631 lists are merged destructively. Alternatively, the function can return
6632 with a different buffer current; in that case it should pay attention
6633 to the annotations returned by previous functions and listed in
6634 `write-region-annotations-so-far'.*/);
6635 Vwrite_region_annotate_functions
= Qnil
;
6636 staticpro (&Qwrite_region_annotate_functions
);
6637 Qwrite_region_annotate_functions
6638 = intern ("write-region-annotate-functions");
6640 DEFVAR_LISP ("write-region-annotations-so-far",
6641 &Vwrite_region_annotations_so_far
,
6642 doc
: /* When an annotation function is called, this holds the previous annotations.
6643 These are the annotations made by other annotation functions
6644 that were already called. See also `write-region-annotate-functions'. */);
6645 Vwrite_region_annotations_so_far
= Qnil
;
6647 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6648 doc
: /* A list of file name handlers that temporarily should not be used.
6649 This applies only to the operation `inhibit-file-name-operation'. */);
6650 Vinhibit_file_name_handlers
= Qnil
;
6652 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6653 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6654 Vinhibit_file_name_operation
= Qnil
;
6656 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6657 doc
: /* File name in which we write a list of all auto save file names.
6658 This variable is initialized automatically from `auto-save-list-file-prefix'
6659 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6660 a non-nil value. */);
6661 Vauto_save_list_file_name
= Qnil
;
6663 defsubr (&Sfind_file_name_handler
);
6664 defsubr (&Sfile_name_directory
);
6665 defsubr (&Sfile_name_nondirectory
);
6666 defsubr (&Sunhandled_file_name_directory
);
6667 defsubr (&Sfile_name_as_directory
);
6668 defsubr (&Sdirectory_file_name
);
6669 defsubr (&Smake_temp_name
);
6670 defsubr (&Sexpand_file_name
);
6671 defsubr (&Ssubstitute_in_file_name
);
6672 defsubr (&Scopy_file
);
6673 defsubr (&Smake_directory_internal
);
6674 defsubr (&Sdelete_directory
);
6675 defsubr (&Sdelete_file
);
6676 defsubr (&Srename_file
);
6677 defsubr (&Sadd_name_to_file
);
6679 defsubr (&Smake_symbolic_link
);
6680 #endif /* S_IFLNK */
6682 defsubr (&Sdefine_logical_name
);
6685 defsubr (&Ssysnetunam
);
6686 #endif /* HPUX_NET */
6687 defsubr (&Sfile_name_absolute_p
);
6688 defsubr (&Sfile_exists_p
);
6689 defsubr (&Sfile_executable_p
);
6690 defsubr (&Sfile_readable_p
);
6691 defsubr (&Sfile_writable_p
);
6692 defsubr (&Saccess_file
);
6693 defsubr (&Sfile_symlink_p
);
6694 defsubr (&Sfile_directory_p
);
6695 defsubr (&Sfile_accessible_directory_p
);
6696 defsubr (&Sfile_regular_p
);
6697 defsubr (&Sfile_modes
);
6698 defsubr (&Sset_file_modes
);
6699 defsubr (&Sset_file_times
);
6700 defsubr (&Sset_default_file_modes
);
6701 defsubr (&Sdefault_file_modes
);
6702 defsubr (&Sfile_newer_than_file_p
);
6703 defsubr (&Sinsert_file_contents
);
6704 defsubr (&Swrite_region
);
6705 defsubr (&Scar_less_than_car
);
6706 defsubr (&Sverify_visited_file_modtime
);
6707 defsubr (&Sclear_visited_file_modtime
);
6708 defsubr (&Svisited_file_modtime
);
6709 defsubr (&Sset_visited_file_modtime
);
6710 defsubr (&Sdo_auto_save
);
6711 defsubr (&Sset_buffer_auto_saved
);
6712 defsubr (&Sclear_buffer_auto_save_failure
);
6713 defsubr (&Srecent_auto_save_p
);
6715 defsubr (&Sread_file_name_internal
);
6716 defsubr (&Sread_file_name
);
6717 defsubr (&Snext_read_file_uses_dialog_p
);
6720 defsubr (&Sunix_sync
);
6724 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6725 (do not change this comment) */