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
);
4534 unbind_to (count
, Qnil
);
4535 inserted
= Z_BYTE
- BEG_BYTE
;
4538 /* The following kludgy code is to avoid some compiler bug.
4540 setup_coding_system (val, &coding);
4543 struct coding_system temp_coding
;
4544 setup_coding_system (val
, &temp_coding
);
4545 bcopy (&temp_coding
, &coding
, sizeof coding
);
4547 /* Ensure we set Vlast_coding_system_used. */
4548 set_coding_system
= 1;
4550 if (NILP (current_buffer
->enable_multibyte_characters
)
4552 /* We must suppress all character code conversion except for
4553 end-of-line conversion. */
4554 setup_raw_text_coding_system (&coding
);
4555 coding
.src_multibyte
= 0;
4556 coding
.dst_multibyte
4557 = !NILP (current_buffer
->enable_multibyte_characters
);
4561 /* Can't do this if part of the buffer might be preserved. */
4563 && (coding
.type
== coding_type_no_conversion
4564 || coding
.type
== coding_type_raw_text
))
4566 /* Visiting a file with these coding system makes the buffer
4568 current_buffer
->enable_multibyte_characters
= Qnil
;
4569 coding
.dst_multibyte
= 0;
4572 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4574 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4576 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4578 inserted
= coding
.produced_char
;
4581 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4585 /* Now INSERTED is measured in characters. */
4588 /* Use the conversion type to determine buffer-file-type
4589 (find-buffer-file-type is now used to help determine the
4591 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4592 || coding
.eol_type
== CODING_EOL_LF
)
4593 && ! CODING_REQUIRE_DECODING (&coding
))
4594 current_buffer
->buffer_file_type
= Qt
;
4596 current_buffer
->buffer_file_type
= Qnil
;
4603 if (!EQ (current_buffer
->undo_list
, Qt
))
4604 current_buffer
->undo_list
= Qnil
;
4606 stat (SDATA (filename
), &st
);
4611 current_buffer
->modtime
= st
.st_mtime
;
4612 current_buffer
->filename
= orig_filename
;
4615 SAVE_MODIFF
= MODIFF
;
4616 current_buffer
->auto_save_modified
= MODIFF
;
4617 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4618 #ifdef CLASH_DETECTION
4621 if (!NILP (current_buffer
->file_truename
))
4622 unlock_file (current_buffer
->file_truename
);
4623 unlock_file (filename
);
4625 #endif /* CLASH_DETECTION */
4627 Fsignal (Qfile_error
,
4628 Fcons (build_string ("not a regular file"),
4629 Fcons (orig_filename
, Qnil
)));
4632 if (set_coding_system
)
4633 Vlast_coding_system_used
= coding
.symbol
;
4635 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4637 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4639 if (! NILP (insval
))
4641 CHECK_NUMBER (insval
);
4642 inserted
= XFASTINT (insval
);
4646 /* Decode file format */
4649 int empty_undo_list_p
= 0;
4651 /* If we're anyway going to discard undo information, don't
4652 record it in the first place. The buffer's undo list at this
4653 point is either nil or t when visiting a file. */
4656 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4657 current_buffer
->undo_list
= Qt
;
4660 insval
= call3 (Qformat_decode
,
4661 Qnil
, make_number (inserted
), visit
);
4662 CHECK_NUMBER (insval
);
4663 inserted
= XFASTINT (insval
);
4666 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4669 /* Call after-change hooks for the inserted text, aside from the case
4670 of normal visiting (not with REPLACE), which is done in a new buffer
4671 "before" the buffer is changed. */
4672 if (inserted
> 0 && total
> 0
4673 && (NILP (visit
) || !NILP (replace
)))
4675 signal_after_change (PT
, 0, inserted
);
4676 update_compositions (PT
, PT
, CHECK_BORDER
);
4679 p
= Vafter_insert_file_functions
;
4682 insval
= call1 (XCAR (p
), make_number (inserted
));
4685 CHECK_NUMBER (insval
);
4686 inserted
= XFASTINT (insval
);
4693 && current_buffer
->modtime
== -1)
4695 /* If visiting nonexistent file, return nil. */
4696 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4700 Fsignal (Qquit
, Qnil
);
4702 /* ??? Retval needs to be dealt with in all cases consistently. */
4704 val
= Fcons (orig_filename
,
4705 Fcons (make_number (inserted
),
4708 RETURN_UNGCPRO (unbind_to (count
, val
));
4711 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4712 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4713 Lisp_Object
, Lisp_Object
));
4715 /* If build_annotations switched buffers, switch back to BUF.
4716 Kill the temporary buffer that was selected in the meantime.
4718 Since this kill only the last temporary buffer, some buffers remain
4719 not killed if build_annotations switched buffers more than once.
4723 build_annotations_unwind (buf
)
4728 if (XBUFFER (buf
) == current_buffer
)
4730 tembuf
= Fcurrent_buffer ();
4732 Fkill_buffer (tembuf
);
4736 /* Decide the coding-system to encode the data with. */
4739 choose_write_coding_system (start
, end
, filename
,
4740 append
, visit
, lockname
, coding
)
4741 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4742 struct coding_system
*coding
;
4747 && NILP (Fstring_equal (current_buffer
->filename
,
4748 current_buffer
->auto_save_file_name
)))
4750 /* We use emacs-mule for auto saving... */
4751 setup_coding_system (Qemacs_mule
, coding
);
4752 /* ... but with the special flag to indicate not to strip off
4753 leading code of eight-bit-control chars. */
4755 goto done_setup_coding
;
4757 else if (!NILP (Vcoding_system_for_write
))
4759 val
= Vcoding_system_for_write
;
4760 if (coding_system_require_warning
4761 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4762 /* Confirm that VAL can surely encode the current region. */
4763 val
= call5 (Vselect_safe_coding_system_function
,
4764 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4769 /* If the variable `buffer-file-coding-system' is set locally,
4770 it means that the file was read with some kind of code
4771 conversion or the variable is explicitly set by users. We
4772 had better write it out with the same coding system even if
4773 `enable-multibyte-characters' is nil.
4775 If it is not set locally, we anyway have to convert EOL
4776 format if the default value of `buffer-file-coding-system'
4777 tells that it is not Unix-like (LF only) format. */
4778 int using_default_coding
= 0;
4779 int force_raw_text
= 0;
4781 val
= current_buffer
->buffer_file_coding_system
;
4783 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4786 if (NILP (current_buffer
->enable_multibyte_characters
))
4792 /* Check file-coding-system-alist. */
4793 Lisp_Object args
[7], coding_systems
;
4795 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4796 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4798 coding_systems
= Ffind_operation_coding_system (7, args
);
4799 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4800 val
= XCDR (coding_systems
);
4804 && !NILP (current_buffer
->buffer_file_coding_system
))
4806 /* If we still have not decided a coding system, use the
4807 default value of buffer-file-coding-system. */
4808 val
= current_buffer
->buffer_file_coding_system
;
4809 using_default_coding
= 1;
4813 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4814 /* Confirm that VAL can surely encode the current region. */
4815 val
= call5 (Vselect_safe_coding_system_function
,
4816 start
, end
, val
, Qnil
, filename
);
4818 setup_coding_system (Fcheck_coding_system (val
), coding
);
4819 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4820 && !using_default_coding
)
4822 if (! EQ (default_buffer_file_coding
.symbol
,
4823 buffer_defaults
.buffer_file_coding_system
))
4824 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4825 &default_buffer_file_coding
);
4826 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4828 Lisp_Object subsidiaries
;
4830 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4831 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4832 if (VECTORP (subsidiaries
)
4833 && XVECTOR (subsidiaries
)->size
== 3)
4835 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4840 setup_raw_text_coding_system (coding
);
4841 goto done_setup_coding
;
4844 setup_coding_system (Fcheck_coding_system (val
), coding
);
4847 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4848 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4851 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4852 "r\nFWrite region to file: \ni\ni\ni\np",
4853 doc
: /* Write current region into specified file.
4854 When called from a program, requires three arguments:
4855 START, END and FILENAME. START and END are normally buffer positions
4856 specifying the part of the buffer to write.
4857 If START is nil, that means to use the entire buffer contents.
4858 If START is a string, then output that string to the file
4859 instead of any buffer contents; END is ignored.
4861 Optional fourth argument APPEND if non-nil means
4862 append to existing file contents (if any). If it is an integer,
4863 seek to that offset in the file before writing.
4864 Optional fifth argument VISIT, if t or a string, means
4865 set the last-save-file-modtime of buffer to this file's modtime
4866 and mark buffer not modified.
4867 If VISIT is a string, it is a second file name;
4868 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4869 VISIT is also the file name to lock and unlock for clash detection.
4870 If VISIT is neither t nor nil nor a string,
4871 that means do not display the \"Wrote file\" message.
4872 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4873 use for locking and unlocking, overriding FILENAME and VISIT.
4874 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4875 for an existing file with the same name. If MUSTBENEW is `excl',
4876 that means to get an error if the file already exists; never overwrite.
4877 If MUSTBENEW is neither nil nor `excl', that means ask for
4878 confirmation before overwriting, but do go ahead and overwrite the file
4879 if the user confirms.
4881 This does code conversion according to the value of
4882 `coding-system-for-write', `buffer-file-coding-system', or
4883 `file-coding-system-alist', and sets the variable
4884 `last-coding-system-used' to the coding system actually used. */)
4885 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4886 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4891 const unsigned char *fn
;
4894 int count
= SPECPDL_INDEX ();
4897 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4899 Lisp_Object handler
;
4900 Lisp_Object visit_file
;
4901 Lisp_Object annotations
;
4902 Lisp_Object encoded_filename
;
4903 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4904 int quietly
= !NILP (visit
);
4905 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4906 struct buffer
*given_buffer
;
4908 int buffer_file_type
= O_BINARY
;
4910 struct coding_system coding
;
4912 if (current_buffer
->base_buffer
&& visiting
)
4913 error ("Cannot do file visiting in an indirect buffer");
4915 if (!NILP (start
) && !STRINGP (start
))
4916 validate_region (&start
, &end
);
4918 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4920 filename
= Fexpand_file_name (filename
, Qnil
);
4922 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4923 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4925 if (STRINGP (visit
))
4926 visit_file
= Fexpand_file_name (visit
, Qnil
);
4928 visit_file
= filename
;
4930 if (NILP (lockname
))
4931 lockname
= visit_file
;
4935 /* If the file name has special constructs in it,
4936 call the corresponding file handler. */
4937 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4938 /* If FILENAME has no handler, see if VISIT has one. */
4939 if (NILP (handler
) && STRINGP (visit
))
4940 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4942 if (!NILP (handler
))
4945 val
= call6 (handler
, Qwrite_region
, start
, end
,
4946 filename
, append
, visit
);
4950 SAVE_MODIFF
= MODIFF
;
4951 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4952 current_buffer
->filename
= visit_file
;
4958 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4960 /* Special kludge to simplify auto-saving. */
4963 XSETFASTINT (start
, BEG
);
4964 XSETFASTINT (end
, Z
);
4968 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4969 count1
= SPECPDL_INDEX ();
4971 given_buffer
= current_buffer
;
4973 if (!STRINGP (start
))
4975 annotations
= build_annotations (start
, end
);
4977 if (current_buffer
!= given_buffer
)
4979 XSETFASTINT (start
, BEGV
);
4980 XSETFASTINT (end
, ZV
);
4986 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4988 /* Decide the coding-system to encode the data with.
4989 We used to make this choice before calling build_annotations, but that
4990 leads to problems when a write-annotate-function takes care of
4991 unsavable chars (as was the case with X-Symbol). */
4992 choose_write_coding_system (start
, end
, filename
,
4993 append
, visit
, lockname
, &coding
);
4994 Vlast_coding_system_used
= coding
.symbol
;
4996 given_buffer
= current_buffer
;
4997 if (! STRINGP (start
))
4999 annotations
= build_annotations_2 (start
, end
,
5000 coding
.pre_write_conversion
, annotations
);
5001 if (current_buffer
!= given_buffer
)
5003 XSETFASTINT (start
, BEGV
);
5004 XSETFASTINT (end
, ZV
);
5008 #ifdef CLASH_DETECTION
5011 #if 0 /* This causes trouble for GNUS. */
5012 /* If we've locked this file for some other buffer,
5013 query before proceeding. */
5014 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5015 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5018 lock_file (lockname
);
5020 #endif /* CLASH_DETECTION */
5022 encoded_filename
= ENCODE_FILE (filename
);
5024 fn
= SDATA (encoded_filename
);
5028 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5029 #else /* not DOS_NT */
5030 desc
= emacs_open (fn
, O_WRONLY
, 0);
5031 #endif /* not DOS_NT */
5033 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5035 if (auto_saving
) /* Overwrite any previous version of autosave file */
5037 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5038 desc
= emacs_open (fn
, O_RDWR
, 0);
5040 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5041 ? SDATA (current_buffer
->filename
) : 0,
5044 else /* Write to temporary name and rename if no errors */
5046 Lisp_Object temp_name
;
5047 temp_name
= Ffile_name_directory (filename
);
5049 if (!NILP (temp_name
))
5051 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5052 build_string ("$$SAVE$$")));
5053 fname
= SDATA (filename
);
5054 fn
= SDATA (temp_name
);
5055 desc
= creat_copy_attrs (fname
, fn
);
5058 /* If we can't open the temporary file, try creating a new
5059 version of the original file. VMS "creat" creates a
5060 new version rather than truncating an existing file. */
5063 desc
= creat (fn
, 0666);
5064 #if 0 /* This can clobber an existing file and fail to replace it,
5065 if the user runs out of space. */
5068 /* We can't make a new version;
5069 try to truncate and rewrite existing version if any. */
5071 desc
= emacs_open (fn
, O_RDWR
, 0);
5077 desc
= creat (fn
, 0666);
5081 desc
= emacs_open (fn
,
5082 O_WRONLY
| O_CREAT
| buffer_file_type
5083 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5084 S_IREAD
| S_IWRITE
);
5085 #else /* not DOS_NT */
5086 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5087 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5088 auto_saving
? auto_save_mode_bits
: 0666);
5089 #endif /* not DOS_NT */
5090 #endif /* not VMS */
5094 #ifdef CLASH_DETECTION
5096 if (!auto_saving
) unlock_file (lockname
);
5098 #endif /* CLASH_DETECTION */
5100 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5103 record_unwind_protect (close_file_unwind
, make_number (desc
));
5105 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5109 if (NUMBERP (append
))
5110 ret
= lseek (desc
, XINT (append
), 1);
5112 ret
= lseek (desc
, 0, 2);
5115 #ifdef CLASH_DETECTION
5116 if (!auto_saving
) unlock_file (lockname
);
5117 #endif /* CLASH_DETECTION */
5119 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5127 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5128 * if we do writes that don't end with a carriage return. Furthermore
5129 * it cannot handle writes of more then 16K. The modified
5130 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5131 * this EXCEPT for the last record (iff it doesn't end with a carriage
5132 * return). This implies that if your buffer doesn't end with a carriage
5133 * return, you get one free... tough. However it also means that if
5134 * we make two calls to sys_write (a la the following code) you can
5135 * get one at the gap as well. The easiest way to fix this (honest)
5136 * is to move the gap to the next newline (or the end of the buffer).
5141 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5142 move_gap (find_next_newline (GPT
, 1));
5144 /* Whether VMS or not, we must move the gap to the next of newline
5145 when we must put designation sequences at beginning of line. */
5146 if (INTEGERP (start
)
5147 && coding
.type
== coding_type_iso2022
5148 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5149 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5151 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5152 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5153 move_gap_both (PT
, PT_BYTE
);
5154 SET_PT_BOTH (opoint
, opoint_byte
);
5161 if (STRINGP (start
))
5163 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5164 &annotations
, &coding
);
5167 else if (XINT (start
) != XINT (end
))
5169 tem
= CHAR_TO_BYTE (XINT (start
));
5171 if (XINT (start
) < GPT
)
5173 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5174 min (GPT
, XINT (end
)) - XINT (start
),
5175 &annotations
, &coding
);
5179 if (XINT (end
) > GPT
&& !failure
)
5181 tem
= max (XINT (start
), GPT
);
5182 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5183 &annotations
, &coding
);
5189 /* If file was empty, still need to write the annotations */
5190 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5191 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5195 if (CODING_REQUIRE_FLUSHING (&coding
)
5196 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5199 /* We have to flush out a data. */
5200 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5201 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5208 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5209 Disk full in NFS may be reported here. */
5210 /* mib says that closing the file will try to write as fast as NFS can do
5211 it, and that means the fsync here is not crucial for autosave files. */
5212 if (!auto_saving
&& fsync (desc
) < 0)
5214 /* If fsync fails with EINTR, don't treat that as serious. */
5216 failure
= 1, save_errno
= errno
;
5220 /* Spurious "file has changed on disk" warnings have been
5221 observed on Suns as well.
5222 It seems that `close' can change the modtime, under nfs.
5224 (This has supposedly been fixed in Sunos 4,
5225 but who knows about all the other machines with NFS?) */
5228 /* On VMS and APOLLO, must do the stat after the close
5229 since closing changes the modtime. */
5232 /* Recall that #if defined does not work on VMS. */
5239 /* NFS can report a write failure now. */
5240 if (emacs_close (desc
) < 0)
5241 failure
= 1, save_errno
= errno
;
5244 /* If we wrote to a temporary name and had no errors, rename to real name. */
5248 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5256 /* Discard the unwind protect for close_file_unwind. */
5257 specpdl_ptr
= specpdl
+ count1
;
5258 /* Restore the original current buffer. */
5259 visit_file
= unbind_to (count
, visit_file
);
5261 #ifdef CLASH_DETECTION
5263 unlock_file (lockname
);
5264 #endif /* CLASH_DETECTION */
5266 /* Do this before reporting IO error
5267 to avoid a "file has changed on disk" warning on
5268 next attempt to save. */
5270 current_buffer
->modtime
= st
.st_mtime
;
5273 error ("IO error writing %s: %s", SDATA (filename
),
5274 emacs_strerror (save_errno
));
5278 SAVE_MODIFF
= MODIFF
;
5279 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5280 current_buffer
->filename
= visit_file
;
5281 update_mode_lines
++;
5286 && ! NILP (Fstring_equal (current_buffer
->filename
,
5287 current_buffer
->auto_save_file_name
)))
5288 SAVE_MODIFF
= MODIFF
;
5294 message_with_string ((INTEGERP (append
)
5304 Lisp_Object
merge ();
5306 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5307 doc
: /* Return t if (car A) is numerically less than (car B). */)
5311 return Flss (Fcar (a
), Fcar (b
));
5314 /* Build the complete list of annotations appropriate for writing out
5315 the text between START and END, by calling all the functions in
5316 write-region-annotate-functions and merging the lists they return.
5317 If one of these functions switches to a different buffer, we assume
5318 that buffer contains altered text. Therefore, the caller must
5319 make sure to restore the current buffer in all cases,
5320 as save-excursion would do. */
5323 build_annotations (start
, end
)
5324 Lisp_Object start
, end
;
5326 Lisp_Object annotations
;
5328 struct gcpro gcpro1
, gcpro2
;
5329 Lisp_Object original_buffer
;
5330 int i
, used_global
= 0;
5332 XSETBUFFER (original_buffer
, current_buffer
);
5335 p
= Vwrite_region_annotate_functions
;
5336 GCPRO2 (annotations
, p
);
5339 struct buffer
*given_buffer
= current_buffer
;
5340 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5341 { /* Use the global value of the hook. */
5344 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5346 p
= Fappend (2, arg
);
5349 Vwrite_region_annotations_so_far
= annotations
;
5350 res
= call2 (XCAR (p
), start
, end
);
5351 /* If the function makes a different buffer current,
5352 assume that means this buffer contains altered text to be output.
5353 Reset START and END from the buffer bounds
5354 and discard all previous annotations because they should have
5355 been dealt with by this function. */
5356 if (current_buffer
!= given_buffer
)
5358 XSETFASTINT (start
, BEGV
);
5359 XSETFASTINT (end
, ZV
);
5362 Flength (res
); /* Check basic validity of return value */
5363 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5367 /* Now do the same for annotation functions implied by the file-format */
5368 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
5369 p
= current_buffer
->auto_save_file_format
;
5371 p
= current_buffer
->file_format
;
5372 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5374 struct buffer
*given_buffer
= current_buffer
;
5376 Vwrite_region_annotations_so_far
= annotations
;
5378 /* Value is either a list of annotations or nil if the function
5379 has written annotations to a temporary buffer, which is now
5381 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5382 original_buffer
, make_number (i
));
5383 if (current_buffer
!= given_buffer
)
5385 XSETFASTINT (start
, BEGV
);
5386 XSETFASTINT (end
, ZV
);
5391 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5399 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5400 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5402 struct gcpro gcpro1
;
5405 GCPRO1 (annotations
);
5406 /* At last, do the same for the function PRE_WRITE_CONVERSION
5407 implied by the current coding-system. */
5408 if (!NILP (pre_write_conversion
))
5410 struct buffer
*given_buffer
= current_buffer
;
5411 Vwrite_region_annotations_so_far
= annotations
;
5412 res
= call2 (pre_write_conversion
, start
, end
);
5414 annotations
= (current_buffer
!= given_buffer
5416 : merge (annotations
, res
, Qcar_less_than_car
));
5423 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5424 If STRING is nil, POS is the character position in the current buffer.
5425 Intersperse with them the annotations from *ANNOT
5426 which fall within the range of POS to POS + NCHARS,
5427 each at its appropriate position.
5429 We modify *ANNOT by discarding elements as we use them up.
5431 The return value is negative in case of system call failure. */
5434 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5437 register int nchars
;
5440 struct coding_system
*coding
;
5444 int lastpos
= pos
+ nchars
;
5446 while (NILP (*annot
) || CONSP (*annot
))
5448 tem
= Fcar_safe (Fcar (*annot
));
5451 nextpos
= XFASTINT (tem
);
5453 /* If there are no more annotations in this range,
5454 output the rest of the range all at once. */
5455 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5456 return e_write (desc
, string
, pos
, lastpos
, coding
);
5458 /* Output buffer text up to the next annotation's position. */
5461 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5465 /* Output the annotation. */
5466 tem
= Fcdr (Fcar (*annot
));
5469 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5472 *annot
= Fcdr (*annot
);
5477 #ifndef WRITE_BUF_SIZE
5478 #define WRITE_BUF_SIZE (16 * 1024)
5481 /* Write text in the range START and END into descriptor DESC,
5482 encoding them with coding system CODING. If STRING is nil, START
5483 and END are character positions of the current buffer, else they
5484 are indexes to the string STRING. */
5487 e_write (desc
, string
, start
, end
, coding
)
5491 struct coding_system
*coding
;
5493 register char *addr
;
5494 register int nbytes
;
5495 char buf
[WRITE_BUF_SIZE
];
5499 coding
->composing
= COMPOSITION_DISABLED
;
5500 if (coding
->composing
!= COMPOSITION_DISABLED
)
5501 coding_save_composition (coding
, start
, end
, string
);
5503 if (STRINGP (string
))
5505 addr
= SDATA (string
);
5506 nbytes
= SBYTES (string
);
5507 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5509 else if (start
< end
)
5511 /* It is assured that the gap is not in the range START and END-1. */
5512 addr
= CHAR_POS_ADDR (start
);
5513 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5514 coding
->src_multibyte
5515 = !NILP (current_buffer
->enable_multibyte_characters
);
5521 coding
->src_multibyte
= 1;
5524 /* We used to have a code for handling selective display here. But,
5525 now it is handled within encode_coding. */
5530 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5531 if (coding
->produced
> 0)
5533 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5534 if (coding
->produced
)
5540 nbytes
-= coding
->consumed
;
5541 addr
+= coding
->consumed
;
5542 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5545 /* The source text ends by an incomplete multibyte form.
5546 There's no way other than write it out as is. */
5547 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5556 start
+= coding
->consumed_char
;
5557 if (coding
->cmp_data
)
5558 coding_adjust_composition_offset (coding
, start
);
5561 if (coding
->cmp_data
)
5562 coding_free_composition_data (coding
);
5567 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5568 Sverify_visited_file_modtime
, 1, 1, 0,
5569 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5570 This means that the file has not been changed since it was visited or saved.
5571 See Info node `(elisp)Modification Time' for more details. */)
5577 Lisp_Object handler
;
5578 Lisp_Object filename
;
5583 if (!STRINGP (b
->filename
)) return Qt
;
5584 if (b
->modtime
== 0) return Qt
;
5586 /* If the file name has special constructs in it,
5587 call the corresponding file handler. */
5588 handler
= Ffind_file_name_handler (b
->filename
,
5589 Qverify_visited_file_modtime
);
5590 if (!NILP (handler
))
5591 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5593 filename
= ENCODE_FILE (b
->filename
);
5595 if (stat (SDATA (filename
), &st
) < 0)
5597 /* If the file doesn't exist now and didn't exist before,
5598 we say that it isn't modified, provided the error is a tame one. */
5599 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5604 if (st
.st_mtime
== b
->modtime
5605 /* If both are positive, accept them if they are off by one second. */
5606 || (st
.st_mtime
> 0 && b
->modtime
> 0
5607 && (st
.st_mtime
== b
->modtime
+ 1
5608 || st
.st_mtime
== b
->modtime
- 1)))
5613 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5614 Sclear_visited_file_modtime
, 0, 0, 0,
5615 doc
: /* Clear out records of last mod time of visited file.
5616 Next attempt to save will certainly not complain of a discrepancy. */)
5619 current_buffer
->modtime
= 0;
5623 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5624 Svisited_file_modtime
, 0, 0, 0,
5625 doc
: /* Return the current buffer's recorded visited file modification time.
5626 The value is a list of the form (HIGH LOW), like the time values
5627 that `file-attributes' returns. If the current buffer has no recorded
5628 file modification time, this function returns 0.
5629 See Info node `(elisp)Modification Time' for more details. */)
5633 tcons
= long_to_cons ((unsigned long) current_buffer
->modtime
);
5635 return list2 (XCAR (tcons
), XCDR (tcons
));
5639 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5640 Sset_visited_file_modtime
, 0, 1, 0,
5641 doc
: /* Update buffer's recorded modification time from the visited file's time.
5642 Useful if the buffer was not read from the file normally
5643 or if the file itself has been changed for some known benign reason.
5644 An argument specifies the modification time value to use
5645 \(instead of that of the visited file), in the form of a list
5646 \(HIGH . LOW) or (HIGH LOW). */)
5648 Lisp_Object time_list
;
5650 if (!NILP (time_list
))
5651 current_buffer
->modtime
= cons_to_long (time_list
);
5654 register Lisp_Object filename
;
5656 Lisp_Object handler
;
5658 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5660 /* If the file name has special constructs in it,
5661 call the corresponding file handler. */
5662 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5663 if (!NILP (handler
))
5664 /* The handler can find the file name the same way we did. */
5665 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5667 filename
= ENCODE_FILE (filename
);
5669 if (stat (SDATA (filename
), &st
) >= 0)
5670 current_buffer
->modtime
= st
.st_mtime
;
5677 auto_save_error (error
)
5680 Lisp_Object args
[3], msg
;
5682 struct gcpro gcpro1
;
5686 args
[0] = build_string ("Auto-saving %s: %s");
5687 args
[1] = current_buffer
->name
;
5688 args
[2] = Ferror_message_string (error
);
5689 msg
= Fformat (3, args
);
5691 nbytes
= SBYTES (msg
);
5693 for (i
= 0; i
< 3; ++i
)
5696 message2 (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5698 message2_nolog (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5699 Fsleep_for (make_number (1), Qnil
);
5712 auto_save_mode_bits
= 0666;
5714 /* Get visited file's mode to become the auto save file's mode. */
5715 if (! NILP (current_buffer
->filename
))
5717 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5718 /* But make sure we can overwrite it later! */
5719 auto_save_mode_bits
= st
.st_mode
| 0600;
5720 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5722 /* Remote files don't cooperate with stat. */
5723 auto_save_mode_bits
= XINT (modes
) | 0600;
5727 Fwrite_region (Qnil
, Qnil
,
5728 current_buffer
->auto_save_file_name
,
5729 Qnil
, Qlambda
, Qnil
, Qnil
);
5733 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5738 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5739 | XFASTINT (XCDR (stream
))));
5744 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5747 minibuffer_auto_raise
= XINT (value
);
5752 do_auto_save_make_dir (dir
)
5755 return call2 (Qmake_directory
, dir
, Qt
);
5759 do_auto_save_eh (ignore
)
5765 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5766 doc
: /* Auto-save all buffers that need it.
5767 This is all buffers that have auto-saving enabled
5768 and are changed since last auto-saved.
5769 Auto-saving writes the buffer into a file
5770 so that your editing is not lost if the system crashes.
5771 This file is not the file you visited; that changes only when you save.
5772 Normally we run the normal hook `auto-save-hook' before saving.
5774 A non-nil NO-MESSAGE argument means do not print any message if successful.
5775 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5776 (no_message
, current_only
)
5777 Lisp_Object no_message
, current_only
;
5779 struct buffer
*old
= current_buffer
, *b
;
5780 Lisp_Object tail
, buf
;
5782 int do_handled_files
;
5785 Lisp_Object lispstream
;
5786 int count
= SPECPDL_INDEX ();
5787 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5788 int old_message_p
= 0;
5789 struct gcpro gcpro1
, gcpro2
;
5791 if (max_specpdl_size
< specpdl_size
+ 40)
5792 max_specpdl_size
= specpdl_size
+ 40;
5797 if (NILP (no_message
))
5799 old_message_p
= push_message ();
5800 record_unwind_protect (pop_message_unwind
, Qnil
);
5803 /* Ordinarily don't quit within this function,
5804 but don't make it impossible to quit (in case we get hung in I/O). */
5808 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5809 point to non-strings reached from Vbuffer_alist. */
5811 if (!NILP (Vrun_hooks
))
5812 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5814 if (STRINGP (Vauto_save_list_file_name
))
5816 Lisp_Object listfile
;
5818 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5820 /* Don't try to create the directory when shutting down Emacs,
5821 because creating the directory might signal an error, and
5822 that would leave Emacs in a strange state. */
5823 if (!NILP (Vrun_hooks
))
5827 GCPRO2 (dir
, listfile
);
5828 dir
= Ffile_name_directory (listfile
);
5829 if (NILP (Ffile_directory_p (dir
)))
5830 internal_condition_case_1 (do_auto_save_make_dir
,
5831 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5836 stream
= fopen (SDATA (listfile
), "w");
5839 /* Arrange to close that file whether or not we get an error.
5840 Also reset auto_saving to 0. */
5841 lispstream
= Fcons (Qnil
, Qnil
);
5842 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
5843 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
5854 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5855 record_unwind_protect (do_auto_save_unwind_1
,
5856 make_number (minibuffer_auto_raise
));
5857 minibuffer_auto_raise
= 0;
5860 /* On first pass, save all files that don't have handlers.
5861 On second pass, save all files that do have handlers.
5863 If Emacs is crashing, the handlers may tweak what is causing
5864 Emacs to crash in the first place, and it would be a shame if
5865 Emacs failed to autosave perfectly ordinary files because it
5866 couldn't handle some ange-ftp'd file. */
5868 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5869 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5871 buf
= XCDR (XCAR (tail
));
5874 /* Record all the buffers that have auto save mode
5875 in the special file that lists them. For each of these buffers,
5876 Record visited name (if any) and auto save name. */
5877 if (STRINGP (b
->auto_save_file_name
)
5878 && stream
!= NULL
&& do_handled_files
== 0)
5880 if (!NILP (b
->filename
))
5882 fwrite (SDATA (b
->filename
), 1,
5883 SBYTES (b
->filename
), stream
);
5885 putc ('\n', stream
);
5886 fwrite (SDATA (b
->auto_save_file_name
), 1,
5887 SBYTES (b
->auto_save_file_name
), stream
);
5888 putc ('\n', stream
);
5891 if (!NILP (current_only
)
5892 && b
!= current_buffer
)
5895 /* Don't auto-save indirect buffers.
5896 The base buffer takes care of it. */
5900 /* Check for auto save enabled
5901 and file changed since last auto save
5902 and file changed since last real save. */
5903 if (STRINGP (b
->auto_save_file_name
)
5904 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5905 && b
->auto_save_modified
< BUF_MODIFF (b
)
5906 /* -1 means we've turned off autosaving for a while--see below. */
5907 && XINT (b
->save_length
) >= 0
5908 && (do_handled_files
5909 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5912 EMACS_TIME before_time
, after_time
;
5914 EMACS_GET_TIME (before_time
);
5916 /* If we had a failure, don't try again for 20 minutes. */
5917 if (b
->auto_save_failure_time
>= 0
5918 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5921 if ((XFASTINT (b
->save_length
) * 10
5922 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5923 /* A short file is likely to change a large fraction;
5924 spare the user annoying messages. */
5925 && XFASTINT (b
->save_length
) > 5000
5926 /* These messages are frequent and annoying for `*mail*'. */
5927 && !EQ (b
->filename
, Qnil
)
5928 && NILP (no_message
))
5930 /* It has shrunk too much; turn off auto-saving here. */
5931 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5932 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5934 minibuffer_auto_raise
= 0;
5935 /* Turn off auto-saving until there's a real save,
5936 and prevent any more warnings. */
5937 XSETINT (b
->save_length
, -1);
5938 Fsleep_for (make_number (1), Qnil
);
5941 set_buffer_internal (b
);
5942 if (!auto_saved
&& NILP (no_message
))
5943 message1 ("Auto-saving...");
5944 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5946 b
->auto_save_modified
= BUF_MODIFF (b
);
5947 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5948 set_buffer_internal (old
);
5950 EMACS_GET_TIME (after_time
);
5952 /* If auto-save took more than 60 seconds,
5953 assume it was an NFS failure that got a timeout. */
5954 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5955 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5959 /* Prevent another auto save till enough input events come in. */
5960 record_auto_save ();
5962 if (auto_saved
&& NILP (no_message
))
5966 /* If we are going to restore an old message,
5967 give time to read ours. */
5968 sit_for (1, 0, 0, 0, 0);
5972 /* If we displayed a message and then restored a state
5973 with no message, leave a "done" message on the screen. */
5974 message1 ("Auto-saving...done");
5979 /* This restores the message-stack status. */
5980 unbind_to (count
, Qnil
);
5984 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5985 Sset_buffer_auto_saved
, 0, 0, 0,
5986 doc
: /* Mark current buffer as auto-saved with its current text.
5987 No auto-save file will be written until the buffer changes again. */)
5990 current_buffer
->auto_save_modified
= MODIFF
;
5991 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5992 current_buffer
->auto_save_failure_time
= -1;
5996 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5997 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5998 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
6001 current_buffer
->auto_save_failure_time
= -1;
6005 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6007 doc
: /* Return t if buffer has been auto-saved since last read in or saved. */)
6010 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6013 /* Reading and completing file names */
6014 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
6016 /* In the string VAL, change each $ to $$ and return the result. */
6019 double_dollars (val
)
6022 register const unsigned char *old
;
6023 register unsigned char *new;
6027 osize
= SBYTES (val
);
6029 /* Count the number of $ characters. */
6030 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
6031 if (*old
++ == '$') count
++;
6035 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
6038 for (n
= osize
; n
> 0; n
--)
6052 read_file_name_cleanup (arg
)
6055 return (current_buffer
->directory
= arg
);
6058 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
6060 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
6061 (string
, dir
, action
)
6062 Lisp_Object string
, dir
, action
;
6063 /* action is nil for complete, t for return list of completions,
6064 lambda for verify final value */
6066 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
6068 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
6070 CHECK_STRING (string
);
6077 /* No need to protect ACTION--we only compare it with t and nil. */
6078 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6080 if (SCHARS (string
) == 0)
6082 if (EQ (action
, Qlambda
))
6090 orig_string
= string
;
6091 string
= Fsubstitute_in_file_name (string
);
6092 changed
= NILP (Fstring_equal (string
, orig_string
));
6093 name
= Ffile_name_nondirectory (string
);
6094 val
= Ffile_name_directory (string
);
6096 realdir
= Fexpand_file_name (val
, realdir
);
6101 specdir
= Ffile_name_directory (string
);
6102 val
= Ffile_name_completion (name
, realdir
);
6107 return double_dollars (string
);
6111 if (!NILP (specdir
))
6112 val
= concat2 (specdir
, val
);
6114 return double_dollars (val
);
6117 #endif /* not VMS */
6121 if (EQ (action
, Qt
))
6123 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6127 if (NILP (Vread_file_name_predicate
)
6128 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6132 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6134 /* Brute-force speed up for directory checking:
6135 Discard strings which don't end in a slash. */
6136 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6138 Lisp_Object tem
= XCAR (all
);
6140 if (STRINGP (tem
) &&
6141 (len
= SCHARS (tem
), len
> 0) &&
6142 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6143 comp
= Fcons (tem
, comp
);
6149 /* Must do it the hard (and slow) way. */
6150 GCPRO3 (all
, comp
, specdir
);
6151 count
= SPECPDL_INDEX ();
6152 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6153 current_buffer
->directory
= realdir
;
6154 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6155 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
6156 comp
= Fcons (XCAR (all
), comp
);
6157 unbind_to (count
, Qnil
);
6160 return Fnreverse (comp
);
6163 /* Only other case actually used is ACTION = lambda */
6165 /* Supposedly this helps commands such as `cd' that read directory names,
6166 but can someone explain how it helps them? -- RMS */
6167 if (SCHARS (name
) == 0)
6170 string
= Fexpand_file_name (string
, dir
);
6171 if (!NILP (Vread_file_name_predicate
))
6172 return call1 (Vread_file_name_predicate
, string
);
6173 return Ffile_exists_p (string
);
6176 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
6177 Snext_read_file_uses_dialog_p
, 0, 0, 0,
6178 doc
: /* Return t if a call to `read-file-name' will use a dialog.
6179 The return value is only relevant for a call to `read-file-name' that happens
6180 before any other event (mouse or keypress) is handeled. */)
6183 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6184 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6193 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6194 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6195 Value is not expanded---you must call `expand-file-name' yourself.
6196 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6197 the same non-empty string that was inserted by this function.
6198 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6199 except that if INITIAL is specified, that combined with DIR is used.)
6200 If the user exits with an empty minibuffer, this function returns
6201 an empty string. (This can only happen if the user erased the
6202 pre-inserted contents or if `insert-default-directory' is nil.)
6203 Fourth arg MUSTMATCH non-nil means require existing file's name.
6204 Non-nil and non-t means also require confirmation after completion.
6205 Fifth arg INITIAL specifies text to start with.
6206 If optional sixth arg PREDICATE is non-nil, possible completions and
6207 the resulting file name must satisfy (funcall PREDICATE NAME).
6208 DIR should be an absolute directory name. It defaults to the value of
6209 `default-directory'.
6211 If this command was invoked with the mouse, use a file dialog box if
6212 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6213 provides a file dialog box.
6215 See also `read-file-name-completion-ignore-case'
6216 and `read-file-name-function'. */)
6217 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6218 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6220 Lisp_Object val
, insdef
, tem
;
6221 struct gcpro gcpro1
, gcpro2
;
6222 register char *homedir
;
6223 Lisp_Object decoded_homedir
;
6224 int replace_in_history
= 0;
6225 int add_to_history
= 0;
6229 dir
= current_buffer
->directory
;
6230 if (NILP (Ffile_name_absolute_p (dir
)))
6231 dir
= Fexpand_file_name (dir
, Qnil
);
6232 if (NILP (default_filename
))
6235 ? Fexpand_file_name (initial
, dir
)
6236 : current_buffer
->filename
);
6238 /* If dir starts with user's homedir, change that to ~. */
6239 homedir
= (char *) egetenv ("HOME");
6241 /* homedir can be NULL in temacs, since Vprocess_environment is not
6242 yet set up. We shouldn't crash in that case. */
6245 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6246 CORRECT_DIR_SEPS (homedir
);
6251 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6254 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6255 SBYTES (decoded_homedir
))
6256 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6258 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6259 dir
= concat2 (build_string ("~"), dir
);
6261 /* Likewise for default_filename. */
6263 && STRINGP (default_filename
)
6264 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6265 SBYTES (decoded_homedir
))
6266 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6269 = Fsubstring (default_filename
,
6270 make_number (SCHARS (decoded_homedir
)), Qnil
);
6271 default_filename
= concat2 (build_string ("~"), default_filename
);
6273 if (!NILP (default_filename
))
6275 CHECK_STRING (default_filename
);
6276 default_filename
= double_dollars (default_filename
);
6279 if (insert_default_directory
&& STRINGP (dir
))
6282 if (!NILP (initial
))
6284 Lisp_Object args
[2], pos
;
6288 insdef
= Fconcat (2, args
);
6289 pos
= make_number (SCHARS (double_dollars (dir
)));
6290 insdef
= Fcons (double_dollars (insdef
), pos
);
6293 insdef
= double_dollars (insdef
);
6295 else if (STRINGP (initial
))
6296 insdef
= Fcons (double_dollars (initial
), make_number (0));
6300 if (!NILP (Vread_file_name_function
))
6302 Lisp_Object args
[7];
6304 GCPRO2 (insdef
, default_filename
);
6305 args
[0] = Vread_file_name_function
;
6308 args
[3] = default_filename
;
6309 args
[4] = mustmatch
;
6311 args
[6] = predicate
;
6312 RETURN_UNGCPRO (Ffuncall (7, args
));
6315 count
= SPECPDL_INDEX ();
6316 specbind (intern ("completion-ignore-case"),
6317 read_file_name_completion_ignore_case
? Qt
: Qnil
);
6318 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6319 specbind (intern ("read-file-name-predicate"),
6320 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6322 GCPRO2 (insdef
, default_filename
);
6324 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6325 if (! NILP (Fnext_read_file_uses_dialog_p ()))
6327 /* If DIR contains a file name, split it. */
6329 file
= Ffile_name_nondirectory (dir
);
6330 if (SCHARS (file
) && NILP (default_filename
))
6332 default_filename
= file
;
6333 dir
= Ffile_name_directory (dir
);
6335 if (!NILP(default_filename
))
6336 default_filename
= Fexpand_file_name (default_filename
, dir
);
6337 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
,
6338 EQ (predicate
, Qfile_directory_p
) ? Qt
: Qnil
);
6343 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6344 dir
, mustmatch
, insdef
,
6345 Qfile_name_history
, default_filename
, Qnil
);
6347 tem
= Fsymbol_value (Qfile_name_history
);
6348 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6349 replace_in_history
= 1;
6351 /* If Fcompleting_read returned the inserted default string itself
6352 (rather than a new string with the same contents),
6353 it has to mean that the user typed RET with the minibuffer empty.
6354 In that case, we really want to return ""
6355 so that commands such as set-visited-file-name can distinguish. */
6356 if (EQ (val
, default_filename
))
6358 /* In this case, Fcompleting_read has not added an element
6359 to the history. Maybe we should. */
6360 if (! replace_in_history
)
6366 unbind_to (count
, Qnil
);
6369 error ("No file name specified");
6371 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6373 if (!NILP (tem
) && !NILP (default_filename
))
6374 val
= default_filename
;
6375 val
= Fsubstitute_in_file_name (val
);
6377 if (replace_in_history
)
6378 /* Replace what Fcompleting_read added to the history
6379 with what we will actually return. */
6381 Lisp_Object val1
= double_dollars (val
);
6382 tem
= Fsymbol_value (Qfile_name_history
);
6383 if (history_delete_duplicates
)
6384 XSETCDR (tem
, Fdelete (val1
, XCDR(tem
)));
6385 XSETCAR (tem
, val1
);
6387 else if (add_to_history
)
6389 /* Add the value to the history--but not if it matches
6390 the last value already there. */
6391 Lisp_Object val1
= double_dollars (val
);
6392 tem
= Fsymbol_value (Qfile_name_history
);
6393 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6395 if (history_delete_duplicates
) tem
= Fdelete (val1
, tem
);
6396 Fset (Qfile_name_history
, Fcons (val1
, tem
));
6407 /* Must be set before any path manipulation is performed. */
6408 XSETFASTINT (Vdirectory_sep_char
, '/');
6415 Qexpand_file_name
= intern ("expand-file-name");
6416 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6417 Qdirectory_file_name
= intern ("directory-file-name");
6418 Qfile_name_directory
= intern ("file-name-directory");
6419 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6420 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6421 Qfile_name_as_directory
= intern ("file-name-as-directory");
6422 Qcopy_file
= intern ("copy-file");
6423 Qmake_directory_internal
= intern ("make-directory-internal");
6424 Qmake_directory
= intern ("make-directory");
6425 Qdelete_directory
= intern ("delete-directory");
6426 Qdelete_file
= intern ("delete-file");
6427 Qrename_file
= intern ("rename-file");
6428 Qadd_name_to_file
= intern ("add-name-to-file");
6429 Qmake_symbolic_link
= intern ("make-symbolic-link");
6430 Qfile_exists_p
= intern ("file-exists-p");
6431 Qfile_executable_p
= intern ("file-executable-p");
6432 Qfile_readable_p
= intern ("file-readable-p");
6433 Qfile_writable_p
= intern ("file-writable-p");
6434 Qfile_symlink_p
= intern ("file-symlink-p");
6435 Qaccess_file
= intern ("access-file");
6436 Qfile_directory_p
= intern ("file-directory-p");
6437 Qfile_regular_p
= intern ("file-regular-p");
6438 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6439 Qfile_modes
= intern ("file-modes");
6440 Qset_file_modes
= intern ("set-file-modes");
6441 Qset_file_times
= intern ("set-file-times");
6442 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6443 Qinsert_file_contents
= intern ("insert-file-contents");
6444 Qwrite_region
= intern ("write-region");
6445 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6446 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6447 Qauto_save_coding
= intern ("auto-save-coding");
6449 staticpro (&Qexpand_file_name
);
6450 staticpro (&Qsubstitute_in_file_name
);
6451 staticpro (&Qdirectory_file_name
);
6452 staticpro (&Qfile_name_directory
);
6453 staticpro (&Qfile_name_nondirectory
);
6454 staticpro (&Qunhandled_file_name_directory
);
6455 staticpro (&Qfile_name_as_directory
);
6456 staticpro (&Qcopy_file
);
6457 staticpro (&Qmake_directory_internal
);
6458 staticpro (&Qmake_directory
);
6459 staticpro (&Qdelete_directory
);
6460 staticpro (&Qdelete_file
);
6461 staticpro (&Qrename_file
);
6462 staticpro (&Qadd_name_to_file
);
6463 staticpro (&Qmake_symbolic_link
);
6464 staticpro (&Qfile_exists_p
);
6465 staticpro (&Qfile_executable_p
);
6466 staticpro (&Qfile_readable_p
);
6467 staticpro (&Qfile_writable_p
);
6468 staticpro (&Qaccess_file
);
6469 staticpro (&Qfile_symlink_p
);
6470 staticpro (&Qfile_directory_p
);
6471 staticpro (&Qfile_regular_p
);
6472 staticpro (&Qfile_accessible_directory_p
);
6473 staticpro (&Qfile_modes
);
6474 staticpro (&Qset_file_modes
);
6475 staticpro (&Qset_file_times
);
6476 staticpro (&Qfile_newer_than_file_p
);
6477 staticpro (&Qinsert_file_contents
);
6478 staticpro (&Qwrite_region
);
6479 staticpro (&Qverify_visited_file_modtime
);
6480 staticpro (&Qset_visited_file_modtime
);
6481 staticpro (&Qauto_save_coding
);
6483 Qfile_name_history
= intern ("file-name-history");
6484 Fset (Qfile_name_history
, Qnil
);
6485 staticpro (&Qfile_name_history
);
6487 Qfile_error
= intern ("file-error");
6488 staticpro (&Qfile_error
);
6489 Qfile_already_exists
= intern ("file-already-exists");
6490 staticpro (&Qfile_already_exists
);
6491 Qfile_date_error
= intern ("file-date-error");
6492 staticpro (&Qfile_date_error
);
6493 Qexcl
= intern ("excl");
6497 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6498 staticpro (&Qfind_buffer_file_type
);
6501 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6502 doc
: /* *Coding system for encoding file names.
6503 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6504 Vfile_name_coding_system
= Qnil
;
6506 DEFVAR_LISP ("default-file-name-coding-system",
6507 &Vdefault_file_name_coding_system
,
6508 doc
: /* Default coding system for encoding file names.
6509 This variable is used only when `file-name-coding-system' is nil.
6511 This variable is set/changed by the command `set-language-environment'.
6512 User should not set this variable manually,
6513 instead use `file-name-coding-system' to get a constant encoding
6514 of file names regardless of the current language environment. */);
6515 Vdefault_file_name_coding_system
= Qnil
;
6517 Qformat_decode
= intern ("format-decode");
6518 staticpro (&Qformat_decode
);
6519 Qformat_annotate_function
= intern ("format-annotate-function");
6520 staticpro (&Qformat_annotate_function
);
6521 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6522 staticpro (&Qafter_insert_file_set_coding
);
6524 Qcar_less_than_car
= intern ("car-less-than-car");
6525 staticpro (&Qcar_less_than_car
);
6527 Fput (Qfile_error
, Qerror_conditions
,
6528 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6529 Fput (Qfile_error
, Qerror_message
,
6530 build_string ("File error"));
6532 Fput (Qfile_already_exists
, Qerror_conditions
,
6533 Fcons (Qfile_already_exists
,
6534 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6535 Fput (Qfile_already_exists
, Qerror_message
,
6536 build_string ("File already exists"));
6538 Fput (Qfile_date_error
, Qerror_conditions
,
6539 Fcons (Qfile_date_error
,
6540 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6541 Fput (Qfile_date_error
, Qerror_message
,
6542 build_string ("Cannot set file date"));
6544 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6545 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6546 Vread_file_name_function
= Qnil
;
6548 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6549 doc
: /* Current predicate used by `read-file-name-internal'. */);
6550 Vread_file_name_predicate
= Qnil
;
6552 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case
,
6553 doc
: /* *Non-nil means when reading a file name completion ignores case. */);
6554 #if defined VMS || defined DOS_NT || defined MAC_OS
6555 read_file_name_completion_ignore_case
= 1;
6557 read_file_name_completion_ignore_case
= 0;
6560 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6561 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6562 If the initial minibuffer contents are non-empty, you can usually
6563 request a default filename by typing RETURN without editing. For some
6564 commands, exiting with an empty minibuffer has a special meaning,
6565 such as making the current buffer visit no file in the case of
6566 `set-visited-file-name'.
6567 If this variable is non-nil, the minibuffer contents are always
6568 initially non-empty and typing RETURN without editing will fetch the
6569 default name, if one is provided. Note however that this default name
6570 is not necessarily the name originally inserted in the minibuffer, if
6571 that is just the default directory.
6572 If this variable is nil, the minibuffer often starts out empty. In
6573 that case you may have to explicitly fetch the next history element to
6574 request the default name. */);
6575 insert_default_directory
= 1;
6577 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6578 doc
: /* *Non-nil means write new files with record format `stmlf'.
6579 nil means use format `var'. This variable is meaningful only on VMS. */);
6580 vms_stmlf_recfm
= 0;
6582 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6583 doc
: /* Directory separator character for built-in functions that return file names.
6584 The value is always ?/. Don't use this variable, just use `/'. */);
6586 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6587 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6588 If a file name matches REGEXP, then all I/O on that file is done by calling
6591 The first argument given to HANDLER is the name of the I/O primitive
6592 to be handled; the remaining arguments are the arguments that were
6593 passed to that primitive. For example, if you do
6594 (file-exists-p FILENAME)
6595 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6596 (funcall HANDLER 'file-exists-p FILENAME)
6597 The function `find-file-name-handler' checks this list for a handler
6598 for its argument. */);
6599 Vfile_name_handler_alist
= Qnil
;
6601 DEFVAR_LISP ("set-auto-coding-function",
6602 &Vset_auto_coding_function
,
6603 doc
: /* If non-nil, a function to call to decide a coding system of file.
6604 Two arguments are passed to this function: the file name
6605 and the length of a file contents following the point.
6606 This function should return a coding system to decode the file contents.
6607 It should check the file name against `auto-coding-alist'.
6608 If no coding system is decided, it should check a coding system
6609 specified in the heading lines with the format:
6610 -*- ... coding: CODING-SYSTEM; ... -*-
6611 or local variable spec of the tailing lines with `coding:' tag. */);
6612 Vset_auto_coding_function
= Qnil
;
6614 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6615 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6616 Each is passed one argument, the number of characters inserted.
6617 It should return the new character count, and leave point the same.
6618 If `insert-file-contents' is intercepted by a handler from
6619 `file-name-handler-alist', that handler is responsible for calling the
6620 functions in `after-insert-file-functions' if appropriate. */);
6621 Vafter_insert_file_functions
= Qnil
;
6623 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6624 doc
: /* A list of functions to be called at the start of `write-region'.
6625 Each is passed two arguments, START and END as for `write-region'.
6626 These are usually two numbers but not always; see the documentation
6627 for `write-region'. The function should return a list of pairs
6628 of the form (POSITION . STRING), consisting of strings to be effectively
6629 inserted at the specified positions of the file being written (1 means to
6630 insert before the first byte written). The POSITIONs must be sorted into
6631 increasing order. If there are several functions in the list, the several
6632 lists are merged destructively. Alternatively, the function can return
6633 with a different buffer current; in that case it should pay attention
6634 to the annotations returned by previous functions and listed in
6635 `write-region-annotations-so-far'.*/);
6636 Vwrite_region_annotate_functions
= Qnil
;
6637 staticpro (&Qwrite_region_annotate_functions
);
6638 Qwrite_region_annotate_functions
6639 = intern ("write-region-annotate-functions");
6641 DEFVAR_LISP ("write-region-annotations-so-far",
6642 &Vwrite_region_annotations_so_far
,
6643 doc
: /* When an annotation function is called, this holds the previous annotations.
6644 These are the annotations made by other annotation functions
6645 that were already called. See also `write-region-annotate-functions'. */);
6646 Vwrite_region_annotations_so_far
= Qnil
;
6648 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6649 doc
: /* A list of file name handlers that temporarily should not be used.
6650 This applies only to the operation `inhibit-file-name-operation'. */);
6651 Vinhibit_file_name_handlers
= Qnil
;
6653 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6654 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6655 Vinhibit_file_name_operation
= Qnil
;
6657 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6658 doc
: /* File name in which we write a list of all auto save file names.
6659 This variable is initialized automatically from `auto-save-list-file-prefix'
6660 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6661 a non-nil value. */);
6662 Vauto_save_list_file_name
= Qnil
;
6664 defsubr (&Sfind_file_name_handler
);
6665 defsubr (&Sfile_name_directory
);
6666 defsubr (&Sfile_name_nondirectory
);
6667 defsubr (&Sunhandled_file_name_directory
);
6668 defsubr (&Sfile_name_as_directory
);
6669 defsubr (&Sdirectory_file_name
);
6670 defsubr (&Smake_temp_name
);
6671 defsubr (&Sexpand_file_name
);
6672 defsubr (&Ssubstitute_in_file_name
);
6673 defsubr (&Scopy_file
);
6674 defsubr (&Smake_directory_internal
);
6675 defsubr (&Sdelete_directory
);
6676 defsubr (&Sdelete_file
);
6677 defsubr (&Srename_file
);
6678 defsubr (&Sadd_name_to_file
);
6680 defsubr (&Smake_symbolic_link
);
6681 #endif /* S_IFLNK */
6683 defsubr (&Sdefine_logical_name
);
6686 defsubr (&Ssysnetunam
);
6687 #endif /* HPUX_NET */
6688 defsubr (&Sfile_name_absolute_p
);
6689 defsubr (&Sfile_exists_p
);
6690 defsubr (&Sfile_executable_p
);
6691 defsubr (&Sfile_readable_p
);
6692 defsubr (&Sfile_writable_p
);
6693 defsubr (&Saccess_file
);
6694 defsubr (&Sfile_symlink_p
);
6695 defsubr (&Sfile_directory_p
);
6696 defsubr (&Sfile_accessible_directory_p
);
6697 defsubr (&Sfile_regular_p
);
6698 defsubr (&Sfile_modes
);
6699 defsubr (&Sset_file_modes
);
6700 defsubr (&Sset_file_times
);
6701 defsubr (&Sset_default_file_modes
);
6702 defsubr (&Sdefault_file_modes
);
6703 defsubr (&Sfile_newer_than_file_p
);
6704 defsubr (&Sinsert_file_contents
);
6705 defsubr (&Swrite_region
);
6706 defsubr (&Scar_less_than_car
);
6707 defsubr (&Sverify_visited_file_modtime
);
6708 defsubr (&Sclear_visited_file_modtime
);
6709 defsubr (&Svisited_file_modtime
);
6710 defsubr (&Sset_visited_file_modtime
);
6711 defsubr (&Sdo_auto_save
);
6712 defsubr (&Sset_buffer_auto_saved
);
6713 defsubr (&Sclear_buffer_auto_save_failure
);
6714 defsubr (&Srecent_auto_save_p
);
6716 defsubr (&Sread_file_name_internal
);
6717 defsubr (&Sread_file_name
);
6718 defsubr (&Snext_read_file_uses_dialog_p
);
6721 defsubr (&Sunix_sync
);
6725 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6726 (do not change this comment) */