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, 2005 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)
74 #include "intervals.h"
85 #endif /* not WINDOWSNT */
89 #include <sys/param.h>
97 #define CORRECT_DIR_SEPS(s) \
98 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
99 else unixtodos_filename (s); \
101 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
102 redirector allows the six letters between 'Z' and 'a' as well. */
104 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
107 #define IS_DRIVE(x) isalpha (x)
109 /* Need to lower-case the drive letter, or else expanded
110 filenames will sometimes compare inequal, because
111 `expand-file-name' doesn't always down-case the drive letter. */
112 #define DRIVE_LETTER(x) (tolower (x))
133 #include "commands.h"
134 extern int use_dialog_box
;
135 extern int use_file_dialog
;
149 #ifndef FILE_SYSTEM_CASE
150 #define FILE_SYSTEM_CASE(filename) (filename)
153 /* Nonzero during writing of auto-save files */
156 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
157 a new file with the same mode as the original */
158 int auto_save_mode_bits
;
160 /* The symbol bound to coding-system-for-read when
161 insert-file-contents is called for recovering a file. This is not
162 an actual coding system name, but just an indicator to tell
163 insert-file-contents to use `emacs-mule' with a special flag for
164 auto saving and recovering a file. */
165 Lisp_Object Qauto_save_coding
;
167 /* Coding system for file names, or nil if none. */
168 Lisp_Object Vfile_name_coding_system
;
170 /* Coding system for file names used only when
171 Vfile_name_coding_system is nil. */
172 Lisp_Object Vdefault_file_name_coding_system
;
174 /* Alist of elements (REGEXP . HANDLER) for file names
175 whose I/O is done with a special handler. */
176 Lisp_Object Vfile_name_handler_alist
;
178 /* Property name of a file name handler,
179 which gives a list of operations it handles.. */
180 Lisp_Object Qoperations
;
182 /* Lisp functions for translating file formats */
183 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
185 /* Function to be called to decide a coding system of a reading file. */
186 Lisp_Object Vset_auto_coding_function
;
188 /* Functions to be called to process text properties in inserted file. */
189 Lisp_Object Vafter_insert_file_functions
;
191 /* Lisp function for setting buffer-file-coding-system and the
192 multibyteness of the current buffer after inserting a file. */
193 Lisp_Object Qafter_insert_file_set_coding
;
195 /* Functions to be called to create text property annotations for file. */
196 Lisp_Object Vwrite_region_annotate_functions
;
197 Lisp_Object Qwrite_region_annotate_functions
;
199 /* During build_annotations, each time an annotation function is called,
200 this holds the annotations made by the previous functions. */
201 Lisp_Object Vwrite_region_annotations_so_far
;
203 /* File name in which we write a list of all our auto save files. */
204 Lisp_Object Vauto_save_list_file_name
;
206 /* Function to call to read a file name. */
207 Lisp_Object Vread_file_name_function
;
209 /* Current predicate used by read_file_name_internal. */
210 Lisp_Object Vread_file_name_predicate
;
212 /* Nonzero means completion ignores case when reading file name. */
213 int read_file_name_completion_ignore_case
;
215 /* Nonzero means, when reading a filename in the minibuffer,
216 start out by inserting the default directory into the minibuffer. */
217 int insert_default_directory
;
219 /* On VMS, nonzero means write new files with record format stmlf.
220 Zero means use var format. */
223 /* On NT, specifies the directory separator character, used (eg.) when
224 expanding file names. This can be bound to / or \. */
225 Lisp_Object Vdirectory_sep_char
;
227 extern Lisp_Object Vuser_login_name
;
230 extern Lisp_Object Vw32_get_true_file_attributes
;
233 extern int minibuf_level
;
235 extern int minibuffer_auto_raise
;
237 extern int history_delete_duplicates
;
239 /* These variables describe handlers that have "already" had a chance
240 to handle the current operation.
242 Vinhibit_file_name_handlers is a list of file name handlers.
243 Vinhibit_file_name_operation is the operation being handled.
244 If we try to handle that operation, we ignore those handlers. */
246 static Lisp_Object Vinhibit_file_name_handlers
;
247 static Lisp_Object Vinhibit_file_name_operation
;
249 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
251 Lisp_Object Qfile_name_history
;
253 Lisp_Object Qcar_less_than_car
;
255 static int a_write
P_ ((int, Lisp_Object
, int, int,
256 Lisp_Object
*, struct coding_system
*));
257 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
261 report_file_error (string
, data
)
265 Lisp_Object errstring
;
268 synchronize_system_messages_locale ();
269 errstring
= code_convert_string_norecord (build_string (strerror (errorno
)),
270 Vlocale_coding_system
, 0);
276 Fsignal (Qfile_already_exists
, Fcons (errstring
, data
));
279 /* System error messages are capitalized. Downcase the initial
280 unless it is followed by a slash. */
281 if (SREF (errstring
, 1) != '/')
282 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
284 Fsignal (Qfile_error
,
285 Fcons (build_string (string
), Fcons (errstring
, data
)));
290 close_file_unwind (fd
)
293 emacs_close (XFASTINT (fd
));
297 /* Restore point, having saved it as a marker. */
300 restore_point_unwind (location
)
301 Lisp_Object location
;
303 Fgoto_char (location
);
304 Fset_marker (location
, Qnil
, Qnil
);
308 Lisp_Object Qexpand_file_name
;
309 Lisp_Object Qsubstitute_in_file_name
;
310 Lisp_Object Qdirectory_file_name
;
311 Lisp_Object Qfile_name_directory
;
312 Lisp_Object Qfile_name_nondirectory
;
313 Lisp_Object Qunhandled_file_name_directory
;
314 Lisp_Object Qfile_name_as_directory
;
315 Lisp_Object Qcopy_file
;
316 Lisp_Object Qmake_directory_internal
;
317 Lisp_Object Qmake_directory
;
318 Lisp_Object Qdelete_directory
;
319 Lisp_Object Qdelete_file
;
320 Lisp_Object Qrename_file
;
321 Lisp_Object Qadd_name_to_file
;
322 Lisp_Object Qmake_symbolic_link
;
323 Lisp_Object Qfile_exists_p
;
324 Lisp_Object Qfile_executable_p
;
325 Lisp_Object Qfile_readable_p
;
326 Lisp_Object Qfile_writable_p
;
327 Lisp_Object Qfile_symlink_p
;
328 Lisp_Object Qaccess_file
;
329 Lisp_Object Qfile_directory_p
;
330 Lisp_Object Qfile_regular_p
;
331 Lisp_Object Qfile_accessible_directory_p
;
332 Lisp_Object Qfile_modes
;
333 Lisp_Object Qset_file_modes
;
334 Lisp_Object Qset_file_times
;
335 Lisp_Object Qfile_newer_than_file_p
;
336 Lisp_Object Qinsert_file_contents
;
337 Lisp_Object Qwrite_region
;
338 Lisp_Object Qverify_visited_file_modtime
;
339 Lisp_Object Qset_visited_file_modtime
;
341 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
342 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
343 Otherwise, return nil.
344 A file name is handled if one of the regular expressions in
345 `file-name-handler-alist' matches it.
347 If OPERATION equals `inhibit-file-name-operation', then we ignore
348 any handlers that are members of `inhibit-file-name-handlers',
349 but we still do run any other handlers. This lets handlers
350 use the standard functions without calling themselves recursively. */)
351 (filename
, operation
)
352 Lisp_Object filename
, operation
;
354 /* This function must not munge the match data. */
355 Lisp_Object chain
, inhibited_handlers
, result
;
359 CHECK_STRING (filename
);
361 if (EQ (operation
, Vinhibit_file_name_operation
))
362 inhibited_handlers
= Vinhibit_file_name_handlers
;
364 inhibited_handlers
= Qnil
;
366 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
367 chain
= XCDR (chain
))
373 Lisp_Object string
= XCAR (elt
);
375 Lisp_Object handler
= XCDR (elt
);
376 Lisp_Object operations
= Qnil
;
378 if (SYMBOLP (handler
))
379 operations
= Fget (handler
, Qoperations
);
382 && (match_pos
= fast_string_match (string
, filename
)) > pos
383 && (NILP (operations
) || ! NILP (Fmemq (operation
, operations
))))
387 handler
= XCDR (elt
);
388 tem
= Fmemq (handler
, inhibited_handlers
);
402 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
404 doc
: /* Return the directory component in file name FILENAME.
405 Return nil if FILENAME does not include a directory.
406 Otherwise return a directory spec.
407 Given a Unix syntax file name, returns a string ending in slash;
408 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
410 Lisp_Object filename
;
413 register const unsigned char *beg
;
415 register unsigned char *beg
;
417 register const unsigned char *p
;
420 CHECK_STRING (filename
);
422 /* If the file name has special constructs in it,
423 call the corresponding file handler. */
424 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
426 return call2 (handler
, Qfile_name_directory
, filename
);
428 filename
= FILE_SYSTEM_CASE (filename
);
429 beg
= SDATA (filename
);
431 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
433 p
= beg
+ SBYTES (filename
);
435 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
437 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
440 /* only recognise drive specifier at the beginning */
442 /* handle the "/:d:foo" and "/:foo" cases correctly */
443 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
444 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
451 /* Expansion of "c:" to drive and default directory. */
454 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
455 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
456 unsigned char *r
= res
;
458 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
460 strncpy (res
, beg
, 2);
465 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
467 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
470 p
= beg
+ strlen (beg
);
473 CORRECT_DIR_SEPS (beg
);
476 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
479 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
480 Sfile_name_nondirectory
, 1, 1, 0,
481 doc
: /* Return file name FILENAME sans its directory.
482 For example, in a Unix-syntax file name,
483 this is everything after the last slash,
484 or the entire name if it contains no slash. */)
486 Lisp_Object filename
;
488 register const unsigned char *beg
, *p
, *end
;
491 CHECK_STRING (filename
);
493 /* If the file name has special constructs in it,
494 call the corresponding file handler. */
495 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
497 return call2 (handler
, Qfile_name_nondirectory
, filename
);
499 beg
= SDATA (filename
);
500 end
= p
= beg
+ SBYTES (filename
);
502 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
504 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
507 /* only recognise drive specifier at beginning */
509 /* handle the "/:d:foo" case correctly */
510 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
515 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
518 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
519 Sunhandled_file_name_directory
, 1, 1, 0,
520 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
521 A `directly usable' directory name is one that may be used without the
522 intervention of any file handler.
523 If FILENAME is a directly usable file itself, return
524 \(file-name-directory FILENAME).
525 The `call-process' and `start-process' functions use this function to
526 get a current directory to run processes in. */)
528 Lisp_Object filename
;
532 /* If the file name has special constructs in it,
533 call the corresponding file handler. */
534 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
536 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
538 return Ffile_name_directory (filename
);
543 file_name_as_directory (out
, in
)
546 int size
= strlen (in
) - 1;
559 /* Is it already a directory string? */
560 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
562 /* Is it a VMS directory file name? If so, hack VMS syntax. */
563 else if (! index (in
, '/')
564 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
565 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
566 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
567 || ! strncmp (&in
[size
- 5], ".dir", 4))
568 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
569 && in
[size
] == '1')))
571 register char *p
, *dot
;
575 dir:x.dir --> dir:[x]
576 dir:[x]y.dir --> dir:[x.y] */
578 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
581 strncpy (out
, in
, p
- in
);
600 dot
= index (p
, '.');
603 /* blindly remove any extension */
604 size
= strlen (out
) + (dot
- p
);
605 strncat (out
, p
, dot
- p
);
616 /* For Unix syntax, Append a slash if necessary */
617 if (!IS_DIRECTORY_SEP (out
[size
]))
619 /* Cannot use DIRECTORY_SEP, which could have any value */
621 out
[size
+ 2] = '\0';
624 CORRECT_DIR_SEPS (out
);
630 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
631 Sfile_name_as_directory
, 1, 1, 0,
632 doc
: /* Return a string representing the file name FILE interpreted as a directory.
633 This operation exists because a directory is also a file, but its name as
634 a directory is different from its name as a file.
635 The result can be used as the value of `default-directory'
636 or passed as second argument to `expand-file-name'.
637 For a Unix-syntax file name, just appends a slash.
638 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
649 /* If the file name has special constructs in it,
650 call the corresponding file handler. */
651 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
653 return call2 (handler
, Qfile_name_as_directory
, file
);
655 buf
= (char *) alloca (SBYTES (file
) + 10);
656 file_name_as_directory (buf
, SDATA (file
));
657 return make_specified_string (buf
, -1, strlen (buf
),
658 STRING_MULTIBYTE (file
));
662 * Convert from directory name to filename.
664 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
665 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
666 * On UNIX, it's simple: just make sure there isn't a terminating /
668 * Value is nonzero if the string output is different from the input.
672 directory_file_name (src
, dst
)
680 struct FAB fab
= cc$rms_fab
;
681 struct NAM nam
= cc$rms_nam
;
682 char esa
[NAM$C_MAXRSS
];
687 if (! index (src
, '/')
688 && (src
[slen
- 1] == ']'
689 || src
[slen
- 1] == ':'
690 || src
[slen
- 1] == '>'))
692 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
694 fab
.fab$b_fns
= slen
;
695 fab
.fab$l_nam
= &nam
;
696 fab
.fab$l_fop
= FAB$M_NAM
;
699 nam
.nam$b_ess
= sizeof esa
;
700 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
702 /* We call SYS$PARSE to handle such things as [--] for us. */
703 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
705 slen
= nam
.nam$b_esl
;
706 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
711 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
713 /* what about when we have logical_name:???? */
714 if (src
[slen
- 1] == ':')
715 { /* Xlate logical name and see what we get */
716 ptr
= strcpy (dst
, src
); /* upper case for getenv */
719 if ('a' <= *ptr
&& *ptr
<= 'z')
723 dst
[slen
- 1] = 0; /* remove colon */
724 if (!(src
= egetenv (dst
)))
726 /* should we jump to the beginning of this procedure?
727 Good points: allows us to use logical names that xlate
729 Bad points: can be a problem if we just translated to a device
731 For now, I'll punt and always expect VMS names, and hope for
734 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
735 { /* no recursion here! */
741 { /* not a directory spec */
746 bracket
= src
[slen
- 1];
748 /* If bracket is ']' or '>', bracket - 2 is the corresponding
750 ptr
= index (src
, bracket
- 2);
752 { /* no opening bracket */
756 if (!(rptr
= rindex (src
, '.')))
759 strncpy (dst
, src
, slen
);
763 dst
[slen
++] = bracket
;
768 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
769 then translate the device and recurse. */
770 if (dst
[slen
- 1] == ':'
771 && dst
[slen
- 2] != ':' /* skip decnet nodes */
772 && strcmp (src
+ slen
, "[000000]") == 0)
774 dst
[slen
- 1] = '\0';
775 if ((ptr
= egetenv (dst
))
776 && (rlen
= strlen (ptr
) - 1) > 0
777 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
778 && ptr
[rlen
- 1] == '.')
780 char * buf
= (char *) alloca (strlen (ptr
) + 1);
784 return directory_file_name (buf
, dst
);
789 strcat (dst
, "[000000]");
793 rlen
= strlen (rptr
) - 1;
794 strncat (dst
, rptr
, rlen
);
795 dst
[slen
+ rlen
] = '\0';
796 strcat (dst
, ".DIR.1");
800 /* Process as Unix format: just remove any final slash.
801 But leave "/" unchanged; do not change it to "". */
804 /* Handle // as root for apollo's. */
805 if ((slen
> 2 && dst
[slen
- 1] == '/')
806 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
810 && IS_DIRECTORY_SEP (dst
[slen
- 1])
812 && !IS_ANY_SEP (dst
[slen
- 2])
818 CORRECT_DIR_SEPS (dst
);
823 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
825 doc
: /* Returns the file name of the directory named DIRECTORY.
826 This is the name of the file that holds the data for the directory DIRECTORY.
827 This operation exists because a directory is also a file, but its name as
828 a directory is different from its name as a file.
829 In Unix-syntax, this function just removes the final slash.
830 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
831 it returns a file name such as \"[X]Y.DIR.1\". */)
833 Lisp_Object directory
;
838 CHECK_STRING (directory
);
840 if (NILP (directory
))
843 /* If the file name has special constructs in it,
844 call the corresponding file handler. */
845 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
847 return call2 (handler
, Qdirectory_file_name
, directory
);
850 /* 20 extra chars is insufficient for VMS, since we might perform a
851 logical name translation. an equivalence string can be up to 255
852 chars long, so grab that much extra space... - sss */
853 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
855 buf
= (char *) alloca (SBYTES (directory
) + 20);
857 directory_file_name (SDATA (directory
), buf
);
858 return make_specified_string (buf
, -1, strlen (buf
),
859 STRING_MULTIBYTE (directory
));
862 static char make_temp_name_tbl
[64] =
864 'A','B','C','D','E','F','G','H',
865 'I','J','K','L','M','N','O','P',
866 'Q','R','S','T','U','V','W','X',
867 'Y','Z','a','b','c','d','e','f',
868 'g','h','i','j','k','l','m','n',
869 'o','p','q','r','s','t','u','v',
870 'w','x','y','z','0','1','2','3',
871 '4','5','6','7','8','9','-','_'
874 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
876 /* Value is a temporary file name starting with PREFIX, a string.
878 The Emacs process number forms part of the result, so there is
879 no danger of generating a name being used by another process.
880 In addition, this function makes an attempt to choose a name
881 which has no existing file. To make this work, PREFIX should be
882 an absolute file name.
884 BASE64_P non-zero means add the pid as 3 characters in base64
885 encoding. In this case, 6 characters will be added to PREFIX to
886 form the file name. Otherwise, if Emacs is running on a system
887 with long file names, add the pid as a decimal number.
889 This function signals an error if no unique file name could be
893 make_temp_name (prefix
, base64_p
)
900 unsigned char *p
, *data
;
904 CHECK_STRING (prefix
);
906 /* VAL is created by adding 6 characters to PREFIX. The first
907 three are the PID of this process, in base 64, and the second
908 three are incremented if the file already exists. This ensures
909 262144 unique file names per PID per PREFIX. */
911 pid
= (int) getpid ();
915 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
916 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
917 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
922 #ifdef HAVE_LONG_FILE_NAMES
923 sprintf (pidbuf
, "%d", pid
);
924 pidlen
= strlen (pidbuf
);
926 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
927 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
928 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
933 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
934 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
935 if (!STRING_MULTIBYTE (prefix
))
936 STRING_SET_UNIBYTE (val
);
938 bcopy(SDATA (prefix
), data
, len
);
941 bcopy (pidbuf
, p
, pidlen
);
944 /* Here we try to minimize useless stat'ing when this function is
945 invoked many times successively with the same PREFIX. We achieve
946 this by initializing count to a random value, and incrementing it
949 We don't want make-temp-name to be called while dumping,
950 because then make_temp_name_count_initialized_p would get set
951 and then make_temp_name_count would not be set when Emacs starts. */
953 if (!make_temp_name_count_initialized_p
)
955 make_temp_name_count
= (unsigned) time (NULL
);
956 make_temp_name_count_initialized_p
= 1;
962 unsigned num
= make_temp_name_count
;
964 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
965 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
966 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
968 /* Poor man's congruential RN generator. Replace with
969 ++make_temp_name_count for debugging. */
970 make_temp_name_count
+= 25229;
971 make_temp_name_count
%= 225307;
973 if (stat (data
, &ignored
) < 0)
975 /* We want to return only if errno is ENOENT. */
979 /* The error here is dubious, but there is little else we
980 can do. The alternatives are to return nil, which is
981 as bad as (and in many cases worse than) throwing the
982 error, or to ignore the error, which will likely result
983 in looping through 225307 stat's, which is not only
984 dog-slow, but also useless since it will fallback to
985 the errow below, anyway. */
986 report_file_error ("Cannot create temporary name for prefix",
987 Fcons (prefix
, Qnil
));
992 error ("Cannot create temporary name for prefix `%s'",
998 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
999 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
1000 The Emacs process number forms part of the result,
1001 so there is no danger of generating a name being used by another process.
1003 In addition, this function makes an attempt to choose a name
1004 which has no existing file. To make this work,
1005 PREFIX should be an absolute file name.
1007 There is a race condition between calling `make-temp-name' and creating the
1008 file which opens all kinds of security holes. For that reason, you should
1009 probably use `make-temp-file' instead, except in three circumstances:
1011 * If you are creating the file in the user's home directory.
1012 * If you are creating a directory rather than an ordinary file.
1013 * If you are taking special precautions as `make-temp-file' does. */)
1017 return make_temp_name (prefix
, 0);
1022 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1023 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1024 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1025 \(does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
1026 the current buffer's value of `default-directory' is used.
1027 File name components that are `.' are removed, and
1028 so are file name components followed by `..', along with the `..' itself;
1029 note that these simplifications are done without checking the resulting
1030 file names in the file system.
1031 An initial `~/' expands to your home directory.
1032 An initial `~USER/' expands to USER's home directory.
1033 See also the function `substitute-in-file-name'. */)
1034 (name
, default_directory
)
1035 Lisp_Object name
, default_directory
;
1039 register unsigned char *newdir
, *p
, *o
;
1041 unsigned char *target
;
1044 unsigned char * colon
= 0;
1045 unsigned char * close
= 0;
1046 unsigned char * slash
= 0;
1047 unsigned char * brack
= 0;
1048 int lbrack
= 0, rbrack
= 0;
1053 int collapse_newdir
= 1;
1057 Lisp_Object handler
, result
;
1059 CHECK_STRING (name
);
1061 /* If the file name has special constructs in it,
1062 call the corresponding file handler. */
1063 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1064 if (!NILP (handler
))
1065 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1067 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1068 if (NILP (default_directory
))
1069 default_directory
= current_buffer
->directory
;
1070 if (! STRINGP (default_directory
))
1073 /* "/" is not considered a root directory on DOS_NT, so using "/"
1074 here causes an infinite recursion in, e.g., the following:
1076 (let (default-directory)
1077 (expand-file-name "a"))
1079 To avoid this, we set default_directory to the root of the
1081 extern char *emacs_root_dir (void);
1083 default_directory
= build_string (emacs_root_dir ());
1085 default_directory
= build_string ("/");
1089 if (!NILP (default_directory
))
1091 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1092 if (!NILP (handler
))
1093 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1096 o
= SDATA (default_directory
);
1098 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1099 It would be better to do this down below where we actually use
1100 default_directory. Unfortunately, calling Fexpand_file_name recursively
1101 could invoke GC, and the strings might be relocated. This would
1102 be annoying because we have pointers into strings lying around
1103 that would need adjusting, and people would add new pointers to
1104 the code and forget to adjust them, resulting in intermittent bugs.
1105 Putting this call here avoids all that crud.
1107 The EQ test avoids infinite recursion. */
1108 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1109 /* Save time in some common cases - as long as default_directory
1110 is not relative, it can be canonicalized with name below (if it
1111 is needed at all) without requiring it to be expanded now. */
1113 /* Detect MSDOS file names with drive specifiers. */
1114 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1116 /* Detect Windows file names in UNC format. */
1117 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1119 #else /* not DOS_NT */
1120 /* Detect Unix absolute file names (/... alone is not absolute on
1122 && ! (IS_DIRECTORY_SEP (o
[0]))
1123 #endif /* not DOS_NT */
1126 struct gcpro gcpro1
;
1129 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1133 name
= FILE_SYSTEM_CASE (name
);
1137 /* We will force directory separators to be either all \ or /, so make
1138 a local copy to modify, even if there ends up being no change. */
1139 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1141 /* Note if special escape prefix is present, but remove for now. */
1142 if (nm
[0] == '/' && nm
[1] == ':')
1148 /* Find and remove drive specifier if present; this makes nm absolute
1149 even if the rest of the name appears to be relative. Only look for
1150 drive specifier at the beginning. */
1151 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1158 /* If we see "c://somedir", we want to strip the first slash after the
1159 colon when stripping the drive letter. Otherwise, this expands to
1161 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1163 #endif /* WINDOWSNT */
1167 /* Discard any previous drive specifier if nm is now in UNC format. */
1168 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1174 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1175 none are found, we can probably return right away. We will avoid
1176 allocating a new string if name is already fully expanded. */
1178 IS_DIRECTORY_SEP (nm
[0])
1180 && drive
&& !is_escaped
1183 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1190 /* If it turns out that the filename we want to return is just a
1191 suffix of FILENAME, we don't need to go through and edit
1192 things; we just need to construct a new string using data
1193 starting at the middle of FILENAME. If we set lose to a
1194 non-zero value, that means we've discovered that we can't do
1201 /* Since we know the name is absolute, we can assume that each
1202 element starts with a "/". */
1204 /* "." and ".." are hairy. */
1205 if (IS_DIRECTORY_SEP (p
[0])
1207 && (IS_DIRECTORY_SEP (p
[2])
1209 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1212 /* We want to replace multiple `/' in a row with a single
1215 && IS_DIRECTORY_SEP (p
[0])
1216 && IS_DIRECTORY_SEP (p
[1]))
1223 /* if dev:[dir]/, move nm to / */
1224 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1225 nm
= (brack
? brack
+ 1 : colon
+ 1);
1226 lbrack
= rbrack
= 0;
1233 #ifdef NO_HYPHENS_IN_FILENAMES
1234 if (lbrack
== rbrack
)
1236 /* Avoid clobbering negative version numbers. */
1241 #endif /* NO_HYPHENS_IN_FILENAMES */
1242 if (lbrack
> rbrack
&&
1243 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1244 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1246 #ifdef NO_HYPHENS_IN_FILENAMES
1249 #endif /* NO_HYPHENS_IN_FILENAMES */
1250 /* count open brackets, reset close bracket pointer */
1251 if (p
[0] == '[' || p
[0] == '<')
1252 lbrack
++, brack
= 0;
1253 /* count close brackets, set close bracket pointer */
1254 if (p
[0] == ']' || p
[0] == '>')
1255 rbrack
++, brack
= p
;
1256 /* detect ][ or >< */
1257 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1259 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1260 nm
= p
+ 1, lose
= 1;
1261 if (p
[0] == ':' && (colon
|| slash
))
1262 /* if dev1:[dir]dev2:, move nm to dev2: */
1268 /* if /name/dev:, move nm to dev: */
1271 /* if node::dev:, move colon following dev */
1272 else if (colon
&& colon
[-1] == ':')
1274 /* if dev1:dev2:, move nm to dev2: */
1275 else if (colon
&& colon
[-1] != ':')
1280 if (p
[0] == ':' && !colon
)
1286 if (lbrack
== rbrack
)
1289 else if (p
[0] == '.')
1297 if (index (nm
, '/'))
1299 nm
= sys_translate_unix (nm
);
1300 return make_specified_string (nm
, -1, strlen (nm
),
1301 STRING_MULTIBYTE (name
));
1305 /* Make sure directories are all separated with / or \ as
1306 desired, but avoid allocation of a new string when not
1308 CORRECT_DIR_SEPS (nm
);
1310 if (IS_DIRECTORY_SEP (nm
[1]))
1312 if (strcmp (nm
, SDATA (name
)) != 0)
1313 name
= make_specified_string (nm
, -1, strlen (nm
),
1314 STRING_MULTIBYTE (name
));
1318 /* drive must be set, so this is okay */
1319 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1323 name
= make_specified_string (nm
, -1, p
- nm
,
1324 STRING_MULTIBYTE (name
));
1325 temp
[0] = DRIVE_LETTER (drive
);
1326 name
= concat2 (build_string (temp
), name
);
1329 #else /* not DOS_NT */
1330 if (nm
== SDATA (name
))
1332 return make_specified_string (nm
, -1, strlen (nm
),
1333 STRING_MULTIBYTE (name
));
1334 #endif /* not DOS_NT */
1338 /* At this point, nm might or might not be an absolute file name. We
1339 need to expand ~ or ~user if present, otherwise prefix nm with
1340 default_directory if nm is not absolute, and finally collapse /./
1341 and /foo/../ sequences.
1343 We set newdir to be the appropriate prefix if one is needed:
1344 - the relevant user directory if nm starts with ~ or ~user
1345 - the specified drive's working dir (DOS/NT only) if nm does not
1347 - the value of default_directory.
1349 Note that these prefixes are not guaranteed to be absolute (except
1350 for the working dir of a drive). Therefore, to ensure we always
1351 return an absolute name, if the final prefix is not absolute we
1352 append it to the current working directory. */
1356 if (nm
[0] == '~') /* prefix ~ */
1358 if (IS_DIRECTORY_SEP (nm
[1])
1362 || nm
[1] == 0) /* ~ by itself */
1364 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1365 newdir
= (unsigned char *) "";
1368 collapse_newdir
= 0;
1371 nm
++; /* Don't leave the slash in nm. */
1374 else /* ~user/filename */
1376 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1381 o
= (unsigned char *) alloca (p
- nm
+ 1);
1382 bcopy ((char *) nm
, o
, p
- nm
);
1385 pw
= (struct passwd
*) getpwnam (o
+ 1);
1388 newdir
= (unsigned char *) pw
-> pw_dir
;
1390 nm
= p
+ 1; /* skip the terminator */
1394 collapse_newdir
= 0;
1399 /* If we don't find a user of that name, leave the name
1400 unchanged; don't move nm forward to p. */
1405 /* On DOS and Windows, nm is absolute if a drive name was specified;
1406 use the drive's current directory as the prefix if needed. */
1407 if (!newdir
&& drive
)
1409 /* Get default directory if needed to make nm absolute. */
1410 if (!IS_DIRECTORY_SEP (nm
[0]))
1412 newdir
= alloca (MAXPATHLEN
+ 1);
1413 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1418 /* Either nm starts with /, or drive isn't mounted. */
1419 newdir
= alloca (4);
1420 newdir
[0] = DRIVE_LETTER (drive
);
1428 /* Finally, if no prefix has been specified and nm is not absolute,
1429 then it must be expanded relative to default_directory. */
1433 /* /... alone is not absolute on DOS and Windows. */
1434 && !IS_DIRECTORY_SEP (nm
[0])
1437 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1444 newdir
= SDATA (default_directory
);
1446 /* Note if special escape prefix is present, but remove for now. */
1447 if (newdir
[0] == '/' && newdir
[1] == ':')
1458 /* First ensure newdir is an absolute name. */
1460 /* Detect MSDOS file names with drive specifiers. */
1461 ! (IS_DRIVE (newdir
[0])
1462 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1464 /* Detect Windows file names in UNC format. */
1465 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1469 /* Effectively, let newdir be (expand-file-name newdir cwd).
1470 Because of the admonition against calling expand-file-name
1471 when we have pointers into lisp strings, we accomplish this
1472 indirectly by prepending newdir to nm if necessary, and using
1473 cwd (or the wd of newdir's drive) as the new newdir. */
1475 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1480 if (!IS_DIRECTORY_SEP (nm
[0]))
1482 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1483 file_name_as_directory (tmp
, newdir
);
1487 newdir
= alloca (MAXPATHLEN
+ 1);
1490 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1497 /* Strip off drive name from prefix, if present. */
1498 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1504 /* Keep only a prefix from newdir if nm starts with slash
1505 (//server/share for UNC, nothing otherwise). */
1506 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1509 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1511 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1513 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1515 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1527 /* Get rid of any slash at the end of newdir, unless newdir is
1528 just / or // (an incomplete UNC name). */
1529 length
= strlen (newdir
);
1530 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1532 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1536 unsigned char *temp
= (unsigned char *) alloca (length
);
1537 bcopy (newdir
, temp
, length
- 1);
1538 temp
[length
- 1] = 0;
1546 /* Now concatenate the directory and name to new space in the stack frame */
1547 tlen
+= strlen (nm
) + 1;
1549 /* Reserve space for drive specifier and escape prefix, since either
1550 or both may need to be inserted. (The Microsoft x86 compiler
1551 produces incorrect code if the following two lines are combined.) */
1552 target
= (unsigned char *) alloca (tlen
+ 4);
1554 #else /* not DOS_NT */
1555 target
= (unsigned char *) alloca (tlen
);
1556 #endif /* not DOS_NT */
1562 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1565 /* If newdir is effectively "C:/", then the drive letter will have
1566 been stripped and newdir will be "/". Concatenating with an
1567 absolute directory in nm produces "//", which will then be
1568 incorrectly treated as a network share. Ignore newdir in
1569 this case (keeping the drive letter). */
1570 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1571 && newdir
[1] == '\0'))
1573 strcpy (target
, newdir
);
1577 file_name_as_directory (target
, newdir
);
1580 strcat (target
, nm
);
1582 if (index (target
, '/'))
1583 strcpy (target
, sys_translate_unix (target
));
1586 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1588 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1597 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1603 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1604 /* brackets are offset from each other by 2 */
1607 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1608 /* convert [foo][bar] to [bar] */
1609 while (o
[-1] != '[' && o
[-1] != '<')
1611 else if (*p
== '-' && *o
!= '.')
1614 else if (p
[0] == '-' && o
[-1] == '.' &&
1615 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1616 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1620 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1621 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1623 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1625 /* else [foo.-] ==> [-] */
1629 #ifdef NO_HYPHENS_IN_FILENAMES
1631 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1632 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1634 #endif /* NO_HYPHENS_IN_FILENAMES */
1638 if (!IS_DIRECTORY_SEP (*p
))
1642 else if (IS_DIRECTORY_SEP (p
[0])
1644 && (IS_DIRECTORY_SEP (p
[2])
1647 /* If "/." is the entire filename, keep the "/". Otherwise,
1648 just delete the whole "/.". */
1649 if (o
== target
&& p
[2] == '\0')
1653 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1654 /* `/../' is the "superroot" on certain file systems. */
1656 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1658 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1660 /* Keep initial / only if this is the whole name. */
1661 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1666 && IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1]))
1668 /* Collapse multiple `/' in a row. */
1670 while (IS_DIRECTORY_SEP (*p
))
1677 #endif /* not VMS */
1681 /* At last, set drive name. */
1683 /* Except for network file name. */
1684 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1685 #endif /* WINDOWSNT */
1687 if (!drive
) abort ();
1689 target
[0] = DRIVE_LETTER (drive
);
1692 /* Reinsert the escape prefix if required. */
1699 CORRECT_DIR_SEPS (target
);
1702 result
= make_specified_string (target
, -1, o
- target
,
1703 STRING_MULTIBYTE (name
));
1705 /* Again look to see if the file name has special constructs in it
1706 and perhaps call the corresponding file handler. This is needed
1707 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1708 the ".." component gives us "/user@host:/bar/../baz" which needs
1709 to be expanded again. */
1710 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1711 if (!NILP (handler
))
1712 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1718 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1719 This is the old version of expand-file-name, before it was thoroughly
1720 rewritten for Emacs 10.31. We leave this version here commented-out,
1721 because the code is very complex and likely to have subtle bugs. If
1722 bugs _are_ found, it might be of interest to look at the old code and
1723 see what did it do in the relevant situation.
1725 Don't remove this code: it's true that it will be accessible via CVS,
1726 but a few years from deletion, people will forget it is there. */
1728 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1729 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1730 "Convert FILENAME to absolute, and canonicalize it.\n\
1731 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1732 \(does not start with slash); if DEFAULT is nil or missing,\n\
1733 the current buffer's value of default-directory is used.\n\
1734 Filenames containing `.' or `..' as components are simplified;\n\
1735 initial `~/' expands to your home directory.\n\
1736 See also the function `substitute-in-file-name'.")
1738 Lisp_Object name
, defalt
;
1742 register unsigned char *newdir
, *p
, *o
;
1744 unsigned char *target
;
1748 unsigned char * colon
= 0;
1749 unsigned char * close
= 0;
1750 unsigned char * slash
= 0;
1751 unsigned char * brack
= 0;
1752 int lbrack
= 0, rbrack
= 0;
1756 CHECK_STRING (name
);
1759 /* Filenames on VMS are always upper case. */
1760 name
= Fupcase (name
);
1765 /* If nm is absolute, flush ...// and detect /./ and /../.
1766 If no /./ or /../ we can return right away. */
1778 if (p
[0] == '/' && p
[1] == '/'
1780 /* // at start of filename is meaningful on Apollo system. */
1785 if (p
[0] == '/' && p
[1] == '~')
1786 nm
= p
+ 1, lose
= 1;
1787 if (p
[0] == '/' && p
[1] == '.'
1788 && (p
[2] == '/' || p
[2] == 0
1789 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1795 /* if dev:[dir]/, move nm to / */
1796 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1797 nm
= (brack
? brack
+ 1 : colon
+ 1);
1798 lbrack
= rbrack
= 0;
1806 /* VMS pre V4.4,convert '-'s in filenames. */
1807 if (lbrack
== rbrack
)
1809 if (dots
< 2) /* this is to allow negative version numbers */
1814 if (lbrack
> rbrack
&&
1815 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1816 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1822 /* count open brackets, reset close bracket pointer */
1823 if (p
[0] == '[' || p
[0] == '<')
1824 lbrack
++, brack
= 0;
1825 /* count close brackets, set close bracket pointer */
1826 if (p
[0] == ']' || p
[0] == '>')
1827 rbrack
++, brack
= p
;
1828 /* detect ][ or >< */
1829 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1831 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1832 nm
= p
+ 1, lose
= 1;
1833 if (p
[0] == ':' && (colon
|| slash
))
1834 /* if dev1:[dir]dev2:, move nm to dev2: */
1840 /* If /name/dev:, move nm to dev: */
1843 /* If node::dev:, move colon following dev */
1844 else if (colon
&& colon
[-1] == ':')
1846 /* If dev1:dev2:, move nm to dev2: */
1847 else if (colon
&& colon
[-1] != ':')
1852 if (p
[0] == ':' && !colon
)
1858 if (lbrack
== rbrack
)
1861 else if (p
[0] == '.')
1869 if (index (nm
, '/'))
1870 return build_string (sys_translate_unix (nm
));
1872 if (nm
== SDATA (name
))
1874 return build_string (nm
);
1878 /* Now determine directory to start with and put it in NEWDIR */
1882 if (nm
[0] == '~') /* prefix ~ */
1887 || nm
[1] == 0)/* ~/filename */
1889 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1890 newdir
= (unsigned char *) "";
1893 nm
++; /* Don't leave the slash in nm. */
1896 else /* ~user/filename */
1898 /* Get past ~ to user */
1899 unsigned char *user
= nm
+ 1;
1900 /* Find end of name. */
1901 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1902 int len
= ptr
? ptr
- user
: strlen (user
);
1904 unsigned char *ptr1
= index (user
, ':');
1905 if (ptr1
!= 0 && ptr1
- user
< len
)
1908 /* Copy the user name into temp storage. */
1909 o
= (unsigned char *) alloca (len
+ 1);
1910 bcopy ((char *) user
, o
, len
);
1913 /* Look up the user name. */
1914 pw
= (struct passwd
*) getpwnam (o
+ 1);
1916 error ("\"%s\" isn't a registered user", o
+ 1);
1918 newdir
= (unsigned char *) pw
->pw_dir
;
1920 /* Discard the user name from NM. */
1927 #endif /* not VMS */
1931 defalt
= current_buffer
->directory
;
1932 CHECK_STRING (defalt
);
1933 newdir
= SDATA (defalt
);
1936 /* Now concatenate the directory and name to new space in the stack frame */
1938 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1939 target
= (unsigned char *) alloca (tlen
);
1945 if (nm
[0] == 0 || nm
[0] == '/')
1946 strcpy (target
, newdir
);
1949 file_name_as_directory (target
, newdir
);
1952 strcat (target
, nm
);
1954 if (index (target
, '/'))
1955 strcpy (target
, sys_translate_unix (target
));
1958 /* Now canonicalize by removing /. and /foo/.. if they appear */
1966 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1972 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1973 /* brackets are offset from each other by 2 */
1976 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1977 /* convert [foo][bar] to [bar] */
1978 while (o
[-1] != '[' && o
[-1] != '<')
1980 else if (*p
== '-' && *o
!= '.')
1983 else if (p
[0] == '-' && o
[-1] == '.' &&
1984 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1985 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1989 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1990 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1992 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1994 /* else [foo.-] ==> [-] */
2000 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
2001 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2011 else if (!strncmp (p
, "//", 2)
2013 /* // at start of filename is meaningful in Apollo system. */
2021 else if (p
[0] == '/' && p
[1] == '.' &&
2022 (p
[2] == '/' || p
[2] == 0))
2024 else if (!strncmp (p
, "/..", 3)
2025 /* `/../' is the "superroot" on certain file systems. */
2027 && (p
[3] == '/' || p
[3] == 0))
2029 while (o
!= target
&& *--o
!= '/')
2032 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2036 if (o
== target
&& *o
== '/')
2044 #endif /* not VMS */
2047 return make_string (target
, o
- target
);
2051 /* If /~ or // appears, discard everything through first slash. */
2053 file_name_absolute_p (filename
)
2054 const unsigned char *filename
;
2057 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
2059 /* ??? This criterion is probably wrong for '<'. */
2060 || index (filename
, ':') || index (filename
, '<')
2061 || (*filename
== '[' && (filename
[1] != '-'
2062 || (filename
[2] != '.' && filename
[2] != ']'))
2063 && filename
[1] != '.')
2066 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
2067 && IS_DIRECTORY_SEP (filename
[2]))
2072 static unsigned char *
2073 search_embedded_absfilename (nm
, endp
)
2074 unsigned char *nm
, *endp
;
2076 unsigned char *p
, *s
;
2078 for (p
= nm
+ 1; p
< endp
; p
++)
2082 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2084 || IS_DIRECTORY_SEP (p
[-1]))
2085 && file_name_absolute_p (p
)
2086 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2087 /* // at start of file name is meaningful in Apollo,
2088 WindowsNT and Cygwin systems. */
2089 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
2090 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2093 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2098 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2100 unsigned char *o
= alloca (s
- p
+ 1);
2102 bcopy (p
, o
, s
- p
);
2105 /* If we have ~user and `user' exists, discard
2106 everything up to ~. But if `user' does not exist, leave
2107 ~user alone, it might be a literal file name. */
2108 if ((pw
= getpwnam (o
+ 1)))
2120 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2121 Ssubstitute_in_file_name
, 1, 1, 0,
2122 doc
: /* Substitute environment variables referred to in FILENAME.
2123 `$FOO' where FOO is an environment variable name means to substitute
2124 the value of that variable. The variable name should be terminated
2125 with a character not a letter, digit or underscore; otherwise, enclose
2126 the entire variable name in braces.
2127 If `/~' appears, all of FILENAME through that `/' is discarded.
2129 On VMS, `$' substitution is not done; this function does little and only
2130 duplicates what `expand-file-name' does. */)
2132 Lisp_Object filename
;
2136 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2137 unsigned char *target
= NULL
;
2139 int substituted
= 0;
2141 Lisp_Object handler
;
2143 CHECK_STRING (filename
);
2145 /* If the file name has special constructs in it,
2146 call the corresponding file handler. */
2147 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2148 if (!NILP (handler
))
2149 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2151 nm
= SDATA (filename
);
2153 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2154 CORRECT_DIR_SEPS (nm
);
2155 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2157 endp
= nm
+ SBYTES (filename
);
2159 /* If /~ or // appears, discard everything through first slash. */
2160 p
= search_embedded_absfilename (nm
, endp
);
2162 /* Start over with the new string, so we check the file-name-handler
2163 again. Important with filenames like "/home/foo//:/hello///there"
2164 which whould substitute to "/:/hello///there" rather than "/there". */
2165 return Fsubstitute_in_file_name
2166 (make_specified_string (p
, -1, endp
- p
,
2167 STRING_MULTIBYTE (filename
)));
2173 /* See if any variables are substituted into the string
2174 and find the total length of their values in `total' */
2176 for (p
= nm
; p
!= endp
;)
2186 /* "$$" means a single "$" */
2195 while (p
!= endp
&& *p
!= '}') p
++;
2196 if (*p
!= '}') goto missingclose
;
2202 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2206 /* Copy out the variable name */
2207 target
= (unsigned char *) alloca (s
- o
+ 1);
2208 strncpy (target
, o
, s
- o
);
2211 strupr (target
); /* $home == $HOME etc. */
2214 /* Get variable value */
2215 o
= (unsigned char *) egetenv (target
);
2218 total
+= strlen (o
);
2228 /* If substitution required, recopy the string and do it */
2229 /* Make space in stack frame for the new copy */
2230 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2233 /* Copy the rest of the name through, replacing $ constructs with values */
2250 while (p
!= endp
&& *p
!= '}') p
++;
2251 if (*p
!= '}') goto missingclose
;
2257 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2261 /* Copy out the variable name */
2262 target
= (unsigned char *) alloca (s
- o
+ 1);
2263 strncpy (target
, o
, s
- o
);
2266 strupr (target
); /* $home == $HOME etc. */
2269 /* Get variable value */
2270 o
= (unsigned char *) egetenv (target
);
2274 strcpy (x
, target
); x
+= strlen (target
);
2276 else if (STRING_MULTIBYTE (filename
))
2278 /* If the original string is multibyte,
2279 convert what we substitute into multibyte. */
2282 int c
= unibyte_char_to_multibyte (*o
++);
2283 x
+= CHAR_STRING (c
, x
);
2295 /* If /~ or // appears, discard everything through first slash. */
2296 while ((p
= search_embedded_absfilename (xnm
, x
)))
2297 /* This time we do not start over because we've already expanded envvars
2298 and replaced $$ with $. Maybe we should start over as well, but we'd
2299 need to quote some $ to $$ first. */
2302 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2305 error ("Bad format environment-variable substitution");
2307 error ("Missing \"}\" in environment-variable substitution");
2309 error ("Substituting nonexistent environment variable \"%s\"", target
);
2312 #endif /* not VMS */
2316 /* A slightly faster and more convenient way to get
2317 (directory-file-name (expand-file-name FOO)). */
2320 expand_and_dir_to_file (filename
, defdir
)
2321 Lisp_Object filename
, defdir
;
2323 register Lisp_Object absname
;
2325 absname
= Fexpand_file_name (filename
, defdir
);
2328 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2329 if (c
== ':' || c
== ']' || c
== '>')
2330 absname
= Fdirectory_file_name (absname
);
2333 /* Remove final slash, if any (unless this is the root dir).
2334 stat behaves differently depending! */
2335 if (SCHARS (absname
) > 1
2336 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2337 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2338 /* We cannot take shortcuts; they might be wrong for magic file names. */
2339 absname
= Fdirectory_file_name (absname
);
2344 /* Signal an error if the file ABSNAME already exists.
2345 If INTERACTIVE is nonzero, ask the user whether to proceed,
2346 and bypass the error if the user says to go ahead.
2347 QUERYSTRING is a name for the action that is being considered
2350 *STATPTR is used to store the stat information if the file exists.
2351 If the file does not exist, STATPTR->st_mode is set to 0.
2352 If STATPTR is null, we don't store into it.
2354 If QUICK is nonzero, we ask for y or n, not yes or no. */
2357 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2358 Lisp_Object absname
;
2359 unsigned char *querystring
;
2361 struct stat
*statptr
;
2364 register Lisp_Object tem
, encoded_filename
;
2365 struct stat statbuf
;
2366 struct gcpro gcpro1
;
2368 encoded_filename
= ENCODE_FILE (absname
);
2370 /* stat is a good way to tell whether the file exists,
2371 regardless of what access permissions it has. */
2372 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
2375 Fsignal (Qfile_already_exists
,
2376 Fcons (build_string ("File already exists"),
2377 Fcons (absname
, Qnil
)));
2379 tem
= format2 ("File %s already exists; %s anyway? ",
2380 absname
, build_string (querystring
));
2382 tem
= Fy_or_n_p (tem
);
2384 tem
= do_yes_or_no_p (tem
);
2387 Fsignal (Qfile_already_exists
,
2388 Fcons (build_string ("File already exists"),
2389 Fcons (absname
, Qnil
)));
2396 statptr
->st_mode
= 0;
2401 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 5,
2402 "fCopy file: \nGCopy %s to file: \np\nP",
2403 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2404 If NEWNAME names a directory, copy FILE there.
2405 Signals a `file-already-exists' error if file NEWNAME already exists,
2406 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
2407 A number as third arg means request confirmation if NEWNAME already exists.
2408 This is what happens in interactive use with M-x.
2409 Always sets the file modes of the output file to match the input file.
2411 Fourth arg KEEP-TIME non-nil means give the output file the same
2412 last-modified time as the old one. (This works on only some systems.)
2414 A prefix arg makes KEEP-TIME non-nil.
2416 The optional fifth arg MUSTBENEW, if non-nil, insists on a check
2417 for an existing file with the same name. If MUSTBENEW is `excl',
2418 that means to get an error if the file already exists; never overwrite.
2419 If MUSTBENEW is neither nil nor `excl', that means ask for
2420 confirmation before overwriting, but do go ahead and overwrite the file
2421 if the user confirms. */)
2422 (file
, newname
, ok_if_already_exists
, keep_time
, mustbenew
)
2423 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
, mustbenew
;
2426 char buf
[16 * 1024];
2427 struct stat st
, out_st
;
2428 Lisp_Object handler
;
2429 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2430 int count
= SPECPDL_INDEX ();
2431 int input_file_statable_p
;
2432 Lisp_Object encoded_file
, encoded_newname
;
2434 encoded_file
= encoded_newname
= Qnil
;
2435 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2436 CHECK_STRING (file
);
2437 CHECK_STRING (newname
);
2439 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
2440 barf_or_query_if_file_exists (newname
, "overwrite", 1, 0, 1);
2442 if (!NILP (Ffile_directory_p (newname
)))
2443 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2445 newname
= Fexpand_file_name (newname
, Qnil
);
2447 file
= Fexpand_file_name (file
, Qnil
);
2449 /* If the input file name has special constructs in it,
2450 call the corresponding file handler. */
2451 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2452 /* Likewise for output file name. */
2454 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2455 if (!NILP (handler
))
2456 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2457 ok_if_already_exists
, keep_time
));
2459 encoded_file
= ENCODE_FILE (file
);
2460 encoded_newname
= ENCODE_FILE (newname
);
2462 if (NILP (ok_if_already_exists
)
2463 || INTEGERP (ok_if_already_exists
))
2464 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2465 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2466 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2470 if (!CopyFile (SDATA (encoded_file
),
2471 SDATA (encoded_newname
),
2473 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2474 /* CopyFile retains the timestamp by default. */
2475 else if (NILP (keep_time
))
2481 EMACS_GET_TIME (now
);
2482 filename
= SDATA (encoded_newname
);
2484 /* Ensure file is writable while its modified time is set. */
2485 attributes
= GetFileAttributes (filename
);
2486 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2487 if (set_file_times (filename
, now
, now
))
2489 /* Restore original attributes. */
2490 SetFileAttributes (filename
, attributes
);
2491 Fsignal (Qfile_date_error
,
2492 Fcons (build_string ("Cannot set file date"),
2493 Fcons (newname
, Qnil
)));
2495 /* Restore original attributes. */
2496 SetFileAttributes (filename
, attributes
);
2498 #else /* not WINDOWSNT */
2500 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2504 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2506 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2508 /* We can only copy regular files and symbolic links. Other files are not
2510 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2512 #if !defined (DOS_NT) || __DJGPP__ > 1
2513 if (out_st
.st_mode
!= 0
2514 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2517 report_file_error ("Input and output files are the same",
2518 Fcons (file
, Fcons (newname
, Qnil
)));
2522 #if defined (S_ISREG) && defined (S_ISLNK)
2523 if (input_file_statable_p
)
2525 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2527 #if defined (EISDIR)
2528 /* Get a better looking error message. */
2531 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2534 #endif /* S_ISREG && S_ISLNK */
2537 /* Create the copy file with the same record format as the input file */
2538 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2541 /* System's default file type was set to binary by _fmode in emacs.c. */
2542 ofd
= emacs_open (SDATA (encoded_newname
),
2543 O_WRONLY
| O_TRUNC
| O_CREAT
2544 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
2545 S_IREAD
| S_IWRITE
);
2546 #else /* not MSDOS */
2547 ofd
= emacs_open (SDATA (encoded_newname
),
2548 O_WRONLY
| O_TRUNC
| O_CREAT
2549 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
2551 #endif /* not MSDOS */
2554 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2556 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2560 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2561 if (emacs_write (ofd
, buf
, n
) != n
)
2562 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2565 /* Closing the output clobbers the file times on some systems. */
2566 if (emacs_close (ofd
) < 0)
2567 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2569 if (input_file_statable_p
)
2571 if (!NILP (keep_time
))
2573 EMACS_TIME atime
, mtime
;
2574 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2575 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2576 if (set_file_times (SDATA (encoded_newname
),
2578 Fsignal (Qfile_date_error
,
2579 Fcons (build_string ("Cannot set file date"),
2580 Fcons (newname
, Qnil
)));
2583 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2585 #if defined (__DJGPP__) && __DJGPP__ > 1
2586 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2587 and if it can't, it tells so. Otherwise, under MSDOS we usually
2588 get only the READ bit, which will make the copied file read-only,
2589 so it's better not to chmod at all. */
2590 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2591 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2592 #endif /* DJGPP version 2 or newer */
2597 #endif /* WINDOWSNT */
2599 /* Discard the unwind protects. */
2600 specpdl_ptr
= specpdl
+ count
;
2606 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2607 Smake_directory_internal
, 1, 1, 0,
2608 doc
: /* Create a new directory named DIRECTORY. */)
2610 Lisp_Object directory
;
2612 const unsigned char *dir
;
2613 Lisp_Object handler
;
2614 Lisp_Object encoded_dir
;
2616 CHECK_STRING (directory
);
2617 directory
= Fexpand_file_name (directory
, Qnil
);
2619 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2620 if (!NILP (handler
))
2621 return call2 (handler
, Qmake_directory_internal
, directory
);
2623 encoded_dir
= ENCODE_FILE (directory
);
2625 dir
= SDATA (encoded_dir
);
2628 if (mkdir (dir
) != 0)
2630 if (mkdir (dir
, 0777) != 0)
2632 report_file_error ("Creating directory", Flist (1, &directory
));
2637 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2638 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2640 Lisp_Object directory
;
2642 const unsigned char *dir
;
2643 Lisp_Object handler
;
2644 Lisp_Object encoded_dir
;
2646 CHECK_STRING (directory
);
2647 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2649 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2650 if (!NILP (handler
))
2651 return call2 (handler
, Qdelete_directory
, directory
);
2653 encoded_dir
= ENCODE_FILE (directory
);
2655 dir
= SDATA (encoded_dir
);
2657 if (rmdir (dir
) != 0)
2658 report_file_error ("Removing directory", Flist (1, &directory
));
2663 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2664 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2665 If file has multiple names, it continues to exist with the other names. */)
2667 Lisp_Object filename
;
2669 Lisp_Object handler
;
2670 Lisp_Object encoded_file
;
2671 struct gcpro gcpro1
;
2674 if (!NILP (Ffile_directory_p (filename
))
2675 && NILP (Ffile_symlink_p (filename
)))
2676 Fsignal (Qfile_error
,
2677 Fcons (build_string ("Removing old name: is a directory"),
2678 Fcons (filename
, Qnil
)));
2680 filename
= Fexpand_file_name (filename
, Qnil
);
2682 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2683 if (!NILP (handler
))
2684 return call2 (handler
, Qdelete_file
, filename
);
2686 encoded_file
= ENCODE_FILE (filename
);
2688 if (0 > unlink (SDATA (encoded_file
)))
2689 report_file_error ("Removing old name", Flist (1, &filename
));
2694 internal_delete_file_1 (ignore
)
2700 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2703 internal_delete_file (filename
)
2704 Lisp_Object filename
;
2706 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2707 Qt
, internal_delete_file_1
));
2710 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2711 "fRename file: \nGRename %s to file: \np",
2712 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2713 If file has names other than FILE, it continues to have those names.
2714 Signals a `file-already-exists' error if a file NEWNAME already exists
2715 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2716 A number as third arg means request confirmation if NEWNAME already exists.
2717 This is what happens in interactive use with M-x. */)
2718 (file
, newname
, ok_if_already_exists
)
2719 Lisp_Object file
, newname
, ok_if_already_exists
;
2722 Lisp_Object args
[2];
2724 Lisp_Object handler
;
2725 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2726 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2728 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2729 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2730 CHECK_STRING (file
);
2731 CHECK_STRING (newname
);
2732 file
= Fexpand_file_name (file
, Qnil
);
2734 if (!NILP (Ffile_directory_p (newname
)))
2735 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2737 newname
= Fexpand_file_name (newname
, Qnil
);
2739 /* If the file name has special constructs in it,
2740 call the corresponding file handler. */
2741 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2743 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2744 if (!NILP (handler
))
2745 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2746 file
, newname
, ok_if_already_exists
));
2748 encoded_file
= ENCODE_FILE (file
);
2749 encoded_newname
= ENCODE_FILE (newname
);
2752 /* If the file names are identical but for the case, don't ask for
2753 confirmation: they simply want to change the letter-case of the
2755 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2757 if (NILP (ok_if_already_exists
)
2758 || INTEGERP (ok_if_already_exists
))
2759 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2760 INTEGERP (ok_if_already_exists
), 0, 0);
2762 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2764 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2765 || 0 > unlink (SDATA (encoded_file
)))
2771 symlink_target
= Ffile_symlink_p (file
);
2772 if (! NILP (symlink_target
))
2773 Fmake_symbolic_link (symlink_target
, newname
,
2774 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2777 Fcopy_file (file
, newname
,
2778 /* We have already prompted if it was an integer,
2779 so don't have copy-file prompt again. */
2780 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2782 Fdelete_file (file
);
2789 report_file_error ("Renaming", Flist (2, args
));
2792 report_file_error ("Renaming", Flist (2, &file
));
2799 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2800 "fAdd name to file: \nGName to add to %s: \np",
2801 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2802 Signals a `file-already-exists' error if a file NEWNAME already exists
2803 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2804 A number as third arg means request confirmation if NEWNAME already exists.
2805 This is what happens in interactive use with M-x. */)
2806 (file
, newname
, ok_if_already_exists
)
2807 Lisp_Object file
, newname
, ok_if_already_exists
;
2810 Lisp_Object args
[2];
2812 Lisp_Object handler
;
2813 Lisp_Object encoded_file
, encoded_newname
;
2814 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2816 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2817 encoded_file
= encoded_newname
= Qnil
;
2818 CHECK_STRING (file
);
2819 CHECK_STRING (newname
);
2820 file
= Fexpand_file_name (file
, Qnil
);
2822 if (!NILP (Ffile_directory_p (newname
)))
2823 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2825 newname
= Fexpand_file_name (newname
, Qnil
);
2827 /* If the file name has special constructs in it,
2828 call the corresponding file handler. */
2829 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2830 if (!NILP (handler
))
2831 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2832 newname
, ok_if_already_exists
));
2834 /* If the new name has special constructs in it,
2835 call the corresponding file handler. */
2836 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2837 if (!NILP (handler
))
2838 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2839 newname
, ok_if_already_exists
));
2841 encoded_file
= ENCODE_FILE (file
);
2842 encoded_newname
= ENCODE_FILE (newname
);
2844 if (NILP (ok_if_already_exists
)
2845 || INTEGERP (ok_if_already_exists
))
2846 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2847 INTEGERP (ok_if_already_exists
), 0, 0);
2849 unlink (SDATA (newname
));
2850 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2855 report_file_error ("Adding new name", Flist (2, args
));
2857 report_file_error ("Adding new name", Flist (2, &file
));
2866 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2867 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2868 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2869 Both args must be strings.
2870 Signals a `file-already-exists' error if a file LINKNAME already exists
2871 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2872 A number as third arg means request confirmation if LINKNAME already exists.
2873 This happens for interactive use with M-x. */)
2874 (filename
, linkname
, ok_if_already_exists
)
2875 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2878 Lisp_Object args
[2];
2880 Lisp_Object handler
;
2881 Lisp_Object encoded_filename
, encoded_linkname
;
2882 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2884 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2885 encoded_filename
= encoded_linkname
= Qnil
;
2886 CHECK_STRING (filename
);
2887 CHECK_STRING (linkname
);
2888 /* If the link target has a ~, we must expand it to get
2889 a truly valid file name. Otherwise, do not expand;
2890 we want to permit links to relative file names. */
2891 if (SREF (filename
, 0) == '~')
2892 filename
= Fexpand_file_name (filename
, Qnil
);
2894 if (!NILP (Ffile_directory_p (linkname
)))
2895 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2897 linkname
= Fexpand_file_name (linkname
, Qnil
);
2899 /* If the file name has special constructs in it,
2900 call the corresponding file handler. */
2901 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2902 if (!NILP (handler
))
2903 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2904 linkname
, ok_if_already_exists
));
2906 /* If the new link name has special constructs in it,
2907 call the corresponding file handler. */
2908 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2909 if (!NILP (handler
))
2910 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2911 linkname
, ok_if_already_exists
));
2913 encoded_filename
= ENCODE_FILE (filename
);
2914 encoded_linkname
= ENCODE_FILE (linkname
);
2916 if (NILP (ok_if_already_exists
)
2917 || INTEGERP (ok_if_already_exists
))
2918 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2919 INTEGERP (ok_if_already_exists
), 0, 0);
2920 if (0 > symlink (SDATA (encoded_filename
),
2921 SDATA (encoded_linkname
)))
2923 /* If we didn't complain already, silently delete existing file. */
2924 if (errno
== EEXIST
)
2926 unlink (SDATA (encoded_linkname
));
2927 if (0 <= symlink (SDATA (encoded_filename
),
2928 SDATA (encoded_linkname
)))
2938 report_file_error ("Making symbolic link", Flist (2, args
));
2940 report_file_error ("Making symbolic link", Flist (2, &filename
));
2946 #endif /* S_IFLNK */
2950 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2951 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2952 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2953 If STRING is nil or a null string, the logical name NAME is deleted. */)
2958 CHECK_STRING (name
);
2960 delete_logical_name (SDATA (name
));
2963 CHECK_STRING (string
);
2965 if (SCHARS (string
) == 0)
2966 delete_logical_name (SDATA (name
));
2968 define_logical_name (SDATA (name
), SDATA (string
));
2977 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2978 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2980 Lisp_Object path
, login
;
2984 CHECK_STRING (path
);
2985 CHECK_STRING (login
);
2987 netresult
= netunam (SDATA (path
), SDATA (login
));
2989 if (netresult
== -1)
2994 #endif /* HPUX_NET */
2996 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2998 doc
: /* Return t if file FILENAME specifies an absolute file name.
2999 On Unix, this is a name starting with a `/' or a `~'. */)
3001 Lisp_Object filename
;
3003 CHECK_STRING (filename
);
3004 return file_name_absolute_p (SDATA (filename
)) ? Qt
: Qnil
;
3007 /* Return nonzero if file FILENAME exists and can be executed. */
3010 check_executable (filename
)
3014 int len
= strlen (filename
);
3017 if (stat (filename
, &st
) < 0)
3019 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
3020 return ((st
.st_mode
& S_IEXEC
) != 0);
3022 return (S_ISREG (st
.st_mode
)
3024 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
3025 || stricmp (suffix
, ".exe") == 0
3026 || stricmp (suffix
, ".bat") == 0)
3027 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3028 #endif /* not WINDOWSNT */
3029 #else /* not DOS_NT */
3030 #ifdef HAVE_EUIDACCESS
3031 return (euidaccess (filename
, 1) >= 0);
3033 /* Access isn't quite right because it uses the real uid
3034 and we really want to test with the effective uid.
3035 But Unix doesn't give us a right way to do it. */
3036 return (access (filename
, 1) >= 0);
3038 #endif /* not DOS_NT */
3041 /* Return nonzero if file FILENAME exists and can be written. */
3044 check_writable (filename
)
3049 if (stat (filename
, &st
) < 0)
3051 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3052 #else /* not MSDOS */
3053 #ifdef HAVE_EUIDACCESS
3054 return (euidaccess (filename
, 2) >= 0);
3056 /* Access isn't quite right because it uses the real uid
3057 and we really want to test with the effective uid.
3058 But Unix doesn't give us a right way to do it.
3059 Opening with O_WRONLY could work for an ordinary file,
3060 but would lose for directories. */
3061 return (access (filename
, 2) >= 0);
3063 #endif /* not MSDOS */
3066 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3067 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
3068 See also `file-readable-p' and `file-attributes'.
3069 This returns nil for a symlink to a nonexistent file.
3070 Use `file-symlink-p' to test for such links. */)
3072 Lisp_Object filename
;
3074 Lisp_Object absname
;
3075 Lisp_Object handler
;
3076 struct stat statbuf
;
3078 CHECK_STRING (filename
);
3079 absname
= Fexpand_file_name (filename
, Qnil
);
3081 /* If the file name has special constructs in it,
3082 call the corresponding file handler. */
3083 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3084 if (!NILP (handler
))
3085 return call2 (handler
, Qfile_exists_p
, absname
);
3087 absname
= ENCODE_FILE (absname
);
3089 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3092 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3093 doc
: /* Return t if FILENAME can be executed by you.
3094 For a directory, this means you can access files in that directory. */)
3096 Lisp_Object filename
;
3098 Lisp_Object absname
;
3099 Lisp_Object handler
;
3101 CHECK_STRING (filename
);
3102 absname
= Fexpand_file_name (filename
, Qnil
);
3104 /* If the file name has special constructs in it,
3105 call the corresponding file handler. */
3106 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3107 if (!NILP (handler
))
3108 return call2 (handler
, Qfile_executable_p
, absname
);
3110 absname
= ENCODE_FILE (absname
);
3112 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3115 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3116 doc
: /* Return t if file FILENAME exists and you can read it.
3117 See also `file-exists-p' and `file-attributes'. */)
3119 Lisp_Object filename
;
3121 Lisp_Object absname
;
3122 Lisp_Object handler
;
3125 struct stat statbuf
;
3127 CHECK_STRING (filename
);
3128 absname
= Fexpand_file_name (filename
, Qnil
);
3130 /* If the file name has special constructs in it,
3131 call the corresponding file handler. */
3132 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3133 if (!NILP (handler
))
3134 return call2 (handler
, Qfile_readable_p
, absname
);
3136 absname
= ENCODE_FILE (absname
);
3138 #if defined(DOS_NT) || defined(macintosh)
3139 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3141 if (access (SDATA (absname
), 0) == 0)
3144 #else /* not DOS_NT and not macintosh */
3146 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3147 /* Opening a fifo without O_NONBLOCK can wait.
3148 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3149 except in the case of a fifo, on a system which handles it. */
3150 desc
= stat (SDATA (absname
), &statbuf
);
3153 if (S_ISFIFO (statbuf
.st_mode
))
3154 flags
|= O_NONBLOCK
;
3156 desc
= emacs_open (SDATA (absname
), flags
, 0);
3161 #endif /* not DOS_NT and not macintosh */
3164 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3166 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3167 doc
: /* Return t if file FILENAME can be written or created by you. */)
3169 Lisp_Object filename
;
3171 Lisp_Object absname
, dir
, encoded
;
3172 Lisp_Object handler
;
3173 struct stat statbuf
;
3175 CHECK_STRING (filename
);
3176 absname
= Fexpand_file_name (filename
, Qnil
);
3178 /* If the file name has special constructs in it,
3179 call the corresponding file handler. */
3180 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3181 if (!NILP (handler
))
3182 return call2 (handler
, Qfile_writable_p
, absname
);
3184 encoded
= ENCODE_FILE (absname
);
3185 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3186 return (check_writable (SDATA (encoded
))
3189 dir
= Ffile_name_directory (absname
);
3192 dir
= Fdirectory_file_name (dir
);
3196 dir
= Fdirectory_file_name (dir
);
3199 dir
= ENCODE_FILE (dir
);
3201 /* The read-only attribute of the parent directory doesn't affect
3202 whether a file or directory can be created within it. Some day we
3203 should check ACLs though, which do affect this. */
3204 if (stat (SDATA (dir
), &statbuf
) < 0)
3206 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3208 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3213 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3214 doc
: /* Access file FILENAME, and get an error if that does not work.
3215 The second argument STRING is used in the error message.
3216 If there is no error, returns nil. */)
3218 Lisp_Object filename
, string
;
3220 Lisp_Object handler
, encoded_filename
, absname
;
3223 CHECK_STRING (filename
);
3224 absname
= Fexpand_file_name (filename
, Qnil
);
3226 CHECK_STRING (string
);
3228 /* If the file name has special constructs in it,
3229 call the corresponding file handler. */
3230 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3231 if (!NILP (handler
))
3232 return call3 (handler
, Qaccess_file
, absname
, string
);
3234 encoded_filename
= ENCODE_FILE (absname
);
3236 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3238 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3244 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3245 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3246 The value is the link target, as a string.
3247 Otherwise it returns nil.
3249 This function returns t when given the name of a symlink that
3250 points to a nonexistent file. */)
3252 Lisp_Object filename
;
3254 Lisp_Object handler
;
3256 CHECK_STRING (filename
);
3257 filename
= Fexpand_file_name (filename
, Qnil
);
3259 /* If the file name has special constructs in it,
3260 call the corresponding file handler. */
3261 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3262 if (!NILP (handler
))
3263 return call2 (handler
, Qfile_symlink_p
, filename
);
3272 filename
= ENCODE_FILE (filename
);
3279 buf
= (char *) xrealloc (buf
, bufsize
);
3280 bzero (buf
, bufsize
);
3283 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3287 /* HP-UX reports ERANGE if buffer is too small. */
3288 if (errno
== ERANGE
)
3298 while (valsize
>= bufsize
);
3300 val
= make_string (buf
, valsize
);
3301 if (buf
[0] == '/' && index (buf
, ':'))
3302 val
= concat2 (build_string ("/:"), val
);
3304 val
= DECODE_FILE (val
);
3307 #else /* not S_IFLNK */
3309 #endif /* not S_IFLNK */
3312 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3313 doc
: /* Return t if FILENAME names an existing directory.
3314 Symbolic links to directories count as directories.
3315 See `file-symlink-p' to distinguish symlinks. */)
3317 Lisp_Object filename
;
3319 register Lisp_Object absname
;
3321 Lisp_Object handler
;
3323 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3325 /* If the file name has special constructs in it,
3326 call the corresponding file handler. */
3327 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3328 if (!NILP (handler
))
3329 return call2 (handler
, Qfile_directory_p
, absname
);
3331 absname
= ENCODE_FILE (absname
);
3333 if (stat (SDATA (absname
), &st
) < 0)
3335 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3338 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3339 doc
: /* Return t if file FILENAME names a directory you can open.
3340 For the value to be t, FILENAME must specify the name of a directory as a file,
3341 and the directory must allow you to open files in it. In order to use a
3342 directory as a buffer's current directory, this predicate must return true.
3343 A directory name spec may be given instead; then the value is t
3344 if the directory so specified exists and really is a readable and
3345 searchable directory. */)
3347 Lisp_Object filename
;
3349 Lisp_Object handler
;
3351 struct gcpro gcpro1
;
3353 /* If the file name has special constructs in it,
3354 call the corresponding file handler. */
3355 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3356 if (!NILP (handler
))
3357 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3360 tem
= (NILP (Ffile_directory_p (filename
))
3361 || NILP (Ffile_executable_p (filename
)));
3363 return tem
? Qnil
: Qt
;
3366 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3367 doc
: /* Return t if file FILENAME is the name of a regular file.
3368 This is the sort of file that holds an ordinary stream of data bytes. */)
3370 Lisp_Object filename
;
3372 register Lisp_Object absname
;
3374 Lisp_Object handler
;
3376 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3378 /* If the file name has special constructs in it,
3379 call the corresponding file handler. */
3380 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3381 if (!NILP (handler
))
3382 return call2 (handler
, Qfile_regular_p
, absname
);
3384 absname
= ENCODE_FILE (absname
);
3389 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3391 /* Tell stat to use expensive method to get accurate info. */
3392 Vw32_get_true_file_attributes
= Qt
;
3393 result
= stat (SDATA (absname
), &st
);
3394 Vw32_get_true_file_attributes
= tem
;
3398 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3401 if (stat (SDATA (absname
), &st
) < 0)
3403 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3407 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3408 doc
: /* Return mode bits of file named FILENAME, as an integer.
3409 Return nil, if file does not exist or is not accessible. */)
3411 Lisp_Object filename
;
3413 Lisp_Object absname
;
3415 Lisp_Object handler
;
3417 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3419 /* If the file name has special constructs in it,
3420 call the corresponding file handler. */
3421 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3422 if (!NILP (handler
))
3423 return call2 (handler
, Qfile_modes
, absname
);
3425 absname
= ENCODE_FILE (absname
);
3427 if (stat (SDATA (absname
), &st
) < 0)
3429 #if defined (MSDOS) && __DJGPP__ < 2
3430 if (check_executable (SDATA (absname
)))
3431 st
.st_mode
|= S_IEXEC
;
3432 #endif /* MSDOS && __DJGPP__ < 2 */
3434 return make_number (st
.st_mode
& 07777);
3437 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3438 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3439 Only the 12 low bits of MODE are used. */)
3441 Lisp_Object filename
, mode
;
3443 Lisp_Object absname
, encoded_absname
;
3444 Lisp_Object handler
;
3446 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3447 CHECK_NUMBER (mode
);
3449 /* If the file name has special constructs in it,
3450 call the corresponding file handler. */
3451 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3452 if (!NILP (handler
))
3453 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3455 encoded_absname
= ENCODE_FILE (absname
);
3457 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3458 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3463 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3464 doc
: /* Set the file permission bits for newly created files.
3465 The argument MODE should be an integer; only the low 9 bits are used.
3466 This setting is inherited by subprocesses. */)
3470 CHECK_NUMBER (mode
);
3472 umask ((~ XINT (mode
)) & 0777);
3477 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3478 doc
: /* Return the default file protection for created files.
3479 The value is an integer. */)
3485 realmask
= umask (0);
3488 XSETINT (value
, (~ realmask
) & 0777);
3492 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3494 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3495 doc
: /* Set times of file FILENAME to TIME.
3496 Set both access and modification times.
3497 Return t on success, else nil.
3498 Use the current time if TIME is nil. TIME is in the format of
3501 Lisp_Object filename
, time
;
3503 Lisp_Object absname
, encoded_absname
;
3504 Lisp_Object handler
;
3508 if (! lisp_time_argument (time
, &sec
, &usec
))
3509 error ("Invalid time specification");
3511 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3513 /* If the file name has special constructs in it,
3514 call the corresponding file handler. */
3515 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3516 if (!NILP (handler
))
3517 return call3 (handler
, Qset_file_times
, absname
, time
);
3519 encoded_absname
= ENCODE_FILE (absname
);
3524 EMACS_SET_SECS (t
, sec
);
3525 EMACS_SET_USECS (t
, usec
);
3527 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3532 /* Setting times on a directory always fails. */
3533 if (stat (SDATA (encoded_absname
), &st
) == 0
3534 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3537 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3550 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3551 doc
: /* Tell Unix to finish all pending disk updates. */)
3560 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3561 doc
: /* Return t if file FILE1 is newer than file FILE2.
3562 If FILE1 does not exist, the answer is nil;
3563 otherwise, if FILE2 does not exist, the answer is t. */)
3565 Lisp_Object file1
, file2
;
3567 Lisp_Object absname1
, absname2
;
3570 Lisp_Object handler
;
3571 struct gcpro gcpro1
, gcpro2
;
3573 CHECK_STRING (file1
);
3574 CHECK_STRING (file2
);
3577 GCPRO2 (absname1
, file2
);
3578 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3579 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3582 /* If the file name has special constructs in it,
3583 call the corresponding file handler. */
3584 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3586 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3587 if (!NILP (handler
))
3588 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3590 GCPRO2 (absname1
, absname2
);
3591 absname1
= ENCODE_FILE (absname1
);
3592 absname2
= ENCODE_FILE (absname2
);
3595 if (stat (SDATA (absname1
), &st
) < 0)
3598 mtime1
= st
.st_mtime
;
3600 if (stat (SDATA (absname2
), &st
) < 0)
3603 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3607 Lisp_Object Qfind_buffer_file_type
;
3610 #ifndef READ_BUF_SIZE
3611 #define READ_BUF_SIZE (64 << 10)
3614 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3616 /* This function is called after Lisp functions to decide a coding
3617 system are called, or when they cause an error. Before they are
3618 called, the current buffer is set unibyte and it contains only a
3619 newly inserted text (thus the buffer was empty before the
3622 The functions may set markers, overlays, text properties, or even
3623 alter the buffer contents, change the current buffer.
3625 Here, we reset all those changes by:
3626 o set back the current buffer.
3627 o move all markers and overlays to BEG.
3628 o remove all text properties.
3629 o set back the buffer multibyteness. */
3632 decide_coding_unwind (unwind_data
)
3633 Lisp_Object unwind_data
;
3635 Lisp_Object multibyte
, undo_list
, buffer
;
3637 multibyte
= XCAR (unwind_data
);
3638 unwind_data
= XCDR (unwind_data
);
3639 undo_list
= XCAR (unwind_data
);
3640 buffer
= XCDR (unwind_data
);
3642 if (current_buffer
!= XBUFFER (buffer
))
3643 set_buffer_internal (XBUFFER (buffer
));
3644 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3645 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3646 BUF_INTERVALS (current_buffer
) = 0;
3647 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3649 /* Now we are safe to change the buffer's multibyteness directly. */
3650 current_buffer
->enable_multibyte_characters
= multibyte
;
3651 current_buffer
->undo_list
= undo_list
;
3657 /* Used to pass values from insert-file-contents to read_non_regular. */
3659 static int non_regular_fd
;
3660 static int non_regular_inserted
;
3661 static int non_regular_nbytes
;
3664 /* Read from a non-regular file.
3665 Read non_regular_trytry bytes max from non_regular_fd.
3666 Non_regular_inserted specifies where to put the read bytes.
3667 Value is the number of bytes read. */
3676 nbytes
= emacs_read (non_regular_fd
,
3677 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3678 non_regular_nbytes
);
3680 return make_number (nbytes
);
3684 /* Condition-case handler used when reading from non-regular files
3685 in insert-file-contents. */
3688 read_non_regular_quit ()
3694 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3696 doc
: /* Insert contents of file FILENAME after point.
3697 Returns list of absolute file name and number of characters inserted.
3698 If second argument VISIT is non-nil, the buffer's visited filename
3699 and last save file modtime are set, and it is marked unmodified.
3700 If visiting and the file does not exist, visiting is completed
3701 before the error is signaled.
3702 The optional third and fourth arguments BEG and END
3703 specify what portion of the file to insert.
3704 These arguments count bytes in the file, not characters in the buffer.
3705 If VISIT is non-nil, BEG and END must be nil.
3707 If optional fifth argument REPLACE is non-nil,
3708 it means replace the current buffer contents (in the accessible portion)
3709 with the file contents. This is better than simply deleting and inserting
3710 the whole thing because (1) it preserves some marker positions
3711 and (2) it puts less data in the undo list.
3712 When REPLACE is non-nil, the value is the number of characters actually read,
3713 which is often less than the number of characters to be read.
3715 This does code conversion according to the value of
3716 `coding-system-for-read' or `file-coding-system-alist',
3717 and sets the variable `last-coding-system-used' to the coding system
3719 (filename
, visit
, beg
, end
, replace
)
3720 Lisp_Object filename
, visit
, beg
, end
, replace
;
3725 register int how_much
;
3726 register int unprocessed
;
3727 int count
= SPECPDL_INDEX ();
3728 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3729 Lisp_Object handler
, val
, insval
, orig_filename
;
3732 int not_regular
= 0;
3733 unsigned char read_buf
[READ_BUF_SIZE
];
3734 struct coding_system coding
;
3735 unsigned char buffer
[1 << 14];
3736 int replace_handled
= 0;
3737 int set_coding_system
= 0;
3738 int coding_system_decided
= 0;
3740 int old_Vdeactivate_mark
= Vdeactivate_mark
;
3741 int we_locked_file
= 0;
3743 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3744 error ("Cannot do file visiting in an indirect buffer");
3746 if (!NILP (current_buffer
->read_only
))
3747 Fbarf_if_buffer_read_only ();
3751 orig_filename
= Qnil
;
3753 GCPRO4 (filename
, val
, p
, orig_filename
);
3755 CHECK_STRING (filename
);
3756 filename
= Fexpand_file_name (filename
, Qnil
);
3758 /* If the file name has special constructs in it,
3759 call the corresponding file handler. */
3760 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3761 if (!NILP (handler
))
3763 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3764 visit
, beg
, end
, replace
);
3765 if (CONSP (val
) && CONSP (XCDR (val
)))
3766 inserted
= XINT (XCAR (XCDR (val
)));
3770 orig_filename
= filename
;
3771 filename
= ENCODE_FILE (filename
);
3777 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3779 /* Tell stat to use expensive method to get accurate info. */
3780 Vw32_get_true_file_attributes
= Qt
;
3781 total
= stat (SDATA (filename
), &st
);
3782 Vw32_get_true_file_attributes
= tem
;
3787 if (stat (SDATA (filename
), &st
) < 0)
3789 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3790 || fstat (fd
, &st
) < 0)
3791 #endif /* not APOLLO */
3792 #endif /* WINDOWSNT */
3794 if (fd
>= 0) emacs_close (fd
);
3797 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3800 if (!NILP (Vcoding_system_for_read
))
3801 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3806 /* This code will need to be changed in order to work on named
3807 pipes, and it's probably just not worth it. So we should at
3808 least signal an error. */
3809 if (!S_ISREG (st
.st_mode
))
3816 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3817 Fsignal (Qfile_error
,
3818 Fcons (build_string ("not a regular file"),
3819 Fcons (orig_filename
, Qnil
)));
3824 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3827 /* Replacement should preserve point as it preserves markers. */
3828 if (!NILP (replace
))
3829 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3831 record_unwind_protect (close_file_unwind
, make_number (fd
));
3833 /* Supposedly happens on VMS. */
3834 /* Can happen on any platform that uses long as type of off_t, but allows
3835 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3836 give a message suitable for the latter case. */
3837 if (! not_regular
&& st
.st_size
< 0)
3838 error ("Maximum buffer size exceeded");
3840 /* Prevent redisplay optimizations. */
3841 current_buffer
->clip_changed
= 1;
3845 if (!NILP (beg
) || !NILP (end
))
3846 error ("Attempt to visit less than an entire file");
3847 if (BEG
< Z
&& NILP (replace
))
3848 error ("Cannot do file visiting in a non-empty buffer");
3854 XSETFASTINT (beg
, 0);
3862 XSETINT (end
, st
.st_size
);
3864 /* Arithmetic overflow can occur if an Emacs integer cannot
3865 represent the file size, or if the calculations below
3866 overflow. The calculations below double the file size
3867 twice, so check that it can be multiplied by 4 safely. */
3868 if (XINT (end
) != st
.st_size
3869 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3870 error ("Maximum buffer size exceeded");
3872 /* The file size returned from stat may be zero, but data
3873 may be readable nonetheless, for example when this is a
3874 file in the /proc filesystem. */
3875 if (st
.st_size
== 0)
3876 XSETINT (end
, READ_BUF_SIZE
);
3880 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3882 /* We use emacs-mule for auto saving... */
3883 setup_coding_system (Qemacs_mule
, &coding
);
3884 /* ... but with the special flag to indicate to read in a
3885 multibyte sequence for eight-bit-control char as is. */
3887 coding
.src_multibyte
= 0;
3888 coding
.dst_multibyte
3889 = !NILP (current_buffer
->enable_multibyte_characters
);
3890 coding
.eol_type
= CODING_EOL_LF
;
3891 coding_system_decided
= 1;
3895 /* Decide the coding system to use for reading the file now
3896 because we can't use an optimized method for handling
3897 `coding:' tag if the current buffer is not empty. */
3901 if (!NILP (Vcoding_system_for_read
))
3902 val
= Vcoding_system_for_read
;
3905 /* Don't try looking inside a file for a coding system
3906 specification if it is not seekable. */
3907 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3909 /* Find a coding system specified in the heading two
3910 lines or in the tailing several lines of the file.
3911 We assume that the 1K-byte and 3K-byte for heading
3912 and tailing respectively are sufficient for this
3916 if (st
.st_size
<= (1024 * 4))
3917 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3920 nread
= emacs_read (fd
, read_buf
, 1024);
3923 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3924 report_file_error ("Setting file position",
3925 Fcons (orig_filename
, Qnil
));
3926 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3931 error ("IO error reading %s: %s",
3932 SDATA (orig_filename
), emacs_strerror (errno
));
3935 struct buffer
*prev
= current_buffer
;
3939 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3941 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3942 buf
= XBUFFER (buffer
);
3944 delete_all_overlays (buf
);
3945 buf
->directory
= current_buffer
->directory
;
3946 buf
->read_only
= Qnil
;
3947 buf
->filename
= Qnil
;
3948 buf
->undo_list
= Qt
;
3949 eassert (buf
->overlays_before
== NULL
);
3950 eassert (buf
->overlays_after
== NULL
);
3952 set_buffer_internal (buf
);
3954 buf
->enable_multibyte_characters
= Qnil
;
3956 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3957 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3958 val
= call2 (Vset_auto_coding_function
,
3959 filename
, make_number (nread
));
3960 set_buffer_internal (prev
);
3962 /* Discard the unwind protect for recovering the
3966 /* Rewind the file for the actual read done later. */
3967 if (lseek (fd
, 0, 0) < 0)
3968 report_file_error ("Setting file position",
3969 Fcons (orig_filename
, Qnil
));
3975 /* If we have not yet decided a coding system, check
3976 file-coding-system-alist. */
3977 Lisp_Object args
[6], coding_systems
;
3979 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3980 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3981 coding_systems
= Ffind_operation_coding_system (6, args
);
3982 if (CONSP (coding_systems
))
3983 val
= XCAR (coding_systems
);
3987 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3988 /* Ensure we set Vlast_coding_system_used. */
3989 set_coding_system
= 1;
3991 if (NILP (current_buffer
->enable_multibyte_characters
)
3993 /* We must suppress all character code conversion except for
3994 end-of-line conversion. */
3995 setup_raw_text_coding_system (&coding
);
3997 coding
.src_multibyte
= 0;
3998 coding
.dst_multibyte
3999 = !NILP (current_buffer
->enable_multibyte_characters
);
4000 coding_system_decided
= 1;
4003 /* If requested, replace the accessible part of the buffer
4004 with the file contents. Avoid replacing text at the
4005 beginning or end of the buffer that matches the file contents;
4006 that preserves markers pointing to the unchanged parts.
4008 Here we implement this feature in an optimized way
4009 for the case where code conversion is NOT needed.
4010 The following if-statement handles the case of conversion
4011 in a less optimal way.
4013 If the code conversion is "automatic" then we try using this
4014 method and hope for the best.
4015 But if we discover the need for conversion, we give up on this method
4016 and let the following if-statement handle the replace job. */
4019 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
4021 /* same_at_start and same_at_end count bytes,
4022 because file access counts bytes
4023 and BEG and END count bytes. */
4024 int same_at_start
= BEGV_BYTE
;
4025 int same_at_end
= ZV_BYTE
;
4027 /* There is still a possibility we will find the need to do code
4028 conversion. If that happens, we set this variable to 1 to
4029 give up on handling REPLACE in the optimized way. */
4030 int giveup_match_end
= 0;
4032 if (XINT (beg
) != 0)
4034 if (lseek (fd
, XINT (beg
), 0) < 0)
4035 report_file_error ("Setting file position",
4036 Fcons (orig_filename
, Qnil
));
4041 /* Count how many chars at the start of the file
4042 match the text at the beginning of the buffer. */
4047 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4049 error ("IO error reading %s: %s",
4050 SDATA (orig_filename
), emacs_strerror (errno
));
4051 else if (nread
== 0)
4054 if (coding
.type
== coding_type_undecided
)
4055 detect_coding (&coding
, buffer
, nread
);
4056 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
4057 /* We found that the file should be decoded somehow.
4058 Let's give up here. */
4060 giveup_match_end
= 1;
4064 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
4065 detect_eol (&coding
, buffer
, nread
);
4066 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
4067 && coding
.eol_type
!= CODING_EOL_LF
)
4068 /* We found that the format of eol should be decoded.
4069 Let's give up here. */
4071 giveup_match_end
= 1;
4076 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4077 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4078 same_at_start
++, bufpos
++;
4079 /* If we found a discrepancy, stop the scan.
4080 Otherwise loop around and scan the next bufferful. */
4081 if (bufpos
!= nread
)
4085 /* If the file matches the buffer completely,
4086 there's no need to replace anything. */
4087 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4091 /* Truncate the buffer to the size of the file. */
4092 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4097 /* Count how many chars at the end of the file
4098 match the text at the end of the buffer. But, if we have
4099 already found that decoding is necessary, don't waste time. */
4100 while (!giveup_match_end
)
4102 int total_read
, nread
, bufpos
, curpos
, trial
;
4104 /* At what file position are we now scanning? */
4105 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4106 /* If the entire file matches the buffer tail, stop the scan. */
4109 /* How much can we scan in the next step? */
4110 trial
= min (curpos
, sizeof buffer
);
4111 if (lseek (fd
, curpos
- trial
, 0) < 0)
4112 report_file_error ("Setting file position",
4113 Fcons (orig_filename
, Qnil
));
4115 total_read
= nread
= 0;
4116 while (total_read
< trial
)
4118 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4120 error ("IO error reading %s: %s",
4121 SDATA (orig_filename
), emacs_strerror (errno
));
4122 else if (nread
== 0)
4124 total_read
+= nread
;
4127 /* Scan this bufferful from the end, comparing with
4128 the Emacs buffer. */
4129 bufpos
= total_read
;
4131 /* Compare with same_at_start to avoid counting some buffer text
4132 as matching both at the file's beginning and at the end. */
4133 while (bufpos
> 0 && same_at_end
> same_at_start
4134 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4135 same_at_end
--, bufpos
--;
4137 /* If we found a discrepancy, stop the scan.
4138 Otherwise loop around and scan the preceding bufferful. */
4141 /* If this discrepancy is because of code conversion,
4142 we cannot use this method; giveup and try the other. */
4143 if (same_at_end
> same_at_start
4144 && FETCH_BYTE (same_at_end
- 1) >= 0200
4145 && ! NILP (current_buffer
->enable_multibyte_characters
)
4146 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4147 giveup_match_end
= 1;
4156 if (! giveup_match_end
)
4160 /* We win! We can handle REPLACE the optimized way. */
4162 /* Extend the start of non-matching text area to multibyte
4163 character boundary. */
4164 if (! NILP (current_buffer
->enable_multibyte_characters
))
4165 while (same_at_start
> BEGV_BYTE
4166 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4169 /* Extend the end of non-matching text area to multibyte
4170 character boundary. */
4171 if (! NILP (current_buffer
->enable_multibyte_characters
))
4172 while (same_at_end
< ZV_BYTE
4173 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4176 /* Don't try to reuse the same piece of text twice. */
4177 overlap
= (same_at_start
- BEGV_BYTE
4178 - (same_at_end
+ st
.st_size
- ZV
));
4180 same_at_end
+= overlap
;
4182 /* Arrange to read only the nonmatching middle part of the file. */
4183 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4184 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4186 del_range_byte (same_at_start
, same_at_end
, 0);
4187 /* Insert from the file at the proper position. */
4188 temp
= BYTE_TO_CHAR (same_at_start
);
4189 SET_PT_BOTH (temp
, same_at_start
);
4191 /* If display currently starts at beginning of line,
4192 keep it that way. */
4193 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4194 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4196 replace_handled
= 1;
4200 /* If requested, replace the accessible part of the buffer
4201 with the file contents. Avoid replacing text at the
4202 beginning or end of the buffer that matches the file contents;
4203 that preserves markers pointing to the unchanged parts.
4205 Here we implement this feature for the case where code conversion
4206 is needed, in a simple way that needs a lot of memory.
4207 The preceding if-statement handles the case of no conversion
4208 in a more optimized way. */
4209 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4211 int same_at_start
= BEGV_BYTE
;
4212 int same_at_end
= ZV_BYTE
;
4215 /* Make sure that the gap is large enough. */
4216 int bufsize
= 2 * st
.st_size
;
4217 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4220 /* First read the whole file, performing code conversion into
4221 CONVERSION_BUFFER. */
4223 if (lseek (fd
, XINT (beg
), 0) < 0)
4225 xfree (conversion_buffer
);
4226 report_file_error ("Setting file position",
4227 Fcons (orig_filename
, Qnil
));
4230 total
= st
.st_size
; /* Total bytes in the file. */
4231 how_much
= 0; /* Bytes read from file so far. */
4232 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4233 unprocessed
= 0; /* Bytes not processed in previous loop. */
4235 while (how_much
< total
)
4237 /* try is reserved in some compilers (Microsoft C) */
4238 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4239 unsigned char *destination
= read_buf
+ unprocessed
;
4242 /* Allow quitting out of the actual I/O. */
4245 this = emacs_read (fd
, destination
, trytry
);
4248 if (this < 0 || this + unprocessed
== 0)
4256 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4258 int require
, result
;
4260 this += unprocessed
;
4262 /* If we are using more space than estimated,
4263 make CONVERSION_BUFFER bigger. */
4264 require
= decoding_buffer_size (&coding
, this);
4265 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4267 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4268 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4271 /* Convert this batch with results in CONVERSION_BUFFER. */
4272 if (how_much
>= total
) /* This is the last block. */
4273 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4274 if (coding
.composing
!= COMPOSITION_DISABLED
)
4275 coding_allocate_composition_data (&coding
, BEGV
);
4276 result
= decode_coding (&coding
, read_buf
,
4277 conversion_buffer
+ inserted
,
4278 this, bufsize
- inserted
);
4280 /* Save for next iteration whatever we didn't convert. */
4281 unprocessed
= this - coding
.consumed
;
4282 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4283 if (!NILP (current_buffer
->enable_multibyte_characters
))
4284 this = coding
.produced
;
4286 this = str_as_unibyte (conversion_buffer
+ inserted
,
4293 /* At this point, INSERTED is how many characters (i.e. bytes)
4294 are present in CONVERSION_BUFFER.
4295 HOW_MUCH should equal TOTAL,
4296 or should be <= 0 if we couldn't read the file. */
4300 xfree (conversion_buffer
);
4301 coding_free_composition_data (&coding
);
4303 error ("IO error reading %s: %s",
4304 SDATA (orig_filename
), emacs_strerror (errno
));
4305 else if (how_much
== -2)
4306 error ("maximum buffer size exceeded");
4309 /* Compare the beginning of the converted file
4310 with the buffer text. */
4313 while (bufpos
< inserted
&& same_at_start
< same_at_end
4314 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4315 same_at_start
++, bufpos
++;
4317 /* If the file matches the buffer completely,
4318 there's no need to replace anything. */
4320 if (bufpos
== inserted
)
4322 xfree (conversion_buffer
);
4323 coding_free_composition_data (&coding
);
4326 /* Truncate the buffer to the size of the file. */
4327 del_range_byte (same_at_start
, same_at_end
, 0);
4332 /* Extend the start of non-matching text area to multibyte
4333 character boundary. */
4334 if (! NILP (current_buffer
->enable_multibyte_characters
))
4335 while (same_at_start
> BEGV_BYTE
4336 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4339 /* Scan this bufferful from the end, comparing with
4340 the Emacs buffer. */
4343 /* Compare with same_at_start to avoid counting some buffer text
4344 as matching both at the file's beginning and at the end. */
4345 while (bufpos
> 0 && same_at_end
> same_at_start
4346 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4347 same_at_end
--, bufpos
--;
4349 /* Extend the end of non-matching text area to multibyte
4350 character boundary. */
4351 if (! NILP (current_buffer
->enable_multibyte_characters
))
4352 while (same_at_end
< ZV_BYTE
4353 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4356 /* Don't try to reuse the same piece of text twice. */
4357 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4359 same_at_end
+= overlap
;
4361 /* If display currently starts at beginning of line,
4362 keep it that way. */
4363 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4364 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4366 /* Replace the chars that we need to replace,
4367 and update INSERTED to equal the number of bytes
4368 we are taking from the file. */
4369 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4371 if (same_at_end
!= same_at_start
)
4373 del_range_byte (same_at_start
, same_at_end
, 0);
4375 same_at_start
= GPT_BYTE
;
4379 temp
= BYTE_TO_CHAR (same_at_start
);
4381 /* Insert from the file at the proper position. */
4382 SET_PT_BOTH (temp
, same_at_start
);
4383 insert_1 (conversion_buffer
+ same_at_start
- BEGV_BYTE
, inserted
,
4385 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4386 coding_restore_composition (&coding
, Fcurrent_buffer ());
4387 coding_free_composition_data (&coding
);
4389 /* Set `inserted' to the number of inserted characters. */
4390 inserted
= PT
- temp
;
4392 xfree (conversion_buffer
);
4401 register Lisp_Object temp
;
4403 total
= XINT (end
) - XINT (beg
);
4405 /* Make sure point-max won't overflow after this insertion. */
4406 XSETINT (temp
, total
);
4407 if (total
!= XINT (temp
))
4408 error ("Maximum buffer size exceeded");
4411 /* For a special file, all we can do is guess. */
4412 total
= READ_BUF_SIZE
;
4414 if (NILP (visit
) && inserted
> 0)
4416 #ifdef CLASH_DETECTION
4417 if (!NILP (current_buffer
->file_truename
)
4418 /* Make binding buffer-file-name to nil effective. */
4419 && !NILP (current_buffer
->filename
)
4420 && SAVE_MODIFF
>= MODIFF
)
4422 #endif /* CLASH_DETECTION */
4423 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
4427 if (GAP_SIZE
< total
)
4428 make_gap (total
- GAP_SIZE
);
4430 if (XINT (beg
) != 0 || !NILP (replace
))
4432 if (lseek (fd
, XINT (beg
), 0) < 0)
4433 report_file_error ("Setting file position",
4434 Fcons (orig_filename
, Qnil
));
4437 /* In the following loop, HOW_MUCH contains the total bytes read so
4438 far for a regular file, and not changed for a special file. But,
4439 before exiting the loop, it is set to a negative value if I/O
4443 /* Total bytes inserted. */
4446 /* Here, we don't do code conversion in the loop. It is done by
4447 code_convert_region after all data are read into the buffer. */
4449 int gap_size
= GAP_SIZE
;
4451 while (how_much
< total
)
4453 /* try is reserved in some compilers (Microsoft C) */
4454 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4461 /* Maybe make more room. */
4462 if (gap_size
< trytry
)
4464 make_gap (total
- gap_size
);
4465 gap_size
= GAP_SIZE
;
4468 /* Read from the file, capturing `quit'. When an
4469 error occurs, end the loop, and arrange for a quit
4470 to be signaled after decoding the text we read. */
4471 non_regular_fd
= fd
;
4472 non_regular_inserted
= inserted
;
4473 non_regular_nbytes
= trytry
;
4474 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4475 read_non_regular_quit
);
4486 /* Allow quitting out of the actual I/O. We don't make text
4487 part of the buffer until all the reading is done, so a C-g
4488 here doesn't do any harm. */
4491 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4503 /* For a regular file, where TOTAL is the real size,
4504 count HOW_MUCH to compare with it.
4505 For a special file, where TOTAL is just a buffer size,
4506 so don't bother counting in HOW_MUCH.
4507 (INSERTED is where we count the number of characters inserted.) */
4514 /* Now we have read all the file data into the gap.
4515 If it was empty, undo marking the buffer modified. */
4519 #ifdef CLASH_DETECTION
4521 unlock_file (current_buffer
->file_truename
);
4523 Vdeactivate_mark
= old_Vdeactivate_mark
;
4526 /* Make the text read part of the buffer. */
4527 GAP_SIZE
-= inserted
;
4529 GPT_BYTE
+= inserted
;
4531 ZV_BYTE
+= inserted
;
4536 /* Put an anchor to ensure multi-byte form ends at gap. */
4541 /* Discard the unwind protect for closing the file. */
4545 error ("IO error reading %s: %s",
4546 SDATA (orig_filename
), emacs_strerror (errno
));
4550 if (! coding_system_decided
)
4552 /* The coding system is not yet decided. Decide it by an
4553 optimized method for handling `coding:' tag.
4555 Note that we can get here only if the buffer was empty
4556 before the insertion. */
4560 if (!NILP (Vcoding_system_for_read
))
4561 val
= Vcoding_system_for_read
;
4564 /* Since we are sure that the current buffer was empty
4565 before the insertion, we can toggle
4566 enable-multibyte-characters directly here without taking
4567 care of marker adjustment and byte combining problem. By
4568 this way, we can run Lisp program safely before decoding
4569 the inserted text. */
4570 Lisp_Object unwind_data
;
4571 int count
= SPECPDL_INDEX ();
4573 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4574 Fcons (current_buffer
->undo_list
,
4575 Fcurrent_buffer ()));
4576 current_buffer
->enable_multibyte_characters
= Qnil
;
4577 current_buffer
->undo_list
= Qt
;
4578 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4580 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4582 val
= call2 (Vset_auto_coding_function
,
4583 filename
, make_number (inserted
));
4588 /* If the coding system is not yet decided, check
4589 file-coding-system-alist. */
4590 Lisp_Object args
[6], coding_systems
;
4592 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4593 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4594 coding_systems
= Ffind_operation_coding_system (6, args
);
4595 if (CONSP (coding_systems
))
4596 val
= XCAR (coding_systems
);
4598 unbind_to (count
, Qnil
);
4599 inserted
= Z_BYTE
- BEG_BYTE
;
4602 /* The following kludgy code is to avoid some compiler bug.
4604 setup_coding_system (val, &coding);
4607 struct coding_system temp_coding
;
4608 setup_coding_system (Fcheck_coding_system (val
), &temp_coding
);
4609 bcopy (&temp_coding
, &coding
, sizeof coding
);
4611 /* Ensure we set Vlast_coding_system_used. */
4612 set_coding_system
= 1;
4614 if (NILP (current_buffer
->enable_multibyte_characters
)
4616 /* We must suppress all character code conversion except for
4617 end-of-line conversion. */
4618 setup_raw_text_coding_system (&coding
);
4619 coding
.src_multibyte
= 0;
4620 coding
.dst_multibyte
4621 = !NILP (current_buffer
->enable_multibyte_characters
);
4625 /* Can't do this if part of the buffer might be preserved. */
4627 && (coding
.type
== coding_type_no_conversion
4628 || coding
.type
== coding_type_raw_text
))
4630 /* Visiting a file with these coding system makes the buffer
4632 current_buffer
->enable_multibyte_characters
= Qnil
;
4633 coding
.dst_multibyte
= 0;
4636 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4638 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4640 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4642 inserted
= coding
.produced_char
;
4645 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4649 /* Now INSERTED is measured in characters. */
4652 /* Use the conversion type to determine buffer-file-type
4653 (find-buffer-file-type is now used to help determine the
4655 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4656 || coding
.eol_type
== CODING_EOL_LF
)
4657 && ! CODING_REQUIRE_DECODING (&coding
))
4658 current_buffer
->buffer_file_type
= Qt
;
4660 current_buffer
->buffer_file_type
= Qnil
;
4667 if (!EQ (current_buffer
->undo_list
, Qt
))
4668 current_buffer
->undo_list
= Qnil
;
4670 stat (SDATA (filename
), &st
);
4675 current_buffer
->modtime
= st
.st_mtime
;
4676 current_buffer
->filename
= orig_filename
;
4679 SAVE_MODIFF
= MODIFF
;
4680 current_buffer
->auto_save_modified
= MODIFF
;
4681 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4682 #ifdef CLASH_DETECTION
4685 if (!NILP (current_buffer
->file_truename
))
4686 unlock_file (current_buffer
->file_truename
);
4687 unlock_file (filename
);
4689 #endif /* CLASH_DETECTION */
4691 Fsignal (Qfile_error
,
4692 Fcons (build_string ("not a regular file"),
4693 Fcons (orig_filename
, Qnil
)));
4696 if (set_coding_system
)
4697 Vlast_coding_system_used
= coding
.symbol
;
4699 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4701 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4703 if (! NILP (insval
))
4705 CHECK_NUMBER (insval
);
4706 inserted
= XFASTINT (insval
);
4710 /* Decode file format */
4713 int empty_undo_list_p
= 0;
4715 /* If we're anyway going to discard undo information, don't
4716 record it in the first place. The buffer's undo list at this
4717 point is either nil or t when visiting a file. */
4720 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4721 current_buffer
->undo_list
= Qt
;
4724 insval
= call3 (Qformat_decode
,
4725 Qnil
, make_number (inserted
), visit
);
4726 CHECK_NUMBER (insval
);
4727 inserted
= XFASTINT (insval
);
4730 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4733 /* Call after-change hooks for the inserted text, aside from the case
4734 of normal visiting (not with REPLACE), which is done in a new buffer
4735 "before" the buffer is changed. */
4736 if (inserted
> 0 && total
> 0
4737 && (NILP (visit
) || !NILP (replace
)))
4739 signal_after_change (PT
, 0, inserted
);
4740 update_compositions (PT
, PT
, CHECK_BORDER
);
4743 p
= Vafter_insert_file_functions
;
4746 insval
= call1 (XCAR (p
), make_number (inserted
));
4749 CHECK_NUMBER (insval
);
4750 inserted
= XFASTINT (insval
);
4757 && current_buffer
->modtime
== -1)
4759 /* If visiting nonexistent file, return nil. */
4760 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4764 Fsignal (Qquit
, Qnil
);
4766 /* ??? Retval needs to be dealt with in all cases consistently. */
4768 val
= Fcons (orig_filename
,
4769 Fcons (make_number (inserted
),
4772 RETURN_UNGCPRO (unbind_to (count
, val
));
4775 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4776 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4777 Lisp_Object
, Lisp_Object
));
4779 /* If build_annotations switched buffers, switch back to BUF.
4780 Kill the temporary buffer that was selected in the meantime.
4782 Since this kill only the last temporary buffer, some buffers remain
4783 not killed if build_annotations switched buffers more than once.
4787 build_annotations_unwind (buf
)
4792 if (XBUFFER (buf
) == current_buffer
)
4794 tembuf
= Fcurrent_buffer ();
4796 Fkill_buffer (tembuf
);
4800 /* Decide the coding-system to encode the data with. */
4803 choose_write_coding_system (start
, end
, filename
,
4804 append
, visit
, lockname
, coding
)
4805 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4806 struct coding_system
*coding
;
4811 && NILP (Fstring_equal (current_buffer
->filename
,
4812 current_buffer
->auto_save_file_name
)))
4814 /* We use emacs-mule for auto saving... */
4815 setup_coding_system (Qemacs_mule
, coding
);
4816 /* ... but with the special flag to indicate not to strip off
4817 leading code of eight-bit-control chars. */
4819 goto done_setup_coding
;
4821 else if (!NILP (Vcoding_system_for_write
))
4823 val
= Vcoding_system_for_write
;
4824 if (coding_system_require_warning
4825 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4826 /* Confirm that VAL can surely encode the current region. */
4827 val
= call5 (Vselect_safe_coding_system_function
,
4828 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4833 /* If the variable `buffer-file-coding-system' is set locally,
4834 it means that the file was read with some kind of code
4835 conversion or the variable is explicitly set by users. We
4836 had better write it out with the same coding system even if
4837 `enable-multibyte-characters' is nil.
4839 If it is not set locally, we anyway have to convert EOL
4840 format if the default value of `buffer-file-coding-system'
4841 tells that it is not Unix-like (LF only) format. */
4842 int using_default_coding
= 0;
4843 int force_raw_text
= 0;
4845 val
= current_buffer
->buffer_file_coding_system
;
4847 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4850 if (NILP (current_buffer
->enable_multibyte_characters
))
4856 /* Check file-coding-system-alist. */
4857 Lisp_Object args
[7], coding_systems
;
4859 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4860 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4862 coding_systems
= Ffind_operation_coding_system (7, args
);
4863 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4864 val
= XCDR (coding_systems
);
4868 && !NILP (current_buffer
->buffer_file_coding_system
))
4870 /* If we still have not decided a coding system, use the
4871 default value of buffer-file-coding-system. */
4872 val
= current_buffer
->buffer_file_coding_system
;
4873 using_default_coding
= 1;
4877 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4878 /* Confirm that VAL can surely encode the current region. */
4879 val
= call5 (Vselect_safe_coding_system_function
,
4880 start
, end
, val
, Qnil
, filename
);
4882 setup_coding_system (Fcheck_coding_system (val
), coding
);
4883 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4884 && !using_default_coding
)
4886 if (! EQ (default_buffer_file_coding
.symbol
,
4887 buffer_defaults
.buffer_file_coding_system
))
4888 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4889 &default_buffer_file_coding
);
4890 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4892 Lisp_Object subsidiaries
;
4894 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4895 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4896 if (VECTORP (subsidiaries
)
4897 && XVECTOR (subsidiaries
)->size
== 3)
4899 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4904 setup_raw_text_coding_system (coding
);
4905 goto done_setup_coding
;
4908 setup_coding_system (Fcheck_coding_system (val
), coding
);
4911 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4912 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4915 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4916 "r\nFWrite region to file: \ni\ni\ni\np",
4917 doc
: /* Write current region into specified file.
4918 When called from a program, requires three arguments:
4919 START, END and FILENAME. START and END are normally buffer positions
4920 specifying the part of the buffer to write.
4921 If START is nil, that means to use the entire buffer contents.
4922 If START is a string, then output that string to the file
4923 instead of any buffer contents; END is ignored.
4925 Optional fourth argument APPEND if non-nil means
4926 append to existing file contents (if any). If it is an integer,
4927 seek to that offset in the file before writing.
4928 Optional fifth argument VISIT, if t or a string, means
4929 set the last-save-file-modtime of buffer to this file's modtime
4930 and mark buffer not modified.
4931 If VISIT is a string, it is a second file name;
4932 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4933 VISIT is also the file name to lock and unlock for clash detection.
4934 If VISIT is neither t nor nil nor a string,
4935 that means do not display the \"Wrote file\" message.
4936 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4937 use for locking and unlocking, overriding FILENAME and VISIT.
4938 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4939 for an existing file with the same name. If MUSTBENEW is `excl',
4940 that means to get an error if the file already exists; never overwrite.
4941 If MUSTBENEW is neither nil nor `excl', that means ask for
4942 confirmation before overwriting, but do go ahead and overwrite the file
4943 if the user confirms.
4945 This does code conversion according to the value of
4946 `coding-system-for-write', `buffer-file-coding-system', or
4947 `file-coding-system-alist', and sets the variable
4948 `last-coding-system-used' to the coding system actually used. */)
4949 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4950 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4955 const unsigned char *fn
;
4958 int count
= SPECPDL_INDEX ();
4961 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4963 Lisp_Object handler
;
4964 Lisp_Object visit_file
;
4965 Lisp_Object annotations
;
4966 Lisp_Object encoded_filename
;
4967 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4968 int quietly
= !NILP (visit
);
4969 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4970 struct buffer
*given_buffer
;
4972 int buffer_file_type
= O_BINARY
;
4974 struct coding_system coding
;
4976 if (current_buffer
->base_buffer
&& visiting
)
4977 error ("Cannot do file visiting in an indirect buffer");
4979 if (!NILP (start
) && !STRINGP (start
))
4980 validate_region (&start
, &end
);
4982 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4984 filename
= Fexpand_file_name (filename
, Qnil
);
4986 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4987 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4989 if (STRINGP (visit
))
4990 visit_file
= Fexpand_file_name (visit
, Qnil
);
4992 visit_file
= filename
;
4994 if (NILP (lockname
))
4995 lockname
= visit_file
;
4999 /* If the file name has special constructs in it,
5000 call the corresponding file handler. */
5001 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
5002 /* If FILENAME has no handler, see if VISIT has one. */
5003 if (NILP (handler
) && STRINGP (visit
))
5004 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
5006 if (!NILP (handler
))
5009 val
= call6 (handler
, Qwrite_region
, start
, end
,
5010 filename
, append
, visit
);
5014 SAVE_MODIFF
= MODIFF
;
5015 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5016 current_buffer
->filename
= visit_file
;
5022 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
5024 /* Special kludge to simplify auto-saving. */
5027 XSETFASTINT (start
, BEG
);
5028 XSETFASTINT (end
, Z
);
5032 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
5033 count1
= SPECPDL_INDEX ();
5035 given_buffer
= current_buffer
;
5037 if (!STRINGP (start
))
5039 annotations
= build_annotations (start
, end
);
5041 if (current_buffer
!= given_buffer
)
5043 XSETFASTINT (start
, BEGV
);
5044 XSETFASTINT (end
, ZV
);
5050 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
5052 /* Decide the coding-system to encode the data with.
5053 We used to make this choice before calling build_annotations, but that
5054 leads to problems when a write-annotate-function takes care of
5055 unsavable chars (as was the case with X-Symbol). */
5056 choose_write_coding_system (start
, end
, filename
,
5057 append
, visit
, lockname
, &coding
);
5058 Vlast_coding_system_used
= coding
.symbol
;
5060 given_buffer
= current_buffer
;
5061 if (! STRINGP (start
))
5063 annotations
= build_annotations_2 (start
, end
,
5064 coding
.pre_write_conversion
, annotations
);
5065 if (current_buffer
!= given_buffer
)
5067 XSETFASTINT (start
, BEGV
);
5068 XSETFASTINT (end
, ZV
);
5072 #ifdef CLASH_DETECTION
5075 #if 0 /* This causes trouble for GNUS. */
5076 /* If we've locked this file for some other buffer,
5077 query before proceeding. */
5078 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5079 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5082 lock_file (lockname
);
5084 #endif /* CLASH_DETECTION */
5086 encoded_filename
= ENCODE_FILE (filename
);
5088 fn
= SDATA (encoded_filename
);
5092 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5093 #else /* not DOS_NT */
5094 desc
= emacs_open (fn
, O_WRONLY
, 0);
5095 #endif /* not DOS_NT */
5097 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5099 if (auto_saving
) /* Overwrite any previous version of autosave file */
5101 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5102 desc
= emacs_open (fn
, O_RDWR
, 0);
5104 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5105 ? SDATA (current_buffer
->filename
) : 0,
5108 else /* Write to temporary name and rename if no errors */
5110 Lisp_Object temp_name
;
5111 temp_name
= Ffile_name_directory (filename
);
5113 if (!NILP (temp_name
))
5115 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5116 build_string ("$$SAVE$$")));
5117 fname
= SDATA (filename
);
5118 fn
= SDATA (temp_name
);
5119 desc
= creat_copy_attrs (fname
, fn
);
5122 /* If we can't open the temporary file, try creating a new
5123 version of the original file. VMS "creat" creates a
5124 new version rather than truncating an existing file. */
5127 desc
= creat (fn
, 0666);
5128 #if 0 /* This can clobber an existing file and fail to replace it,
5129 if the user runs out of space. */
5132 /* We can't make a new version;
5133 try to truncate and rewrite existing version if any. */
5135 desc
= emacs_open (fn
, O_RDWR
, 0);
5141 desc
= creat (fn
, 0666);
5145 desc
= emacs_open (fn
,
5146 O_WRONLY
| O_CREAT
| buffer_file_type
5147 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5148 S_IREAD
| S_IWRITE
);
5149 #else /* not DOS_NT */
5150 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5151 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5152 auto_saving
? auto_save_mode_bits
: 0666);
5153 #endif /* not DOS_NT */
5154 #endif /* not VMS */
5158 #ifdef CLASH_DETECTION
5160 if (!auto_saving
) unlock_file (lockname
);
5162 #endif /* CLASH_DETECTION */
5164 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5167 record_unwind_protect (close_file_unwind
, make_number (desc
));
5169 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5173 if (NUMBERP (append
))
5174 ret
= lseek (desc
, XINT (append
), 1);
5176 ret
= lseek (desc
, 0, 2);
5179 #ifdef CLASH_DETECTION
5180 if (!auto_saving
) unlock_file (lockname
);
5181 #endif /* CLASH_DETECTION */
5183 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5191 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5192 * if we do writes that don't end with a carriage return. Furthermore
5193 * it cannot handle writes of more then 16K. The modified
5194 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5195 * this EXCEPT for the last record (iff it doesn't end with a carriage
5196 * return). This implies that if your buffer doesn't end with a carriage
5197 * return, you get one free... tough. However it also means that if
5198 * we make two calls to sys_write (a la the following code) you can
5199 * get one at the gap as well. The easiest way to fix this (honest)
5200 * is to move the gap to the next newline (or the end of the buffer).
5205 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5206 move_gap (find_next_newline (GPT
, 1));
5208 /* Whether VMS or not, we must move the gap to the next of newline
5209 when we must put designation sequences at beginning of line. */
5210 if (INTEGERP (start
)
5211 && coding
.type
== coding_type_iso2022
5212 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5213 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5215 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5216 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5217 move_gap_both (PT
, PT_BYTE
);
5218 SET_PT_BOTH (opoint
, opoint_byte
);
5225 if (STRINGP (start
))
5227 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5228 &annotations
, &coding
);
5231 else if (XINT (start
) != XINT (end
))
5233 tem
= CHAR_TO_BYTE (XINT (start
));
5235 if (XINT (start
) < GPT
)
5237 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5238 min (GPT
, XINT (end
)) - XINT (start
),
5239 &annotations
, &coding
);
5243 if (XINT (end
) > GPT
&& !failure
)
5245 tem
= max (XINT (start
), GPT
);
5246 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5247 &annotations
, &coding
);
5253 /* If file was empty, still need to write the annotations */
5254 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5255 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5259 if (CODING_REQUIRE_FLUSHING (&coding
)
5260 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5263 /* We have to flush out a data. */
5264 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5265 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5272 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5273 Disk full in NFS may be reported here. */
5274 /* mib says that closing the file will try to write as fast as NFS can do
5275 it, and that means the fsync here is not crucial for autosave files. */
5276 if (!auto_saving
&& fsync (desc
) < 0)
5278 /* If fsync fails with EINTR, don't treat that as serious. */
5280 failure
= 1, save_errno
= errno
;
5284 /* Spurious "file has changed on disk" warnings have been
5285 observed on Suns as well.
5286 It seems that `close' can change the modtime, under nfs.
5288 (This has supposedly been fixed in Sunos 4,
5289 but who knows about all the other machines with NFS?) */
5292 /* On VMS and APOLLO, must do the stat after the close
5293 since closing changes the modtime. */
5296 /* Recall that #if defined does not work on VMS. */
5303 /* NFS can report a write failure now. */
5304 if (emacs_close (desc
) < 0)
5305 failure
= 1, save_errno
= errno
;
5308 /* If we wrote to a temporary name and had no errors, rename to real name. */
5312 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5320 /* Discard the unwind protect for close_file_unwind. */
5321 specpdl_ptr
= specpdl
+ count1
;
5322 /* Restore the original current buffer. */
5323 visit_file
= unbind_to (count
, visit_file
);
5325 #ifdef CLASH_DETECTION
5327 unlock_file (lockname
);
5328 #endif /* CLASH_DETECTION */
5330 /* Do this before reporting IO error
5331 to avoid a "file has changed on disk" warning on
5332 next attempt to save. */
5334 current_buffer
->modtime
= st
.st_mtime
;
5337 error ("IO error writing %s: %s", SDATA (filename
),
5338 emacs_strerror (save_errno
));
5342 SAVE_MODIFF
= MODIFF
;
5343 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5344 current_buffer
->filename
= visit_file
;
5345 update_mode_lines
++;
5350 && ! NILP (Fstring_equal (current_buffer
->filename
,
5351 current_buffer
->auto_save_file_name
)))
5352 SAVE_MODIFF
= MODIFF
;
5358 message_with_string ((INTEGERP (append
)
5368 Lisp_Object
merge ();
5370 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5371 doc
: /* Return t if (car A) is numerically less than (car B). */)
5375 return Flss (Fcar (a
), Fcar (b
));
5378 /* Build the complete list of annotations appropriate for writing out
5379 the text between START and END, by calling all the functions in
5380 write-region-annotate-functions and merging the lists they return.
5381 If one of these functions switches to a different buffer, we assume
5382 that buffer contains altered text. Therefore, the caller must
5383 make sure to restore the current buffer in all cases,
5384 as save-excursion would do. */
5387 build_annotations (start
, end
)
5388 Lisp_Object start
, end
;
5390 Lisp_Object annotations
;
5392 struct gcpro gcpro1
, gcpro2
;
5393 Lisp_Object original_buffer
;
5394 int i
, used_global
= 0;
5396 XSETBUFFER (original_buffer
, current_buffer
);
5399 p
= Vwrite_region_annotate_functions
;
5400 GCPRO2 (annotations
, p
);
5403 struct buffer
*given_buffer
= current_buffer
;
5404 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5405 { /* Use the global value of the hook. */
5408 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5410 p
= Fappend (2, arg
);
5413 Vwrite_region_annotations_so_far
= annotations
;
5414 res
= call2 (XCAR (p
), start
, end
);
5415 /* If the function makes a different buffer current,
5416 assume that means this buffer contains altered text to be output.
5417 Reset START and END from the buffer bounds
5418 and discard all previous annotations because they should have
5419 been dealt with by this function. */
5420 if (current_buffer
!= given_buffer
)
5422 XSETFASTINT (start
, BEGV
);
5423 XSETFASTINT (end
, ZV
);
5426 Flength (res
); /* Check basic validity of return value */
5427 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5431 /* Now do the same for annotation functions implied by the file-format */
5432 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
5433 p
= current_buffer
->auto_save_file_format
;
5435 p
= current_buffer
->file_format
;
5436 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5438 struct buffer
*given_buffer
= current_buffer
;
5440 Vwrite_region_annotations_so_far
= annotations
;
5442 /* Value is either a list of annotations or nil if the function
5443 has written annotations to a temporary buffer, which is now
5445 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5446 original_buffer
, make_number (i
));
5447 if (current_buffer
!= given_buffer
)
5449 XSETFASTINT (start
, BEGV
);
5450 XSETFASTINT (end
, ZV
);
5455 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5463 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5464 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5466 struct gcpro gcpro1
;
5469 GCPRO1 (annotations
);
5470 /* At last, do the same for the function PRE_WRITE_CONVERSION
5471 implied by the current coding-system. */
5472 if (!NILP (pre_write_conversion
))
5474 struct buffer
*given_buffer
= current_buffer
;
5475 Vwrite_region_annotations_so_far
= annotations
;
5476 res
= call2 (pre_write_conversion
, start
, end
);
5478 annotations
= (current_buffer
!= given_buffer
5480 : merge (annotations
, res
, Qcar_less_than_car
));
5487 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5488 If STRING is nil, POS is the character position in the current buffer.
5489 Intersperse with them the annotations from *ANNOT
5490 which fall within the range of POS to POS + NCHARS,
5491 each at its appropriate position.
5493 We modify *ANNOT by discarding elements as we use them up.
5495 The return value is negative in case of system call failure. */
5498 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5501 register int nchars
;
5504 struct coding_system
*coding
;
5508 int lastpos
= pos
+ nchars
;
5510 while (NILP (*annot
) || CONSP (*annot
))
5512 tem
= Fcar_safe (Fcar (*annot
));
5515 nextpos
= XFASTINT (tem
);
5517 /* If there are no more annotations in this range,
5518 output the rest of the range all at once. */
5519 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5520 return e_write (desc
, string
, pos
, lastpos
, coding
);
5522 /* Output buffer text up to the next annotation's position. */
5525 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5529 /* Output the annotation. */
5530 tem
= Fcdr (Fcar (*annot
));
5533 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5536 *annot
= Fcdr (*annot
);
5541 #ifndef WRITE_BUF_SIZE
5542 #define WRITE_BUF_SIZE (16 * 1024)
5545 /* Write text in the range START and END into descriptor DESC,
5546 encoding them with coding system CODING. If STRING is nil, START
5547 and END are character positions of the current buffer, else they
5548 are indexes to the string STRING. */
5551 e_write (desc
, string
, start
, end
, coding
)
5555 struct coding_system
*coding
;
5557 register char *addr
;
5558 register int nbytes
;
5559 char buf
[WRITE_BUF_SIZE
];
5563 coding
->composing
= COMPOSITION_DISABLED
;
5564 if (coding
->composing
!= COMPOSITION_DISABLED
)
5565 coding_save_composition (coding
, start
, end
, string
);
5567 if (STRINGP (string
))
5569 addr
= SDATA (string
);
5570 nbytes
= SBYTES (string
);
5571 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5573 else if (start
< end
)
5575 /* It is assured that the gap is not in the range START and END-1. */
5576 addr
= CHAR_POS_ADDR (start
);
5577 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5578 coding
->src_multibyte
5579 = !NILP (current_buffer
->enable_multibyte_characters
);
5585 coding
->src_multibyte
= 1;
5588 /* We used to have a code for handling selective display here. But,
5589 now it is handled within encode_coding. */
5594 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5595 if (coding
->produced
> 0)
5597 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5598 if (coding
->produced
)
5604 nbytes
-= coding
->consumed
;
5605 addr
+= coding
->consumed
;
5606 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5609 /* The source text ends by an incomplete multibyte form.
5610 There's no way other than write it out as is. */
5611 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5620 start
+= coding
->consumed_char
;
5621 if (coding
->cmp_data
)
5622 coding_adjust_composition_offset (coding
, start
);
5625 if (coding
->cmp_data
)
5626 coding_free_composition_data (coding
);
5631 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5632 Sverify_visited_file_modtime
, 1, 1, 0,
5633 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5634 This means that the file has not been changed since it was visited or saved.
5635 See Info node `(elisp)Modification Time' for more details. */)
5641 Lisp_Object handler
;
5642 Lisp_Object filename
;
5647 if (!STRINGP (b
->filename
)) return Qt
;
5648 if (b
->modtime
== 0) return Qt
;
5650 /* If the file name has special constructs in it,
5651 call the corresponding file handler. */
5652 handler
= Ffind_file_name_handler (b
->filename
,
5653 Qverify_visited_file_modtime
);
5654 if (!NILP (handler
))
5655 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5657 filename
= ENCODE_FILE (b
->filename
);
5659 if (stat (SDATA (filename
), &st
) < 0)
5661 /* If the file doesn't exist now and didn't exist before,
5662 we say that it isn't modified, provided the error is a tame one. */
5663 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5668 if (st
.st_mtime
== b
->modtime
5669 /* If both are positive, accept them if they are off by one second. */
5670 || (st
.st_mtime
> 0 && b
->modtime
> 0
5671 && (st
.st_mtime
== b
->modtime
+ 1
5672 || st
.st_mtime
== b
->modtime
- 1)))
5677 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5678 Sclear_visited_file_modtime
, 0, 0, 0,
5679 doc
: /* Clear out records of last mod time of visited file.
5680 Next attempt to save will certainly not complain of a discrepancy. */)
5683 current_buffer
->modtime
= 0;
5687 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5688 Svisited_file_modtime
, 0, 0, 0,
5689 doc
: /* Return the current buffer's recorded visited file modification time.
5690 The value is a list of the form (HIGH LOW), like the time values
5691 that `file-attributes' returns. If the current buffer has no recorded
5692 file modification time, this function returns 0.
5693 See Info node `(elisp)Modification Time' for more details. */)
5697 tcons
= long_to_cons ((unsigned long) current_buffer
->modtime
);
5699 return list2 (XCAR (tcons
), XCDR (tcons
));
5703 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5704 Sset_visited_file_modtime
, 0, 1, 0,
5705 doc
: /* Update buffer's recorded modification time from the visited file's time.
5706 Useful if the buffer was not read from the file normally
5707 or if the file itself has been changed for some known benign reason.
5708 An argument specifies the modification time value to use
5709 \(instead of that of the visited file), in the form of a list
5710 \(HIGH . LOW) or (HIGH LOW). */)
5712 Lisp_Object time_list
;
5714 if (!NILP (time_list
))
5715 current_buffer
->modtime
= cons_to_long (time_list
);
5718 register Lisp_Object filename
;
5720 Lisp_Object handler
;
5722 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5724 /* If the file name has special constructs in it,
5725 call the corresponding file handler. */
5726 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5727 if (!NILP (handler
))
5728 /* The handler can find the file name the same way we did. */
5729 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5731 filename
= ENCODE_FILE (filename
);
5733 if (stat (SDATA (filename
), &st
) >= 0)
5734 current_buffer
->modtime
= st
.st_mtime
;
5741 auto_save_error (error
)
5744 Lisp_Object args
[3], msg
;
5746 struct gcpro gcpro1
;
5750 args
[0] = build_string ("Auto-saving %s: %s");
5751 args
[1] = current_buffer
->name
;
5752 args
[2] = Ferror_message_string (error
);
5753 msg
= Fformat (3, args
);
5755 nbytes
= SBYTES (msg
);
5757 for (i
= 0; i
< 3; ++i
)
5760 message2 (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5762 message2_nolog (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5763 Fsleep_for (make_number (1), Qnil
);
5776 auto_save_mode_bits
= 0666;
5778 /* Get visited file's mode to become the auto save file's mode. */
5779 if (! NILP (current_buffer
->filename
))
5781 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5782 /* But make sure we can overwrite it later! */
5783 auto_save_mode_bits
= st
.st_mode
| 0600;
5784 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5786 /* Remote files don't cooperate with stat. */
5787 auto_save_mode_bits
= XINT (modes
) | 0600;
5791 Fwrite_region (Qnil
, Qnil
,
5792 current_buffer
->auto_save_file_name
,
5793 Qnil
, Qlambda
, Qnil
, Qnil
);
5797 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5802 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5803 | XFASTINT (XCDR (stream
))));
5808 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5811 minibuffer_auto_raise
= XINT (value
);
5816 do_auto_save_make_dir (dir
)
5819 return call2 (Qmake_directory
, dir
, Qt
);
5823 do_auto_save_eh (ignore
)
5829 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5830 doc
: /* Auto-save all buffers that need it.
5831 This is all buffers that have auto-saving enabled
5832 and are changed since last auto-saved.
5833 Auto-saving writes the buffer into a file
5834 so that your editing is not lost if the system crashes.
5835 This file is not the file you visited; that changes only when you save.
5836 Normally we run the normal hook `auto-save-hook' before saving.
5838 A non-nil NO-MESSAGE argument means do not print any message if successful.
5839 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5840 (no_message
, current_only
)
5841 Lisp_Object no_message
, current_only
;
5843 struct buffer
*old
= current_buffer
, *b
;
5844 Lisp_Object tail
, buf
;
5846 int do_handled_files
;
5849 Lisp_Object lispstream
;
5850 int count
= SPECPDL_INDEX ();
5851 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5852 int old_message_p
= 0;
5853 struct gcpro gcpro1
, gcpro2
;
5855 if (max_specpdl_size
< specpdl_size
+ 40)
5856 max_specpdl_size
= specpdl_size
+ 40;
5861 if (NILP (no_message
))
5863 old_message_p
= push_message ();
5864 record_unwind_protect (pop_message_unwind
, Qnil
);
5867 /* Ordinarily don't quit within this function,
5868 but don't make it impossible to quit (in case we get hung in I/O). */
5872 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5873 point to non-strings reached from Vbuffer_alist. */
5875 if (!NILP (Vrun_hooks
))
5876 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5878 if (STRINGP (Vauto_save_list_file_name
))
5880 Lisp_Object listfile
;
5882 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5884 /* Don't try to create the directory when shutting down Emacs,
5885 because creating the directory might signal an error, and
5886 that would leave Emacs in a strange state. */
5887 if (!NILP (Vrun_hooks
))
5891 GCPRO2 (dir
, listfile
);
5892 dir
= Ffile_name_directory (listfile
);
5893 if (NILP (Ffile_directory_p (dir
)))
5894 internal_condition_case_1 (do_auto_save_make_dir
,
5895 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5900 stream
= fopen (SDATA (listfile
), "w");
5903 /* Arrange to close that file whether or not we get an error.
5904 Also reset auto_saving to 0. */
5905 lispstream
= Fcons (Qnil
, Qnil
);
5906 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
5907 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
5918 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5919 record_unwind_protect (do_auto_save_unwind_1
,
5920 make_number (minibuffer_auto_raise
));
5921 minibuffer_auto_raise
= 0;
5924 /* On first pass, save all files that don't have handlers.
5925 On second pass, save all files that do have handlers.
5927 If Emacs is crashing, the handlers may tweak what is causing
5928 Emacs to crash in the first place, and it would be a shame if
5929 Emacs failed to autosave perfectly ordinary files because it
5930 couldn't handle some ange-ftp'd file. */
5932 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5933 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5935 buf
= XCDR (XCAR (tail
));
5938 /* Record all the buffers that have auto save mode
5939 in the special file that lists them. For each of these buffers,
5940 Record visited name (if any) and auto save name. */
5941 if (STRINGP (b
->auto_save_file_name
)
5942 && stream
!= NULL
&& do_handled_files
== 0)
5944 if (!NILP (b
->filename
))
5946 fwrite (SDATA (b
->filename
), 1,
5947 SBYTES (b
->filename
), stream
);
5949 putc ('\n', stream
);
5950 fwrite (SDATA (b
->auto_save_file_name
), 1,
5951 SBYTES (b
->auto_save_file_name
), stream
);
5952 putc ('\n', stream
);
5955 if (!NILP (current_only
)
5956 && b
!= current_buffer
)
5959 /* Don't auto-save indirect buffers.
5960 The base buffer takes care of it. */
5964 /* Check for auto save enabled
5965 and file changed since last auto save
5966 and file changed since last real save. */
5967 if (STRINGP (b
->auto_save_file_name
)
5968 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5969 && b
->auto_save_modified
< BUF_MODIFF (b
)
5970 /* -1 means we've turned off autosaving for a while--see below. */
5971 && XINT (b
->save_length
) >= 0
5972 && (do_handled_files
5973 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5976 EMACS_TIME before_time
, after_time
;
5978 EMACS_GET_TIME (before_time
);
5980 /* If we had a failure, don't try again for 20 minutes. */
5981 if (b
->auto_save_failure_time
>= 0
5982 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5985 if ((XFASTINT (b
->save_length
) * 10
5986 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5987 /* A short file is likely to change a large fraction;
5988 spare the user annoying messages. */
5989 && XFASTINT (b
->save_length
) > 5000
5990 /* These messages are frequent and annoying for `*mail*'. */
5991 && !EQ (b
->filename
, Qnil
)
5992 && NILP (no_message
))
5994 /* It has shrunk too much; turn off auto-saving here. */
5995 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5996 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5998 minibuffer_auto_raise
= 0;
5999 /* Turn off auto-saving until there's a real save,
6000 and prevent any more warnings. */
6001 XSETINT (b
->save_length
, -1);
6002 Fsleep_for (make_number (1), Qnil
);
6005 set_buffer_internal (b
);
6006 if (!auto_saved
&& NILP (no_message
))
6007 message1 ("Auto-saving...");
6008 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
6010 b
->auto_save_modified
= BUF_MODIFF (b
);
6011 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6012 set_buffer_internal (old
);
6014 EMACS_GET_TIME (after_time
);
6016 /* If auto-save took more than 60 seconds,
6017 assume it was an NFS failure that got a timeout. */
6018 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
6019 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
6023 /* Prevent another auto save till enough input events come in. */
6024 record_auto_save ();
6026 if (auto_saved
&& NILP (no_message
))
6030 /* If we are going to restore an old message,
6031 give time to read ours. */
6032 sit_for (1, 0, 0, 0, 0);
6036 /* If we displayed a message and then restored a state
6037 with no message, leave a "done" message on the screen. */
6038 message1 ("Auto-saving...done");
6043 /* This restores the message-stack status. */
6044 unbind_to (count
, Qnil
);
6048 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
6049 Sset_buffer_auto_saved
, 0, 0, 0,
6050 doc
: /* Mark current buffer as auto-saved with its current text.
6051 No auto-save file will be written until the buffer changes again. */)
6054 current_buffer
->auto_save_modified
= MODIFF
;
6055 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6056 current_buffer
->auto_save_failure_time
= -1;
6060 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
6061 Sclear_buffer_auto_save_failure
, 0, 0, 0,
6062 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
6065 current_buffer
->auto_save_failure_time
= -1;
6069 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6071 doc
: /* Return t if current buffer has been auto-saved recently.
6072 More precisely, if it has been auto-saved since last read from or saved
6073 in the visited file. If the buffer has no visited file,
6074 then any auto-save counts as "recent". */)
6077 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6080 /* Reading and completing file names */
6081 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
6083 /* In the string VAL, change each $ to $$ and return the result. */
6086 double_dollars (val
)
6089 register const unsigned char *old
;
6090 register unsigned char *new;
6094 osize
= SBYTES (val
);
6096 /* Count the number of $ characters. */
6097 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
6098 if (*old
++ == '$') count
++;
6102 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
6105 for (n
= osize
; n
> 0; n
--)
6119 read_file_name_cleanup (arg
)
6122 return (current_buffer
->directory
= arg
);
6125 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
6127 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
6128 (string
, dir
, action
)
6129 Lisp_Object string
, dir
, action
;
6130 /* action is nil for complete, t for return list of completions,
6131 lambda for verify final value */
6133 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
6135 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
6137 CHECK_STRING (string
);
6144 /* No need to protect ACTION--we only compare it with t and nil. */
6145 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6147 if (SCHARS (string
) == 0)
6149 if (EQ (action
, Qlambda
))
6157 orig_string
= string
;
6158 string
= Fsubstitute_in_file_name (string
);
6159 changed
= NILP (Fstring_equal (string
, orig_string
));
6160 name
= Ffile_name_nondirectory (string
);
6161 val
= Ffile_name_directory (string
);
6163 realdir
= Fexpand_file_name (val
, realdir
);
6168 specdir
= Ffile_name_directory (string
);
6169 val
= Ffile_name_completion (name
, realdir
);
6174 return double_dollars (string
);
6178 if (!NILP (specdir
))
6179 val
= concat2 (specdir
, val
);
6181 return double_dollars (val
);
6184 #endif /* not VMS */
6188 if (EQ (action
, Qt
))
6190 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6194 if (NILP (Vread_file_name_predicate
)
6195 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6199 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6201 /* Brute-force speed up for directory checking:
6202 Discard strings which don't end in a slash. */
6203 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6205 Lisp_Object tem
= XCAR (all
);
6207 if (STRINGP (tem
) &&
6208 (len
= SCHARS (tem
), len
> 0) &&
6209 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6210 comp
= Fcons (tem
, comp
);
6216 /* Must do it the hard (and slow) way. */
6217 GCPRO3 (all
, comp
, specdir
);
6218 count
= SPECPDL_INDEX ();
6219 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6220 current_buffer
->directory
= realdir
;
6221 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6222 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
6223 comp
= Fcons (XCAR (all
), comp
);
6224 unbind_to (count
, Qnil
);
6227 return Fnreverse (comp
);
6230 /* Only other case actually used is ACTION = lambda */
6232 /* Supposedly this helps commands such as `cd' that read directory names,
6233 but can someone explain how it helps them? -- RMS */
6234 if (SCHARS (name
) == 0)
6237 string
= Fexpand_file_name (string
, dir
);
6238 if (!NILP (Vread_file_name_predicate
))
6239 return call1 (Vread_file_name_predicate
, string
);
6240 return Ffile_exists_p (string
);
6243 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
6244 Snext_read_file_uses_dialog_p
, 0, 0, 0,
6245 doc
: /* Return t if a call to `read-file-name' will use a dialog.
6246 The return value is only relevant for a call to `read-file-name' that happens
6247 before any other event (mouse or keypress) is handeled. */)
6250 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6251 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6260 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6261 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6262 Value is not expanded---you must call `expand-file-name' yourself.
6263 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6264 the same non-empty string that was inserted by this function.
6265 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6266 except that if INITIAL is specified, that combined with DIR is used.)
6267 If the user exits with an empty minibuffer, this function returns
6268 an empty string. (This can only happen if the user erased the
6269 pre-inserted contents or if `insert-default-directory' is nil.)
6270 Fourth arg MUSTMATCH non-nil means require existing file's name.
6271 Non-nil and non-t means also require confirmation after completion.
6272 Fifth arg INITIAL specifies text to start with.
6273 If optional sixth arg PREDICATE is non-nil, possible completions and
6274 the resulting file name must satisfy (funcall PREDICATE NAME).
6275 DIR should be an absolute directory name. It defaults to the value of
6276 `default-directory'.
6278 If this command was invoked with the mouse, use a file dialog box if
6279 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6280 provides a file dialog box.
6282 See also `read-file-name-completion-ignore-case'
6283 and `read-file-name-function'. */)
6284 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6285 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6287 Lisp_Object val
, insdef
, tem
;
6288 struct gcpro gcpro1
, gcpro2
;
6289 register char *homedir
;
6290 Lisp_Object decoded_homedir
;
6291 int replace_in_history
= 0;
6292 int add_to_history
= 0;
6296 dir
= current_buffer
->directory
;
6297 if (NILP (Ffile_name_absolute_p (dir
)))
6298 dir
= Fexpand_file_name (dir
, Qnil
);
6299 if (NILP (default_filename
))
6302 ? Fexpand_file_name (initial
, dir
)
6303 : current_buffer
->filename
);
6305 /* If dir starts with user's homedir, change that to ~. */
6306 homedir
= (char *) egetenv ("HOME");
6308 /* homedir can be NULL in temacs, since Vprocess_environment is not
6309 yet set up. We shouldn't crash in that case. */
6312 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6313 CORRECT_DIR_SEPS (homedir
);
6318 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6321 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6322 SBYTES (decoded_homedir
))
6323 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6325 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6326 dir
= concat2 (build_string ("~"), dir
);
6328 /* Likewise for default_filename. */
6330 && STRINGP (default_filename
)
6331 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6332 SBYTES (decoded_homedir
))
6333 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6336 = Fsubstring (default_filename
,
6337 make_number (SCHARS (decoded_homedir
)), Qnil
);
6338 default_filename
= concat2 (build_string ("~"), default_filename
);
6340 if (!NILP (default_filename
))
6342 CHECK_STRING (default_filename
);
6343 default_filename
= double_dollars (default_filename
);
6346 if (insert_default_directory
&& STRINGP (dir
))
6349 if (!NILP (initial
))
6351 Lisp_Object args
[2], pos
;
6355 insdef
= Fconcat (2, args
);
6356 pos
= make_number (SCHARS (double_dollars (dir
)));
6357 insdef
= Fcons (double_dollars (insdef
), pos
);
6360 insdef
= double_dollars (insdef
);
6362 else if (STRINGP (initial
))
6363 insdef
= Fcons (double_dollars (initial
), make_number (0));
6367 if (!NILP (Vread_file_name_function
))
6369 Lisp_Object args
[7];
6371 GCPRO2 (insdef
, default_filename
);
6372 args
[0] = Vread_file_name_function
;
6375 args
[3] = default_filename
;
6376 args
[4] = mustmatch
;
6378 args
[6] = predicate
;
6379 RETURN_UNGCPRO (Ffuncall (7, args
));
6382 count
= SPECPDL_INDEX ();
6383 specbind (intern ("completion-ignore-case"),
6384 read_file_name_completion_ignore_case
? Qt
: Qnil
);
6385 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6386 specbind (intern ("read-file-name-predicate"),
6387 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6389 GCPRO2 (insdef
, default_filename
);
6391 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6392 if (! NILP (Fnext_read_file_uses_dialog_p ()))
6394 /* If DIR contains a file name, split it. */
6396 file
= Ffile_name_nondirectory (dir
);
6397 if (SCHARS (file
) && NILP (default_filename
))
6399 default_filename
= file
;
6400 dir
= Ffile_name_directory (dir
);
6402 if (!NILP(default_filename
))
6403 default_filename
= Fexpand_file_name (default_filename
, dir
);
6404 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
,
6405 EQ (predicate
, Qfile_directory_p
) ? Qt
: Qnil
);
6410 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6411 dir
, mustmatch
, insdef
,
6412 Qfile_name_history
, default_filename
, Qnil
);
6414 tem
= Fsymbol_value (Qfile_name_history
);
6415 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6416 replace_in_history
= 1;
6418 /* If Fcompleting_read returned the inserted default string itself
6419 (rather than a new string with the same contents),
6420 it has to mean that the user typed RET with the minibuffer empty.
6421 In that case, we really want to return ""
6422 so that commands such as set-visited-file-name can distinguish. */
6423 if (EQ (val
, default_filename
))
6425 /* In this case, Fcompleting_read has not added an element
6426 to the history. Maybe we should. */
6427 if (! replace_in_history
)
6433 unbind_to (count
, Qnil
);
6436 error ("No file name specified");
6438 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6440 if (!NILP (tem
) && !NILP (default_filename
))
6441 val
= default_filename
;
6442 val
= Fsubstitute_in_file_name (val
);
6444 if (replace_in_history
)
6445 /* Replace what Fcompleting_read added to the history
6446 with what we will actually return. */
6448 Lisp_Object val1
= double_dollars (val
);
6449 tem
= Fsymbol_value (Qfile_name_history
);
6450 if (history_delete_duplicates
)
6451 XSETCDR (tem
, Fdelete (val1
, XCDR(tem
)));
6452 XSETCAR (tem
, val1
);
6454 else if (add_to_history
)
6456 /* Add the value to the history--but not if it matches
6457 the last value already there. */
6458 Lisp_Object val1
= double_dollars (val
);
6459 tem
= Fsymbol_value (Qfile_name_history
);
6460 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6462 if (history_delete_duplicates
) tem
= Fdelete (val1
, tem
);
6463 Fset (Qfile_name_history
, Fcons (val1
, tem
));
6474 /* Must be set before any path manipulation is performed. */
6475 XSETFASTINT (Vdirectory_sep_char
, '/');
6482 Qoperations
= intern ("operations");
6483 Qexpand_file_name
= intern ("expand-file-name");
6484 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6485 Qdirectory_file_name
= intern ("directory-file-name");
6486 Qfile_name_directory
= intern ("file-name-directory");
6487 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6488 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6489 Qfile_name_as_directory
= intern ("file-name-as-directory");
6490 Qcopy_file
= intern ("copy-file");
6491 Qmake_directory_internal
= intern ("make-directory-internal");
6492 Qmake_directory
= intern ("make-directory");
6493 Qdelete_directory
= intern ("delete-directory");
6494 Qdelete_file
= intern ("delete-file");
6495 Qrename_file
= intern ("rename-file");
6496 Qadd_name_to_file
= intern ("add-name-to-file");
6497 Qmake_symbolic_link
= intern ("make-symbolic-link");
6498 Qfile_exists_p
= intern ("file-exists-p");
6499 Qfile_executable_p
= intern ("file-executable-p");
6500 Qfile_readable_p
= intern ("file-readable-p");
6501 Qfile_writable_p
= intern ("file-writable-p");
6502 Qfile_symlink_p
= intern ("file-symlink-p");
6503 Qaccess_file
= intern ("access-file");
6504 Qfile_directory_p
= intern ("file-directory-p");
6505 Qfile_regular_p
= intern ("file-regular-p");
6506 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6507 Qfile_modes
= intern ("file-modes");
6508 Qset_file_modes
= intern ("set-file-modes");
6509 Qset_file_times
= intern ("set-file-times");
6510 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6511 Qinsert_file_contents
= intern ("insert-file-contents");
6512 Qwrite_region
= intern ("write-region");
6513 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6514 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6515 Qauto_save_coding
= intern ("auto-save-coding");
6517 staticpro (&Qoperations
);
6518 staticpro (&Qexpand_file_name
);
6519 staticpro (&Qsubstitute_in_file_name
);
6520 staticpro (&Qdirectory_file_name
);
6521 staticpro (&Qfile_name_directory
);
6522 staticpro (&Qfile_name_nondirectory
);
6523 staticpro (&Qunhandled_file_name_directory
);
6524 staticpro (&Qfile_name_as_directory
);
6525 staticpro (&Qcopy_file
);
6526 staticpro (&Qmake_directory_internal
);
6527 staticpro (&Qmake_directory
);
6528 staticpro (&Qdelete_directory
);
6529 staticpro (&Qdelete_file
);
6530 staticpro (&Qrename_file
);
6531 staticpro (&Qadd_name_to_file
);
6532 staticpro (&Qmake_symbolic_link
);
6533 staticpro (&Qfile_exists_p
);
6534 staticpro (&Qfile_executable_p
);
6535 staticpro (&Qfile_readable_p
);
6536 staticpro (&Qfile_writable_p
);
6537 staticpro (&Qaccess_file
);
6538 staticpro (&Qfile_symlink_p
);
6539 staticpro (&Qfile_directory_p
);
6540 staticpro (&Qfile_regular_p
);
6541 staticpro (&Qfile_accessible_directory_p
);
6542 staticpro (&Qfile_modes
);
6543 staticpro (&Qset_file_modes
);
6544 staticpro (&Qset_file_times
);
6545 staticpro (&Qfile_newer_than_file_p
);
6546 staticpro (&Qinsert_file_contents
);
6547 staticpro (&Qwrite_region
);
6548 staticpro (&Qverify_visited_file_modtime
);
6549 staticpro (&Qset_visited_file_modtime
);
6550 staticpro (&Qauto_save_coding
);
6552 Qfile_name_history
= intern ("file-name-history");
6553 Fset (Qfile_name_history
, Qnil
);
6554 staticpro (&Qfile_name_history
);
6556 Qfile_error
= intern ("file-error");
6557 staticpro (&Qfile_error
);
6558 Qfile_already_exists
= intern ("file-already-exists");
6559 staticpro (&Qfile_already_exists
);
6560 Qfile_date_error
= intern ("file-date-error");
6561 staticpro (&Qfile_date_error
);
6562 Qexcl
= intern ("excl");
6566 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6567 staticpro (&Qfind_buffer_file_type
);
6570 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6571 doc
: /* *Coding system for encoding file names.
6572 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6573 Vfile_name_coding_system
= Qnil
;
6575 DEFVAR_LISP ("default-file-name-coding-system",
6576 &Vdefault_file_name_coding_system
,
6577 doc
: /* Default coding system for encoding file names.
6578 This variable is used only when `file-name-coding-system' is nil.
6580 This variable is set/changed by the command `set-language-environment'.
6581 User should not set this variable manually,
6582 instead use `file-name-coding-system' to get a constant encoding
6583 of file names regardless of the current language environment. */);
6584 Vdefault_file_name_coding_system
= Qnil
;
6586 Qformat_decode
= intern ("format-decode");
6587 staticpro (&Qformat_decode
);
6588 Qformat_annotate_function
= intern ("format-annotate-function");
6589 staticpro (&Qformat_annotate_function
);
6590 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6591 staticpro (&Qafter_insert_file_set_coding
);
6593 Qcar_less_than_car
= intern ("car-less-than-car");
6594 staticpro (&Qcar_less_than_car
);
6596 Fput (Qfile_error
, Qerror_conditions
,
6597 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6598 Fput (Qfile_error
, Qerror_message
,
6599 build_string ("File error"));
6601 Fput (Qfile_already_exists
, Qerror_conditions
,
6602 Fcons (Qfile_already_exists
,
6603 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6604 Fput (Qfile_already_exists
, Qerror_message
,
6605 build_string ("File already exists"));
6607 Fput (Qfile_date_error
, Qerror_conditions
,
6608 Fcons (Qfile_date_error
,
6609 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6610 Fput (Qfile_date_error
, Qerror_message
,
6611 build_string ("Cannot set file date"));
6613 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6614 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6615 Vread_file_name_function
= Qnil
;
6617 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6618 doc
: /* Current predicate used by `read-file-name-internal'. */);
6619 Vread_file_name_predicate
= Qnil
;
6621 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case
,
6622 doc
: /* *Non-nil means when reading a file name completion ignores case. */);
6623 #if defined VMS || defined DOS_NT || defined MAC_OS
6624 read_file_name_completion_ignore_case
= 1;
6626 read_file_name_completion_ignore_case
= 0;
6629 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6630 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6631 If the initial minibuffer contents are non-empty, you can usually
6632 request a default filename by typing RETURN without editing. For some
6633 commands, exiting with an empty minibuffer has a special meaning,
6634 such as making the current buffer visit no file in the case of
6635 `set-visited-file-name'.
6636 If this variable is non-nil, the minibuffer contents are always
6637 initially non-empty and typing RETURN without editing will fetch the
6638 default name, if one is provided. Note however that this default name
6639 is not necessarily the name originally inserted in the minibuffer, if
6640 that is just the default directory.
6641 If this variable is nil, the minibuffer often starts out empty. In
6642 that case you may have to explicitly fetch the next history element to
6643 request the default name. */);
6644 insert_default_directory
= 1;
6646 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6647 doc
: /* *Non-nil means write new files with record format `stmlf'.
6648 nil means use format `var'. This variable is meaningful only on VMS. */);
6649 vms_stmlf_recfm
= 0;
6651 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6652 doc
: /* Directory separator character for built-in functions that return file names.
6653 The value is always ?/. Don't use this variable, just use `/'. */);
6655 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6656 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6657 If a file name matches REGEXP, then all I/O on that file is done by calling
6660 The first argument given to HANDLER is the name of the I/O primitive
6661 to be handled; the remaining arguments are the arguments that were
6662 passed to that primitive. For example, if you do
6663 (file-exists-p FILENAME)
6664 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6665 (funcall HANDLER 'file-exists-p FILENAME)
6666 The function `find-file-name-handler' checks this list for a handler
6667 for its argument. */);
6668 Vfile_name_handler_alist
= Qnil
;
6670 DEFVAR_LISP ("set-auto-coding-function",
6671 &Vset_auto_coding_function
,
6672 doc
: /* If non-nil, a function to call to decide a coding system of file.
6673 Two arguments are passed to this function: the file name
6674 and the length of a file contents following the point.
6675 This function should return a coding system to decode the file contents.
6676 It should check the file name against `auto-coding-alist'.
6677 If no coding system is decided, it should check a coding system
6678 specified in the heading lines with the format:
6679 -*- ... coding: CODING-SYSTEM; ... -*-
6680 or local variable spec of the tailing lines with `coding:' tag. */);
6681 Vset_auto_coding_function
= Qnil
;
6683 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6684 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6685 Each is passed one argument, the number of characters inserted.
6686 It should return the new character count, and leave point the same.
6687 If `insert-file-contents' is intercepted by a handler from
6688 `file-name-handler-alist', that handler is responsible for calling the
6689 functions in `after-insert-file-functions' if appropriate. */);
6690 Vafter_insert_file_functions
= Qnil
;
6692 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6693 doc
: /* A list of functions to be called at the start of `write-region'.
6694 Each is passed two arguments, START and END as for `write-region'.
6695 These are usually two numbers but not always; see the documentation
6696 for `write-region'. The function should return a list of pairs
6697 of the form (POSITION . STRING), consisting of strings to be effectively
6698 inserted at the specified positions of the file being written (1 means to
6699 insert before the first byte written). The POSITIONs must be sorted into
6700 increasing order. If there are several functions in the list, the several
6701 lists are merged destructively. Alternatively, the function can return
6702 with a different buffer current; in that case it should pay attention
6703 to the annotations returned by previous functions and listed in
6704 `write-region-annotations-so-far'.*/);
6705 Vwrite_region_annotate_functions
= Qnil
;
6706 staticpro (&Qwrite_region_annotate_functions
);
6707 Qwrite_region_annotate_functions
6708 = intern ("write-region-annotate-functions");
6710 DEFVAR_LISP ("write-region-annotations-so-far",
6711 &Vwrite_region_annotations_so_far
,
6712 doc
: /* When an annotation function is called, this holds the previous annotations.
6713 These are the annotations made by other annotation functions
6714 that were already called. See also `write-region-annotate-functions'. */);
6715 Vwrite_region_annotations_so_far
= Qnil
;
6717 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6718 doc
: /* A list of file name handlers that temporarily should not be used.
6719 This applies only to the operation `inhibit-file-name-operation'. */);
6720 Vinhibit_file_name_handlers
= Qnil
;
6722 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6723 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6724 Vinhibit_file_name_operation
= Qnil
;
6726 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6727 doc
: /* File name in which we write a list of all auto save file names.
6728 This variable is initialized automatically from `auto-save-list-file-prefix'
6729 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6730 a non-nil value. */);
6731 Vauto_save_list_file_name
= Qnil
;
6733 defsubr (&Sfind_file_name_handler
);
6734 defsubr (&Sfile_name_directory
);
6735 defsubr (&Sfile_name_nondirectory
);
6736 defsubr (&Sunhandled_file_name_directory
);
6737 defsubr (&Sfile_name_as_directory
);
6738 defsubr (&Sdirectory_file_name
);
6739 defsubr (&Smake_temp_name
);
6740 defsubr (&Sexpand_file_name
);
6741 defsubr (&Ssubstitute_in_file_name
);
6742 defsubr (&Scopy_file
);
6743 defsubr (&Smake_directory_internal
);
6744 defsubr (&Sdelete_directory
);
6745 defsubr (&Sdelete_file
);
6746 defsubr (&Srename_file
);
6747 defsubr (&Sadd_name_to_file
);
6749 defsubr (&Smake_symbolic_link
);
6750 #endif /* S_IFLNK */
6752 defsubr (&Sdefine_logical_name
);
6755 defsubr (&Ssysnetunam
);
6756 #endif /* HPUX_NET */
6757 defsubr (&Sfile_name_absolute_p
);
6758 defsubr (&Sfile_exists_p
);
6759 defsubr (&Sfile_executable_p
);
6760 defsubr (&Sfile_readable_p
);
6761 defsubr (&Sfile_writable_p
);
6762 defsubr (&Saccess_file
);
6763 defsubr (&Sfile_symlink_p
);
6764 defsubr (&Sfile_directory_p
);
6765 defsubr (&Sfile_accessible_directory_p
);
6766 defsubr (&Sfile_regular_p
);
6767 defsubr (&Sfile_modes
);
6768 defsubr (&Sset_file_modes
);
6769 defsubr (&Sset_file_times
);
6770 defsubr (&Sset_default_file_modes
);
6771 defsubr (&Sdefault_file_modes
);
6772 defsubr (&Sfile_newer_than_file_p
);
6773 defsubr (&Sinsert_file_contents
);
6774 defsubr (&Swrite_region
);
6775 defsubr (&Scar_less_than_car
);
6776 defsubr (&Sverify_visited_file_modtime
);
6777 defsubr (&Sclear_visited_file_modtime
);
6778 defsubr (&Svisited_file_modtime
);
6779 defsubr (&Sset_visited_file_modtime
);
6780 defsubr (&Sdo_auto_save
);
6781 defsubr (&Sset_buffer_auto_saved
);
6782 defsubr (&Sclear_buffer_auto_save_failure
);
6783 defsubr (&Srecent_auto_save_p
);
6785 defsubr (&Sread_file_name_internal
);
6786 defsubr (&Sread_file_name
);
6787 defsubr (&Snext_read_file_uses_dialog_p
);
6790 defsubr (&Sunix_sync
);
6794 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6795 (do not change this comment) */