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.
1655 Turned off on DOS_NT systems because they have no
1656 "superroot" and because this causes us to produce
1657 file names like "d:/../foo" which fail file-related
1658 functions of the underlying OS. (To reproduce, try a
1659 long series of "../../" in default_directory, longer
1660 than the number of levels from the root.) */
1664 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1666 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1668 /* Keep initial / only if this is the whole name. */
1669 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1674 && IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1]))
1676 /* Collapse multiple `/' in a row. */
1678 while (IS_DIRECTORY_SEP (*p
))
1685 #endif /* not VMS */
1689 /* At last, set drive name. */
1691 /* Except for network file name. */
1692 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1693 #endif /* WINDOWSNT */
1695 if (!drive
) abort ();
1697 target
[0] = DRIVE_LETTER (drive
);
1700 /* Reinsert the escape prefix if required. */
1707 CORRECT_DIR_SEPS (target
);
1710 result
= make_specified_string (target
, -1, o
- target
,
1711 STRING_MULTIBYTE (name
));
1713 /* Again look to see if the file name has special constructs in it
1714 and perhaps call the corresponding file handler. This is needed
1715 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1716 the ".." component gives us "/user@host:/bar/../baz" which needs
1717 to be expanded again. */
1718 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1719 if (!NILP (handler
))
1720 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1726 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1727 This is the old version of expand-file-name, before it was thoroughly
1728 rewritten for Emacs 10.31. We leave this version here commented-out,
1729 because the code is very complex and likely to have subtle bugs. If
1730 bugs _are_ found, it might be of interest to look at the old code and
1731 see what did it do in the relevant situation.
1733 Don't remove this code: it's true that it will be accessible via CVS,
1734 but a few years from deletion, people will forget it is there. */
1736 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1737 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1738 "Convert FILENAME to absolute, and canonicalize it.\n\
1739 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1740 \(does not start with slash); if DEFAULT is nil or missing,\n\
1741 the current buffer's value of default-directory is used.\n\
1742 Filenames containing `.' or `..' as components are simplified;\n\
1743 initial `~/' expands to your home directory.\n\
1744 See also the function `substitute-in-file-name'.")
1746 Lisp_Object name
, defalt
;
1750 register unsigned char *newdir
, *p
, *o
;
1752 unsigned char *target
;
1756 unsigned char * colon
= 0;
1757 unsigned char * close
= 0;
1758 unsigned char * slash
= 0;
1759 unsigned char * brack
= 0;
1760 int lbrack
= 0, rbrack
= 0;
1764 CHECK_STRING (name
);
1767 /* Filenames on VMS are always upper case. */
1768 name
= Fupcase (name
);
1773 /* If nm is absolute, flush ...// and detect /./ and /../.
1774 If no /./ or /../ we can return right away. */
1786 if (p
[0] == '/' && p
[1] == '/'
1788 /* // at start of filename is meaningful on Apollo system. */
1793 if (p
[0] == '/' && p
[1] == '~')
1794 nm
= p
+ 1, lose
= 1;
1795 if (p
[0] == '/' && p
[1] == '.'
1796 && (p
[2] == '/' || p
[2] == 0
1797 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1803 /* if dev:[dir]/, move nm to / */
1804 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1805 nm
= (brack
? brack
+ 1 : colon
+ 1);
1806 lbrack
= rbrack
= 0;
1814 /* VMS pre V4.4,convert '-'s in filenames. */
1815 if (lbrack
== rbrack
)
1817 if (dots
< 2) /* this is to allow negative version numbers */
1822 if (lbrack
> rbrack
&&
1823 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1824 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1830 /* count open brackets, reset close bracket pointer */
1831 if (p
[0] == '[' || p
[0] == '<')
1832 lbrack
++, brack
= 0;
1833 /* count close brackets, set close bracket pointer */
1834 if (p
[0] == ']' || p
[0] == '>')
1835 rbrack
++, brack
= p
;
1836 /* detect ][ or >< */
1837 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1839 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1840 nm
= p
+ 1, lose
= 1;
1841 if (p
[0] == ':' && (colon
|| slash
))
1842 /* if dev1:[dir]dev2:, move nm to dev2: */
1848 /* If /name/dev:, move nm to dev: */
1851 /* If node::dev:, move colon following dev */
1852 else if (colon
&& colon
[-1] == ':')
1854 /* If dev1:dev2:, move nm to dev2: */
1855 else if (colon
&& colon
[-1] != ':')
1860 if (p
[0] == ':' && !colon
)
1866 if (lbrack
== rbrack
)
1869 else if (p
[0] == '.')
1877 if (index (nm
, '/'))
1878 return build_string (sys_translate_unix (nm
));
1880 if (nm
== SDATA (name
))
1882 return build_string (nm
);
1886 /* Now determine directory to start with and put it in NEWDIR */
1890 if (nm
[0] == '~') /* prefix ~ */
1895 || nm
[1] == 0)/* ~/filename */
1897 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1898 newdir
= (unsigned char *) "";
1901 nm
++; /* Don't leave the slash in nm. */
1904 else /* ~user/filename */
1906 /* Get past ~ to user */
1907 unsigned char *user
= nm
+ 1;
1908 /* Find end of name. */
1909 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1910 int len
= ptr
? ptr
- user
: strlen (user
);
1912 unsigned char *ptr1
= index (user
, ':');
1913 if (ptr1
!= 0 && ptr1
- user
< len
)
1916 /* Copy the user name into temp storage. */
1917 o
= (unsigned char *) alloca (len
+ 1);
1918 bcopy ((char *) user
, o
, len
);
1921 /* Look up the user name. */
1922 pw
= (struct passwd
*) getpwnam (o
+ 1);
1924 error ("\"%s\" isn't a registered user", o
+ 1);
1926 newdir
= (unsigned char *) pw
->pw_dir
;
1928 /* Discard the user name from NM. */
1935 #endif /* not VMS */
1939 defalt
= current_buffer
->directory
;
1940 CHECK_STRING (defalt
);
1941 newdir
= SDATA (defalt
);
1944 /* Now concatenate the directory and name to new space in the stack frame */
1946 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1947 target
= (unsigned char *) alloca (tlen
);
1953 if (nm
[0] == 0 || nm
[0] == '/')
1954 strcpy (target
, newdir
);
1957 file_name_as_directory (target
, newdir
);
1960 strcat (target
, nm
);
1962 if (index (target
, '/'))
1963 strcpy (target
, sys_translate_unix (target
));
1966 /* Now canonicalize by removing /. and /foo/.. if they appear */
1974 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1980 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1981 /* brackets are offset from each other by 2 */
1984 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1985 /* convert [foo][bar] to [bar] */
1986 while (o
[-1] != '[' && o
[-1] != '<')
1988 else if (*p
== '-' && *o
!= '.')
1991 else if (p
[0] == '-' && o
[-1] == '.' &&
1992 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1993 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1997 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1998 if (p
[1] == '.') /* foo.-.bar ==> bar. */
2000 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
2002 /* else [foo.-] ==> [-] */
2008 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
2009 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2019 else if (!strncmp (p
, "//", 2)
2021 /* // at start of filename is meaningful in Apollo system. */
2029 else if (p
[0] == '/' && p
[1] == '.' &&
2030 (p
[2] == '/' || p
[2] == 0))
2032 else if (!strncmp (p
, "/..", 3)
2033 /* `/../' is the "superroot" on certain file systems. */
2035 && (p
[3] == '/' || p
[3] == 0))
2037 while (o
!= target
&& *--o
!= '/')
2040 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2044 if (o
== target
&& *o
== '/')
2052 #endif /* not VMS */
2055 return make_string (target
, o
- target
);
2059 /* If /~ or // appears, discard everything through first slash. */
2061 file_name_absolute_p (filename
)
2062 const unsigned char *filename
;
2065 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
2067 /* ??? This criterion is probably wrong for '<'. */
2068 || index (filename
, ':') || index (filename
, '<')
2069 || (*filename
== '[' && (filename
[1] != '-'
2070 || (filename
[2] != '.' && filename
[2] != ']'))
2071 && filename
[1] != '.')
2074 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
2075 && IS_DIRECTORY_SEP (filename
[2]))
2080 static unsigned char *
2081 search_embedded_absfilename (nm
, endp
)
2082 unsigned char *nm
, *endp
;
2084 unsigned char *p
, *s
;
2086 for (p
= nm
+ 1; p
< endp
; p
++)
2090 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2092 || IS_DIRECTORY_SEP (p
[-1]))
2093 && file_name_absolute_p (p
)
2094 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2095 /* // at start of file name is meaningful in Apollo,
2096 WindowsNT and Cygwin systems. */
2097 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
2098 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2101 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2106 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2108 unsigned char *o
= alloca (s
- p
+ 1);
2110 bcopy (p
, o
, s
- p
);
2113 /* If we have ~user and `user' exists, discard
2114 everything up to ~. But if `user' does not exist, leave
2115 ~user alone, it might be a literal file name. */
2116 if ((pw
= getpwnam (o
+ 1)))
2128 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2129 Ssubstitute_in_file_name
, 1, 1, 0,
2130 doc
: /* Substitute environment variables referred to in FILENAME.
2131 `$FOO' where FOO is an environment variable name means to substitute
2132 the value of that variable. The variable name should be terminated
2133 with a character not a letter, digit or underscore; otherwise, enclose
2134 the entire variable name in braces.
2135 If `/~' appears, all of FILENAME through that `/' is discarded.
2137 On VMS, `$' substitution is not done; this function does little and only
2138 duplicates what `expand-file-name' does. */)
2140 Lisp_Object filename
;
2144 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2145 unsigned char *target
= NULL
;
2147 int substituted
= 0;
2149 Lisp_Object handler
;
2151 CHECK_STRING (filename
);
2153 /* If the file name has special constructs in it,
2154 call the corresponding file handler. */
2155 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2156 if (!NILP (handler
))
2157 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2159 nm
= SDATA (filename
);
2161 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2162 CORRECT_DIR_SEPS (nm
);
2163 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2165 endp
= nm
+ SBYTES (filename
);
2167 /* If /~ or // appears, discard everything through first slash. */
2168 p
= search_embedded_absfilename (nm
, endp
);
2170 /* Start over with the new string, so we check the file-name-handler
2171 again. Important with filenames like "/home/foo//:/hello///there"
2172 which whould substitute to "/:/hello///there" rather than "/there". */
2173 return Fsubstitute_in_file_name
2174 (make_specified_string (p
, -1, endp
- p
,
2175 STRING_MULTIBYTE (filename
)));
2181 /* See if any variables are substituted into the string
2182 and find the total length of their values in `total' */
2184 for (p
= nm
; p
!= endp
;)
2194 /* "$$" means a single "$" */
2203 while (p
!= endp
&& *p
!= '}') p
++;
2204 if (*p
!= '}') goto missingclose
;
2210 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2214 /* Copy out the variable name */
2215 target
= (unsigned char *) alloca (s
- o
+ 1);
2216 strncpy (target
, o
, s
- o
);
2219 strupr (target
); /* $home == $HOME etc. */
2222 /* Get variable value */
2223 o
= (unsigned char *) egetenv (target
);
2226 total
+= strlen (o
);
2236 /* If substitution required, recopy the string and do it */
2237 /* Make space in stack frame for the new copy */
2238 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2241 /* Copy the rest of the name through, replacing $ constructs with values */
2258 while (p
!= endp
&& *p
!= '}') p
++;
2259 if (*p
!= '}') goto missingclose
;
2265 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2269 /* Copy out the variable name */
2270 target
= (unsigned char *) alloca (s
- o
+ 1);
2271 strncpy (target
, o
, s
- o
);
2274 strupr (target
); /* $home == $HOME etc. */
2277 /* Get variable value */
2278 o
= (unsigned char *) egetenv (target
);
2282 strcpy (x
, target
); x
+= strlen (target
);
2284 else if (STRING_MULTIBYTE (filename
))
2286 /* If the original string is multibyte,
2287 convert what we substitute into multibyte. */
2290 int c
= unibyte_char_to_multibyte (*o
++);
2291 x
+= CHAR_STRING (c
, x
);
2303 /* If /~ or // appears, discard everything through first slash. */
2304 while ((p
= search_embedded_absfilename (xnm
, x
)))
2305 /* This time we do not start over because we've already expanded envvars
2306 and replaced $$ with $. Maybe we should start over as well, but we'd
2307 need to quote some $ to $$ first. */
2310 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2313 error ("Bad format environment-variable substitution");
2315 error ("Missing \"}\" in environment-variable substitution");
2317 error ("Substituting nonexistent environment variable \"%s\"", target
);
2320 #endif /* not VMS */
2324 /* A slightly faster and more convenient way to get
2325 (directory-file-name (expand-file-name FOO)). */
2328 expand_and_dir_to_file (filename
, defdir
)
2329 Lisp_Object filename
, defdir
;
2331 register Lisp_Object absname
;
2333 absname
= Fexpand_file_name (filename
, defdir
);
2336 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2337 if (c
== ':' || c
== ']' || c
== '>')
2338 absname
= Fdirectory_file_name (absname
);
2341 /* Remove final slash, if any (unless this is the root dir).
2342 stat behaves differently depending! */
2343 if (SCHARS (absname
) > 1
2344 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2345 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2346 /* We cannot take shortcuts; they might be wrong for magic file names. */
2347 absname
= Fdirectory_file_name (absname
);
2352 /* Signal an error if the file ABSNAME already exists.
2353 If INTERACTIVE is nonzero, ask the user whether to proceed,
2354 and bypass the error if the user says to go ahead.
2355 QUERYSTRING is a name for the action that is being considered
2358 *STATPTR is used to store the stat information if the file exists.
2359 If the file does not exist, STATPTR->st_mode is set to 0.
2360 If STATPTR is null, we don't store into it.
2362 If QUICK is nonzero, we ask for y or n, not yes or no. */
2365 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2366 Lisp_Object absname
;
2367 unsigned char *querystring
;
2369 struct stat
*statptr
;
2372 register Lisp_Object tem
, encoded_filename
;
2373 struct stat statbuf
;
2374 struct gcpro gcpro1
;
2376 encoded_filename
= ENCODE_FILE (absname
);
2378 /* stat is a good way to tell whether the file exists,
2379 regardless of what access permissions it has. */
2380 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
2383 Fsignal (Qfile_already_exists
,
2384 Fcons (build_string ("File already exists"),
2385 Fcons (absname
, Qnil
)));
2387 tem
= format2 ("File %s already exists; %s anyway? ",
2388 absname
, build_string (querystring
));
2390 tem
= Fy_or_n_p (tem
);
2392 tem
= do_yes_or_no_p (tem
);
2395 Fsignal (Qfile_already_exists
,
2396 Fcons (build_string ("File already exists"),
2397 Fcons (absname
, Qnil
)));
2404 statptr
->st_mode
= 0;
2409 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 6,
2410 "fCopy file: \nGCopy %s to file: \np\nP",
2411 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2412 If NEWNAME names a directory, copy FILE there.
2413 Signals a `file-already-exists' error if file NEWNAME already exists,
2414 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
2415 A number as third arg means request confirmation if NEWNAME already exists.
2416 This is what happens in interactive use with M-x.
2417 Always sets the file modes of the output file to match the input file.
2419 Fourth arg KEEP-TIME non-nil means give the output file the same
2420 last-modified time as the old one. (This works on only some systems.)
2422 A prefix arg makes KEEP-TIME non-nil.
2424 The optional fifth arg MUSTBENEW, if non-nil, insists on a check
2425 for an existing file with the same name. If MUSTBENEW is `excl',
2426 that means to get an error if the file already exists; never overwrite.
2427 If MUSTBENEW is neither nil nor `excl', that means ask for
2428 confirmation before overwriting, but do go ahead and overwrite the file
2429 if the user confirms.
2431 If PRESERVE-UID-GID is non-nil, we try to transfer the
2432 uid and gid of FILE to NEWNAME. */)
2433 (file
, newname
, ok_if_already_exists
, keep_time
, mustbenew
, preserve_uid_gid
)
2434 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
, mustbenew
;
2435 Lisp_Object preserve_uid_gid
;
2438 char buf
[16 * 1024];
2439 struct stat st
, out_st
;
2440 Lisp_Object handler
;
2441 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2442 int count
= SPECPDL_INDEX ();
2443 int input_file_statable_p
;
2444 Lisp_Object encoded_file
, encoded_newname
;
2446 encoded_file
= encoded_newname
= Qnil
;
2447 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2448 CHECK_STRING (file
);
2449 CHECK_STRING (newname
);
2451 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
2452 barf_or_query_if_file_exists (newname
, "overwrite", 1, 0, 1);
2454 if (!NILP (Ffile_directory_p (newname
)))
2455 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2457 newname
= Fexpand_file_name (newname
, Qnil
);
2459 file
= Fexpand_file_name (file
, Qnil
);
2461 /* If the input file name has special constructs in it,
2462 call the corresponding file handler. */
2463 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2464 /* Likewise for output file name. */
2466 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2467 if (!NILP (handler
))
2468 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2469 ok_if_already_exists
, keep_time
));
2471 encoded_file
= ENCODE_FILE (file
);
2472 encoded_newname
= ENCODE_FILE (newname
);
2474 if (NILP (ok_if_already_exists
)
2475 || INTEGERP (ok_if_already_exists
))
2476 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2477 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2478 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2482 if (!CopyFile (SDATA (encoded_file
),
2483 SDATA (encoded_newname
),
2485 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2486 /* CopyFile retains the timestamp by default. */
2487 else if (NILP (keep_time
))
2493 EMACS_GET_TIME (now
);
2494 filename
= SDATA (encoded_newname
);
2496 /* Ensure file is writable while its modified time is set. */
2497 attributes
= GetFileAttributes (filename
);
2498 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2499 if (set_file_times (filename
, now
, now
))
2501 /* Restore original attributes. */
2502 SetFileAttributes (filename
, attributes
);
2503 Fsignal (Qfile_date_error
,
2504 Fcons (build_string ("Cannot set file date"),
2505 Fcons (newname
, Qnil
)));
2507 /* Restore original attributes. */
2508 SetFileAttributes (filename
, attributes
);
2510 #else /* not WINDOWSNT */
2512 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2516 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2518 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2520 /* We can only copy regular files and symbolic links. Other files are not
2522 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2524 #if !defined (DOS_NT) || __DJGPP__ > 1
2525 if (out_st
.st_mode
!= 0
2526 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2529 report_file_error ("Input and output files are the same",
2530 Fcons (file
, Fcons (newname
, Qnil
)));
2534 #if defined (S_ISREG) && defined (S_ISLNK)
2535 if (input_file_statable_p
)
2537 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2539 #if defined (EISDIR)
2540 /* Get a better looking error message. */
2543 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2546 #endif /* S_ISREG && S_ISLNK */
2549 /* Create the copy file with the same record format as the input file */
2550 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2553 /* System's default file type was set to binary by _fmode in emacs.c. */
2554 ofd
= emacs_open (SDATA (encoded_newname
),
2555 O_WRONLY
| O_TRUNC
| O_CREAT
2556 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
2557 S_IREAD
| S_IWRITE
);
2558 #else /* not MSDOS */
2559 ofd
= emacs_open (SDATA (encoded_newname
),
2560 O_WRONLY
| O_TRUNC
| O_CREAT
2561 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
2563 #endif /* not MSDOS */
2566 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2568 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2572 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2573 if (emacs_write (ofd
, buf
, n
) != n
)
2574 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2577 /* Preserve the owner and group, if requested. */
2578 if (input_file_statable_p
&& ! NILP (preserve_uid_gid
))
2579 fchown (ofd
, st
.st_uid
, st
.st_gid
);
2581 if (input_file_statable_p
)
2584 fchmod (ofd
, st
.st_mode
& 07777);
2586 #if defined (__DJGPP__) && __DJGPP__ > 1
2587 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2588 and if it can't, it tells so. Otherwise, under MSDOS we usually
2589 get only the READ bit, which will make the copied file read-only,
2590 so it's better not to chmod at all. */
2591 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2592 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2593 #endif /* DJGPP version 2 or newer */
2597 /* Closing the output clobbers the file times on some systems. */
2598 if (emacs_close (ofd
) < 0)
2599 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2601 if (input_file_statable_p
)
2603 if (!NILP (keep_time
))
2605 EMACS_TIME atime
, mtime
;
2606 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2607 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2608 if (set_file_times (SDATA (encoded_newname
),
2610 Fsignal (Qfile_date_error
,
2611 Fcons (build_string ("Cannot set file date"),
2612 Fcons (newname
, Qnil
)));
2617 #endif /* WINDOWSNT */
2619 /* Discard the unwind protects. */
2620 specpdl_ptr
= specpdl
+ count
;
2626 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2627 Smake_directory_internal
, 1, 1, 0,
2628 doc
: /* Create a new directory named DIRECTORY. */)
2630 Lisp_Object directory
;
2632 const unsigned char *dir
;
2633 Lisp_Object handler
;
2634 Lisp_Object encoded_dir
;
2636 CHECK_STRING (directory
);
2637 directory
= Fexpand_file_name (directory
, Qnil
);
2639 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2640 if (!NILP (handler
))
2641 return call2 (handler
, Qmake_directory_internal
, directory
);
2643 encoded_dir
= ENCODE_FILE (directory
);
2645 dir
= SDATA (encoded_dir
);
2648 if (mkdir (dir
) != 0)
2650 if (mkdir (dir
, 0777) != 0)
2652 report_file_error ("Creating directory", Flist (1, &directory
));
2657 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2658 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2660 Lisp_Object directory
;
2662 const unsigned char *dir
;
2663 Lisp_Object handler
;
2664 Lisp_Object encoded_dir
;
2666 CHECK_STRING (directory
);
2667 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2669 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2670 if (!NILP (handler
))
2671 return call2 (handler
, Qdelete_directory
, directory
);
2673 encoded_dir
= ENCODE_FILE (directory
);
2675 dir
= SDATA (encoded_dir
);
2677 if (rmdir (dir
) != 0)
2678 report_file_error ("Removing directory", Flist (1, &directory
));
2683 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2684 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2685 If file has multiple names, it continues to exist with the other names. */)
2687 Lisp_Object filename
;
2689 Lisp_Object handler
;
2690 Lisp_Object encoded_file
;
2691 struct gcpro gcpro1
;
2694 if (!NILP (Ffile_directory_p (filename
))
2695 && NILP (Ffile_symlink_p (filename
)))
2696 Fsignal (Qfile_error
,
2697 Fcons (build_string ("Removing old name: is a directory"),
2698 Fcons (filename
, Qnil
)));
2700 filename
= Fexpand_file_name (filename
, Qnil
);
2702 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2703 if (!NILP (handler
))
2704 return call2 (handler
, Qdelete_file
, filename
);
2706 encoded_file
= ENCODE_FILE (filename
);
2708 if (0 > unlink (SDATA (encoded_file
)))
2709 report_file_error ("Removing old name", Flist (1, &filename
));
2714 internal_delete_file_1 (ignore
)
2720 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2723 internal_delete_file (filename
)
2724 Lisp_Object filename
;
2726 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2727 Qt
, internal_delete_file_1
));
2730 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2731 "fRename file: \nGRename %s to file: \np",
2732 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2733 If file has names other than FILE, it continues to have those names.
2734 Signals a `file-already-exists' error if a file NEWNAME already exists
2735 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2736 A number as third arg means request confirmation if NEWNAME already exists.
2737 This is what happens in interactive use with M-x. */)
2738 (file
, newname
, ok_if_already_exists
)
2739 Lisp_Object file
, newname
, ok_if_already_exists
;
2742 Lisp_Object args
[2];
2744 Lisp_Object handler
;
2745 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2746 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2748 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2749 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2750 CHECK_STRING (file
);
2751 CHECK_STRING (newname
);
2752 file
= Fexpand_file_name (file
, Qnil
);
2754 if (!NILP (Ffile_directory_p (newname
)))
2755 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2757 newname
= Fexpand_file_name (newname
, Qnil
);
2759 /* If the file name has special constructs in it,
2760 call the corresponding file handler. */
2761 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2763 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2764 if (!NILP (handler
))
2765 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2766 file
, newname
, ok_if_already_exists
));
2768 encoded_file
= ENCODE_FILE (file
);
2769 encoded_newname
= ENCODE_FILE (newname
);
2772 /* If the file names are identical but for the case, don't ask for
2773 confirmation: they simply want to change the letter-case of the
2775 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2777 if (NILP (ok_if_already_exists
)
2778 || INTEGERP (ok_if_already_exists
))
2779 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2780 INTEGERP (ok_if_already_exists
), 0, 0);
2782 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2784 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2785 || 0 > unlink (SDATA (encoded_file
)))
2791 symlink_target
= Ffile_symlink_p (file
);
2792 if (! NILP (symlink_target
))
2793 Fmake_symbolic_link (symlink_target
, newname
,
2794 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2797 Fcopy_file (file
, newname
,
2798 /* We have already prompted if it was an integer,
2799 so don't have copy-file prompt again. */
2800 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2803 Fdelete_file (file
);
2810 report_file_error ("Renaming", Flist (2, args
));
2813 report_file_error ("Renaming", Flist (2, &file
));
2820 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2821 "fAdd name to file: \nGName to add to %s: \np",
2822 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2823 Signals a `file-already-exists' error if a file NEWNAME already exists
2824 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2825 A number as third arg means request confirmation if NEWNAME already exists.
2826 This is what happens in interactive use with M-x. */)
2827 (file
, newname
, ok_if_already_exists
)
2828 Lisp_Object file
, newname
, ok_if_already_exists
;
2831 Lisp_Object args
[2];
2833 Lisp_Object handler
;
2834 Lisp_Object encoded_file
, encoded_newname
;
2835 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2837 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2838 encoded_file
= encoded_newname
= Qnil
;
2839 CHECK_STRING (file
);
2840 CHECK_STRING (newname
);
2841 file
= Fexpand_file_name (file
, Qnil
);
2843 if (!NILP (Ffile_directory_p (newname
)))
2844 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2846 newname
= Fexpand_file_name (newname
, Qnil
);
2848 /* If the file name has special constructs in it,
2849 call the corresponding file handler. */
2850 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2851 if (!NILP (handler
))
2852 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2853 newname
, ok_if_already_exists
));
2855 /* If the new name has special constructs in it,
2856 call the corresponding file handler. */
2857 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2858 if (!NILP (handler
))
2859 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2860 newname
, ok_if_already_exists
));
2862 encoded_file
= ENCODE_FILE (file
);
2863 encoded_newname
= ENCODE_FILE (newname
);
2865 if (NILP (ok_if_already_exists
)
2866 || INTEGERP (ok_if_already_exists
))
2867 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2868 INTEGERP (ok_if_already_exists
), 0, 0);
2870 unlink (SDATA (newname
));
2871 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2876 report_file_error ("Adding new name", Flist (2, args
));
2878 report_file_error ("Adding new name", Flist (2, &file
));
2887 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2888 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2889 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2890 Both args must be strings.
2891 Signals a `file-already-exists' error if a file LINKNAME already exists
2892 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2893 A number as third arg means request confirmation if LINKNAME already exists.
2894 This happens for interactive use with M-x. */)
2895 (filename
, linkname
, ok_if_already_exists
)
2896 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2899 Lisp_Object args
[2];
2901 Lisp_Object handler
;
2902 Lisp_Object encoded_filename
, encoded_linkname
;
2903 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2905 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2906 encoded_filename
= encoded_linkname
= Qnil
;
2907 CHECK_STRING (filename
);
2908 CHECK_STRING (linkname
);
2909 /* If the link target has a ~, we must expand it to get
2910 a truly valid file name. Otherwise, do not expand;
2911 we want to permit links to relative file names. */
2912 if (SREF (filename
, 0) == '~')
2913 filename
= Fexpand_file_name (filename
, Qnil
);
2915 if (!NILP (Ffile_directory_p (linkname
)))
2916 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2918 linkname
= Fexpand_file_name (linkname
, Qnil
);
2920 /* If the file name has special constructs in it,
2921 call the corresponding file handler. */
2922 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2923 if (!NILP (handler
))
2924 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2925 linkname
, ok_if_already_exists
));
2927 /* If the new link name has special constructs in it,
2928 call the corresponding file handler. */
2929 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2930 if (!NILP (handler
))
2931 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2932 linkname
, ok_if_already_exists
));
2934 encoded_filename
= ENCODE_FILE (filename
);
2935 encoded_linkname
= ENCODE_FILE (linkname
);
2937 if (NILP (ok_if_already_exists
)
2938 || INTEGERP (ok_if_already_exists
))
2939 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2940 INTEGERP (ok_if_already_exists
), 0, 0);
2941 if (0 > symlink (SDATA (encoded_filename
),
2942 SDATA (encoded_linkname
)))
2944 /* If we didn't complain already, silently delete existing file. */
2945 if (errno
== EEXIST
)
2947 unlink (SDATA (encoded_linkname
));
2948 if (0 <= symlink (SDATA (encoded_filename
),
2949 SDATA (encoded_linkname
)))
2959 report_file_error ("Making symbolic link", Flist (2, args
));
2961 report_file_error ("Making symbolic link", Flist (2, &filename
));
2967 #endif /* S_IFLNK */
2971 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2972 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2973 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2974 If STRING is nil or a null string, the logical name NAME is deleted. */)
2979 CHECK_STRING (name
);
2981 delete_logical_name (SDATA (name
));
2984 CHECK_STRING (string
);
2986 if (SCHARS (string
) == 0)
2987 delete_logical_name (SDATA (name
));
2989 define_logical_name (SDATA (name
), SDATA (string
));
2998 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2999 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
3001 Lisp_Object path
, login
;
3005 CHECK_STRING (path
);
3006 CHECK_STRING (login
);
3008 netresult
= netunam (SDATA (path
), SDATA (login
));
3010 if (netresult
== -1)
3015 #endif /* HPUX_NET */
3017 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
3019 doc
: /* Return t if file FILENAME specifies an absolute file name.
3020 On Unix, this is a name starting with a `/' or a `~'. */)
3022 Lisp_Object filename
;
3024 CHECK_STRING (filename
);
3025 return file_name_absolute_p (SDATA (filename
)) ? Qt
: Qnil
;
3028 /* Return nonzero if file FILENAME exists and can be executed. */
3031 check_executable (filename
)
3035 int len
= strlen (filename
);
3038 if (stat (filename
, &st
) < 0)
3040 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
3041 return ((st
.st_mode
& S_IEXEC
) != 0);
3043 return (S_ISREG (st
.st_mode
)
3045 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
3046 || stricmp (suffix
, ".exe") == 0
3047 || stricmp (suffix
, ".bat") == 0)
3048 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3049 #endif /* not WINDOWSNT */
3050 #else /* not DOS_NT */
3051 #ifdef HAVE_EUIDACCESS
3052 return (euidaccess (filename
, 1) >= 0);
3054 /* Access isn't quite right because it uses the real uid
3055 and we really want to test with the effective uid.
3056 But Unix doesn't give us a right way to do it. */
3057 return (access (filename
, 1) >= 0);
3059 #endif /* not DOS_NT */
3062 /* Return nonzero if file FILENAME exists and can be written. */
3065 check_writable (filename
)
3070 if (stat (filename
, &st
) < 0)
3072 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3073 #else /* not MSDOS */
3074 #ifdef HAVE_EUIDACCESS
3075 return (euidaccess (filename
, 2) >= 0);
3077 /* Access isn't quite right because it uses the real uid
3078 and we really want to test with the effective uid.
3079 But Unix doesn't give us a right way to do it.
3080 Opening with O_WRONLY could work for an ordinary file,
3081 but would lose for directories. */
3082 return (access (filename
, 2) >= 0);
3084 #endif /* not MSDOS */
3087 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3088 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
3089 See also `file-readable-p' and `file-attributes'.
3090 This returns nil for a symlink to a nonexistent file.
3091 Use `file-symlink-p' to test for such links. */)
3093 Lisp_Object filename
;
3095 Lisp_Object absname
;
3096 Lisp_Object handler
;
3097 struct stat statbuf
;
3099 CHECK_STRING (filename
);
3100 absname
= Fexpand_file_name (filename
, Qnil
);
3102 /* If the file name has special constructs in it,
3103 call the corresponding file handler. */
3104 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3105 if (!NILP (handler
))
3106 return call2 (handler
, Qfile_exists_p
, absname
);
3108 absname
= ENCODE_FILE (absname
);
3110 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3113 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3114 doc
: /* Return t if FILENAME can be executed by you.
3115 For a directory, this means you can access files in that directory. */)
3117 Lisp_Object filename
;
3119 Lisp_Object absname
;
3120 Lisp_Object handler
;
3122 CHECK_STRING (filename
);
3123 absname
= Fexpand_file_name (filename
, Qnil
);
3125 /* If the file name has special constructs in it,
3126 call the corresponding file handler. */
3127 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3128 if (!NILP (handler
))
3129 return call2 (handler
, Qfile_executable_p
, absname
);
3131 absname
= ENCODE_FILE (absname
);
3133 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3136 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3137 doc
: /* Return t if file FILENAME exists and you can read it.
3138 See also `file-exists-p' and `file-attributes'. */)
3140 Lisp_Object filename
;
3142 Lisp_Object absname
;
3143 Lisp_Object handler
;
3146 struct stat statbuf
;
3148 CHECK_STRING (filename
);
3149 absname
= Fexpand_file_name (filename
, Qnil
);
3151 /* If the file name has special constructs in it,
3152 call the corresponding file handler. */
3153 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3154 if (!NILP (handler
))
3155 return call2 (handler
, Qfile_readable_p
, absname
);
3157 absname
= ENCODE_FILE (absname
);
3159 #if defined(DOS_NT) || defined(macintosh)
3160 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3162 if (access (SDATA (absname
), 0) == 0)
3165 #else /* not DOS_NT and not macintosh */
3167 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3168 /* Opening a fifo without O_NONBLOCK can wait.
3169 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3170 except in the case of a fifo, on a system which handles it. */
3171 desc
= stat (SDATA (absname
), &statbuf
);
3174 if (S_ISFIFO (statbuf
.st_mode
))
3175 flags
|= O_NONBLOCK
;
3177 desc
= emacs_open (SDATA (absname
), flags
, 0);
3182 #endif /* not DOS_NT and not macintosh */
3185 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3187 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3188 doc
: /* Return t if file FILENAME can be written or created by you. */)
3190 Lisp_Object filename
;
3192 Lisp_Object absname
, dir
, encoded
;
3193 Lisp_Object handler
;
3194 struct stat statbuf
;
3196 CHECK_STRING (filename
);
3197 absname
= Fexpand_file_name (filename
, Qnil
);
3199 /* If the file name has special constructs in it,
3200 call the corresponding file handler. */
3201 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3202 if (!NILP (handler
))
3203 return call2 (handler
, Qfile_writable_p
, absname
);
3205 encoded
= ENCODE_FILE (absname
);
3206 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3207 return (check_writable (SDATA (encoded
))
3210 dir
= Ffile_name_directory (absname
);
3213 dir
= Fdirectory_file_name (dir
);
3217 dir
= Fdirectory_file_name (dir
);
3220 dir
= ENCODE_FILE (dir
);
3222 /* The read-only attribute of the parent directory doesn't affect
3223 whether a file or directory can be created within it. Some day we
3224 should check ACLs though, which do affect this. */
3225 if (stat (SDATA (dir
), &statbuf
) < 0)
3227 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3229 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3234 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3235 doc
: /* Access file FILENAME, and get an error if that does not work.
3236 The second argument STRING is used in the error message.
3237 If there is no error, returns nil. */)
3239 Lisp_Object filename
, string
;
3241 Lisp_Object handler
, encoded_filename
, absname
;
3244 CHECK_STRING (filename
);
3245 absname
= Fexpand_file_name (filename
, Qnil
);
3247 CHECK_STRING (string
);
3249 /* If the file name has special constructs in it,
3250 call the corresponding file handler. */
3251 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3252 if (!NILP (handler
))
3253 return call3 (handler
, Qaccess_file
, absname
, string
);
3255 encoded_filename
= ENCODE_FILE (absname
);
3257 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3259 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3265 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3266 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3267 The value is the link target, as a string.
3268 Otherwise it returns nil.
3270 This function returns t when given the name of a symlink that
3271 points to a nonexistent file. */)
3273 Lisp_Object filename
;
3275 Lisp_Object handler
;
3277 CHECK_STRING (filename
);
3278 filename
= Fexpand_file_name (filename
, Qnil
);
3280 /* If the file name has special constructs in it,
3281 call the corresponding file handler. */
3282 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3283 if (!NILP (handler
))
3284 return call2 (handler
, Qfile_symlink_p
, filename
);
3293 filename
= ENCODE_FILE (filename
);
3300 buf
= (char *) xrealloc (buf
, bufsize
);
3301 bzero (buf
, bufsize
);
3304 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3308 /* HP-UX reports ERANGE if buffer is too small. */
3309 if (errno
== ERANGE
)
3319 while (valsize
>= bufsize
);
3321 val
= make_string (buf
, valsize
);
3322 if (buf
[0] == '/' && index (buf
, ':'))
3323 val
= concat2 (build_string ("/:"), val
);
3325 val
= DECODE_FILE (val
);
3328 #else /* not S_IFLNK */
3330 #endif /* not S_IFLNK */
3333 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3334 doc
: /* Return t if FILENAME names an existing directory.
3335 Symbolic links to directories count as directories.
3336 See `file-symlink-p' to distinguish symlinks. */)
3338 Lisp_Object filename
;
3340 register Lisp_Object absname
;
3342 Lisp_Object handler
;
3344 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3346 /* If the file name has special constructs in it,
3347 call the corresponding file handler. */
3348 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3349 if (!NILP (handler
))
3350 return call2 (handler
, Qfile_directory_p
, absname
);
3352 absname
= ENCODE_FILE (absname
);
3354 if (stat (SDATA (absname
), &st
) < 0)
3356 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3359 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3360 doc
: /* Return t if file FILENAME names a directory you can open.
3361 For the value to be t, FILENAME must specify the name of a directory as a file,
3362 and the directory must allow you to open files in it. In order to use a
3363 directory as a buffer's current directory, this predicate must return true.
3364 A directory name spec may be given instead; then the value is t
3365 if the directory so specified exists and really is a readable and
3366 searchable directory. */)
3368 Lisp_Object filename
;
3370 Lisp_Object handler
;
3372 struct gcpro gcpro1
;
3374 /* If the file name has special constructs in it,
3375 call the corresponding file handler. */
3376 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3377 if (!NILP (handler
))
3378 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3381 tem
= (NILP (Ffile_directory_p (filename
))
3382 || NILP (Ffile_executable_p (filename
)));
3384 return tem
? Qnil
: Qt
;
3387 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3388 doc
: /* Return t if file FILENAME is the name of a regular file.
3389 This is the sort of file that holds an ordinary stream of data bytes. */)
3391 Lisp_Object filename
;
3393 register Lisp_Object absname
;
3395 Lisp_Object handler
;
3397 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3399 /* If the file name has special constructs in it,
3400 call the corresponding file handler. */
3401 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3402 if (!NILP (handler
))
3403 return call2 (handler
, Qfile_regular_p
, absname
);
3405 absname
= ENCODE_FILE (absname
);
3410 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3412 /* Tell stat to use expensive method to get accurate info. */
3413 Vw32_get_true_file_attributes
= Qt
;
3414 result
= stat (SDATA (absname
), &st
);
3415 Vw32_get_true_file_attributes
= tem
;
3419 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3422 if (stat (SDATA (absname
), &st
) < 0)
3424 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3428 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3429 doc
: /* Return mode bits of file named FILENAME, as an integer.
3430 Return nil, if file does not exist or is not accessible. */)
3432 Lisp_Object filename
;
3434 Lisp_Object absname
;
3436 Lisp_Object handler
;
3438 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3440 /* If the file name has special constructs in it,
3441 call the corresponding file handler. */
3442 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3443 if (!NILP (handler
))
3444 return call2 (handler
, Qfile_modes
, absname
);
3446 absname
= ENCODE_FILE (absname
);
3448 if (stat (SDATA (absname
), &st
) < 0)
3450 #if defined (MSDOS) && __DJGPP__ < 2
3451 if (check_executable (SDATA (absname
)))
3452 st
.st_mode
|= S_IEXEC
;
3453 #endif /* MSDOS && __DJGPP__ < 2 */
3455 return make_number (st
.st_mode
& 07777);
3458 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3459 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3460 Only the 12 low bits of MODE are used. */)
3462 Lisp_Object filename
, mode
;
3464 Lisp_Object absname
, encoded_absname
;
3465 Lisp_Object handler
;
3467 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3468 CHECK_NUMBER (mode
);
3470 /* If the file name has special constructs in it,
3471 call the corresponding file handler. */
3472 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3473 if (!NILP (handler
))
3474 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3476 encoded_absname
= ENCODE_FILE (absname
);
3478 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3479 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3484 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3485 doc
: /* Set the file permission bits for newly created files.
3486 The argument MODE should be an integer; only the low 9 bits are used.
3487 This setting is inherited by subprocesses. */)
3491 CHECK_NUMBER (mode
);
3493 umask ((~ XINT (mode
)) & 0777);
3498 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3499 doc
: /* Return the default file protection for created files.
3500 The value is an integer. */)
3506 realmask
= umask (0);
3509 XSETINT (value
, (~ realmask
) & 0777);
3513 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3515 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3516 doc
: /* Set times of file FILENAME to TIME.
3517 Set both access and modification times.
3518 Return t on success, else nil.
3519 Use the current time if TIME is nil. TIME is in the format of
3522 Lisp_Object filename
, time
;
3524 Lisp_Object absname
, encoded_absname
;
3525 Lisp_Object handler
;
3529 if (! lisp_time_argument (time
, &sec
, &usec
))
3530 error ("Invalid time specification");
3532 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3534 /* If the file name has special constructs in it,
3535 call the corresponding file handler. */
3536 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3537 if (!NILP (handler
))
3538 return call3 (handler
, Qset_file_times
, absname
, time
);
3540 encoded_absname
= ENCODE_FILE (absname
);
3545 EMACS_SET_SECS (t
, sec
);
3546 EMACS_SET_USECS (t
, usec
);
3548 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3553 /* Setting times on a directory always fails. */
3554 if (stat (SDATA (encoded_absname
), &st
) == 0
3555 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3558 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3571 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3572 doc
: /* Tell Unix to finish all pending disk updates. */)
3581 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3582 doc
: /* Return t if file FILE1 is newer than file FILE2.
3583 If FILE1 does not exist, the answer is nil;
3584 otherwise, if FILE2 does not exist, the answer is t. */)
3586 Lisp_Object file1
, file2
;
3588 Lisp_Object absname1
, absname2
;
3591 Lisp_Object handler
;
3592 struct gcpro gcpro1
, gcpro2
;
3594 CHECK_STRING (file1
);
3595 CHECK_STRING (file2
);
3598 GCPRO2 (absname1
, file2
);
3599 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3600 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3603 /* If the file name has special constructs in it,
3604 call the corresponding file handler. */
3605 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3607 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3608 if (!NILP (handler
))
3609 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3611 GCPRO2 (absname1
, absname2
);
3612 absname1
= ENCODE_FILE (absname1
);
3613 absname2
= ENCODE_FILE (absname2
);
3616 if (stat (SDATA (absname1
), &st
) < 0)
3619 mtime1
= st
.st_mtime
;
3621 if (stat (SDATA (absname2
), &st
) < 0)
3624 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3628 Lisp_Object Qfind_buffer_file_type
;
3631 #ifndef READ_BUF_SIZE
3632 #define READ_BUF_SIZE (64 << 10)
3635 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3637 /* This function is called after Lisp functions to decide a coding
3638 system are called, or when they cause an error. Before they are
3639 called, the current buffer is set unibyte and it contains only a
3640 newly inserted text (thus the buffer was empty before the
3643 The functions may set markers, overlays, text properties, or even
3644 alter the buffer contents, change the current buffer.
3646 Here, we reset all those changes by:
3647 o set back the current buffer.
3648 o move all markers and overlays to BEG.
3649 o remove all text properties.
3650 o set back the buffer multibyteness. */
3653 decide_coding_unwind (unwind_data
)
3654 Lisp_Object unwind_data
;
3656 Lisp_Object multibyte
, undo_list
, buffer
;
3658 multibyte
= XCAR (unwind_data
);
3659 unwind_data
= XCDR (unwind_data
);
3660 undo_list
= XCAR (unwind_data
);
3661 buffer
= XCDR (unwind_data
);
3663 if (current_buffer
!= XBUFFER (buffer
))
3664 set_buffer_internal (XBUFFER (buffer
));
3665 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3666 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3667 BUF_INTERVALS (current_buffer
) = 0;
3668 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3670 /* Now we are safe to change the buffer's multibyteness directly. */
3671 current_buffer
->enable_multibyte_characters
= multibyte
;
3672 current_buffer
->undo_list
= undo_list
;
3678 /* Used to pass values from insert-file-contents to read_non_regular. */
3680 static int non_regular_fd
;
3681 static int non_regular_inserted
;
3682 static int non_regular_nbytes
;
3685 /* Read from a non-regular file.
3686 Read non_regular_trytry bytes max from non_regular_fd.
3687 Non_regular_inserted specifies where to put the read bytes.
3688 Value is the number of bytes read. */
3697 nbytes
= emacs_read (non_regular_fd
,
3698 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3699 non_regular_nbytes
);
3701 return make_number (nbytes
);
3705 /* Condition-case handler used when reading from non-regular files
3706 in insert-file-contents. */
3709 read_non_regular_quit ()
3715 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3717 doc
: /* Insert contents of file FILENAME after point.
3718 Returns list of absolute file name and number of characters inserted.
3719 If second argument VISIT is non-nil, the buffer's visited filename
3720 and last save file modtime are set, and it is marked unmodified.
3721 If visiting and the file does not exist, visiting is completed
3722 before the error is signaled.
3723 The optional third and fourth arguments BEG and END
3724 specify what portion of the file to insert.
3725 These arguments count bytes in the file, not characters in the buffer.
3726 If VISIT is non-nil, BEG and END must be nil.
3728 If optional fifth argument REPLACE is non-nil,
3729 it means replace the current buffer contents (in the accessible portion)
3730 with the file contents. This is better than simply deleting and inserting
3731 the whole thing because (1) it preserves some marker positions
3732 and (2) it puts less data in the undo list.
3733 When REPLACE is non-nil, the value is the number of characters actually read,
3734 which is often less than the number of characters to be read.
3736 This does code conversion according to the value of
3737 `coding-system-for-read' or `file-coding-system-alist',
3738 and sets the variable `last-coding-system-used' to the coding system
3740 (filename
, visit
, beg
, end
, replace
)
3741 Lisp_Object filename
, visit
, beg
, end
, replace
;
3746 register int how_much
;
3747 register int unprocessed
;
3748 int count
= SPECPDL_INDEX ();
3749 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3750 Lisp_Object handler
, val
, insval
, orig_filename
;
3753 int not_regular
= 0;
3754 unsigned char read_buf
[READ_BUF_SIZE
];
3755 struct coding_system coding
;
3756 unsigned char buffer
[1 << 14];
3757 int replace_handled
= 0;
3758 int set_coding_system
= 0;
3759 int coding_system_decided
= 0;
3761 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3762 int we_locked_file
= 0;
3764 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3765 error ("Cannot do file visiting in an indirect buffer");
3767 if (!NILP (current_buffer
->read_only
))
3768 Fbarf_if_buffer_read_only ();
3772 orig_filename
= Qnil
;
3774 GCPRO4 (filename
, val
, p
, orig_filename
);
3776 CHECK_STRING (filename
);
3777 filename
= Fexpand_file_name (filename
, Qnil
);
3779 /* If the file name has special constructs in it,
3780 call the corresponding file handler. */
3781 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3782 if (!NILP (handler
))
3784 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3785 visit
, beg
, end
, replace
);
3786 if (CONSP (val
) && CONSP (XCDR (val
)))
3787 inserted
= XINT (XCAR (XCDR (val
)));
3791 orig_filename
= filename
;
3792 filename
= ENCODE_FILE (filename
);
3798 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3800 /* Tell stat to use expensive method to get accurate info. */
3801 Vw32_get_true_file_attributes
= Qt
;
3802 total
= stat (SDATA (filename
), &st
);
3803 Vw32_get_true_file_attributes
= tem
;
3808 if (stat (SDATA (filename
), &st
) < 0)
3810 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3811 || fstat (fd
, &st
) < 0)
3812 #endif /* not APOLLO */
3813 #endif /* WINDOWSNT */
3815 if (fd
>= 0) emacs_close (fd
);
3818 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3821 if (!NILP (Vcoding_system_for_read
))
3822 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3827 /* This code will need to be changed in order to work on named
3828 pipes, and it's probably just not worth it. So we should at
3829 least signal an error. */
3830 if (!S_ISREG (st
.st_mode
))
3837 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3838 Fsignal (Qfile_error
,
3839 Fcons (build_string ("not a regular file"),
3840 Fcons (orig_filename
, Qnil
)));
3845 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3848 /* Replacement should preserve point as it preserves markers. */
3849 if (!NILP (replace
))
3850 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3852 record_unwind_protect (close_file_unwind
, make_number (fd
));
3854 /* Supposedly happens on VMS. */
3855 /* Can happen on any platform that uses long as type of off_t, but allows
3856 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3857 give a message suitable for the latter case. */
3858 if (! not_regular
&& st
.st_size
< 0)
3859 error ("Maximum buffer size exceeded");
3861 /* Prevent redisplay optimizations. */
3862 current_buffer
->clip_changed
= 1;
3866 if (!NILP (beg
) || !NILP (end
))
3867 error ("Attempt to visit less than an entire file");
3868 if (BEG
< Z
&& NILP (replace
))
3869 error ("Cannot do file visiting in a non-empty buffer");
3875 XSETFASTINT (beg
, 0);
3883 XSETINT (end
, st
.st_size
);
3885 /* Arithmetic overflow can occur if an Emacs integer cannot
3886 represent the file size, or if the calculations below
3887 overflow. The calculations below double the file size
3888 twice, so check that it can be multiplied by 4 safely. */
3889 if (XINT (end
) != st
.st_size
3890 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3891 error ("Maximum buffer size exceeded");
3893 /* The file size returned from stat may be zero, but data
3894 may be readable nonetheless, for example when this is a
3895 file in the /proc filesystem. */
3896 if (st
.st_size
== 0)
3897 XSETINT (end
, READ_BUF_SIZE
);
3901 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3903 /* We use emacs-mule for auto saving... */
3904 setup_coding_system (Qemacs_mule
, &coding
);
3905 /* ... but with the special flag to indicate to read in a
3906 multibyte sequence for eight-bit-control char as is. */
3908 coding
.src_multibyte
= 0;
3909 coding
.dst_multibyte
3910 = !NILP (current_buffer
->enable_multibyte_characters
);
3911 coding
.eol_type
= CODING_EOL_LF
;
3912 coding_system_decided
= 1;
3916 /* Decide the coding system to use for reading the file now
3917 because we can't use an optimized method for handling
3918 `coding:' tag if the current buffer is not empty. */
3922 if (!NILP (Vcoding_system_for_read
))
3923 val
= Vcoding_system_for_read
;
3926 /* Don't try looking inside a file for a coding system
3927 specification if it is not seekable. */
3928 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3930 /* Find a coding system specified in the heading two
3931 lines or in the tailing several lines of the file.
3932 We assume that the 1K-byte and 3K-byte for heading
3933 and tailing respectively are sufficient for this
3937 if (st
.st_size
<= (1024 * 4))
3938 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3941 nread
= emacs_read (fd
, read_buf
, 1024);
3944 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3945 report_file_error ("Setting file position",
3946 Fcons (orig_filename
, Qnil
));
3947 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3952 error ("IO error reading %s: %s",
3953 SDATA (orig_filename
), emacs_strerror (errno
));
3956 struct buffer
*prev
= current_buffer
;
3960 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3962 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3963 buf
= XBUFFER (buffer
);
3965 delete_all_overlays (buf
);
3966 buf
->directory
= current_buffer
->directory
;
3967 buf
->read_only
= Qnil
;
3968 buf
->filename
= Qnil
;
3969 buf
->undo_list
= Qt
;
3970 eassert (buf
->overlays_before
== NULL
);
3971 eassert (buf
->overlays_after
== NULL
);
3973 set_buffer_internal (buf
);
3975 buf
->enable_multibyte_characters
= Qnil
;
3977 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3978 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3979 val
= call2 (Vset_auto_coding_function
,
3980 filename
, make_number (nread
));
3981 set_buffer_internal (prev
);
3983 /* Discard the unwind protect for recovering the
3987 /* Rewind the file for the actual read done later. */
3988 if (lseek (fd
, 0, 0) < 0)
3989 report_file_error ("Setting file position",
3990 Fcons (orig_filename
, Qnil
));
3996 /* If we have not yet decided a coding system, check
3997 file-coding-system-alist. */
3998 Lisp_Object args
[6], coding_systems
;
4000 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4001 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
4002 coding_systems
= Ffind_operation_coding_system (6, args
);
4003 if (CONSP (coding_systems
))
4004 val
= XCAR (coding_systems
);
4008 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4009 /* Ensure we set Vlast_coding_system_used. */
4010 set_coding_system
= 1;
4012 if (NILP (current_buffer
->enable_multibyte_characters
)
4014 /* We must suppress all character code conversion except for
4015 end-of-line conversion. */
4016 setup_raw_text_coding_system (&coding
);
4018 coding
.src_multibyte
= 0;
4019 coding
.dst_multibyte
4020 = !NILP (current_buffer
->enable_multibyte_characters
);
4021 coding_system_decided
= 1;
4024 /* If requested, replace the accessible part of the buffer
4025 with the file contents. Avoid replacing text at the
4026 beginning or end of the buffer that matches the file contents;
4027 that preserves markers pointing to the unchanged parts.
4029 Here we implement this feature in an optimized way
4030 for the case where code conversion is NOT needed.
4031 The following if-statement handles the case of conversion
4032 in a less optimal way.
4034 If the code conversion is "automatic" then we try using this
4035 method and hope for the best.
4036 But if we discover the need for conversion, we give up on this method
4037 and let the following if-statement handle the replace job. */
4040 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
4042 /* same_at_start and same_at_end count bytes,
4043 because file access counts bytes
4044 and BEG and END count bytes. */
4045 int same_at_start
= BEGV_BYTE
;
4046 int same_at_end
= ZV_BYTE
;
4048 /* There is still a possibility we will find the need to do code
4049 conversion. If that happens, we set this variable to 1 to
4050 give up on handling REPLACE in the optimized way. */
4051 int giveup_match_end
= 0;
4053 if (XINT (beg
) != 0)
4055 if (lseek (fd
, XINT (beg
), 0) < 0)
4056 report_file_error ("Setting file position",
4057 Fcons (orig_filename
, Qnil
));
4062 /* Count how many chars at the start of the file
4063 match the text at the beginning of the buffer. */
4068 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4070 error ("IO error reading %s: %s",
4071 SDATA (orig_filename
), emacs_strerror (errno
));
4072 else if (nread
== 0)
4075 if (coding
.type
== coding_type_undecided
)
4076 detect_coding (&coding
, buffer
, nread
);
4077 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
4078 /* We found that the file should be decoded somehow.
4079 Let's give up here. */
4081 giveup_match_end
= 1;
4085 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
4086 detect_eol (&coding
, buffer
, nread
);
4087 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
4088 && coding
.eol_type
!= CODING_EOL_LF
)
4089 /* We found that the format of eol should be decoded.
4090 Let's give up here. */
4092 giveup_match_end
= 1;
4097 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4098 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4099 same_at_start
++, bufpos
++;
4100 /* If we found a discrepancy, stop the scan.
4101 Otherwise loop around and scan the next bufferful. */
4102 if (bufpos
!= nread
)
4106 /* If the file matches the buffer completely,
4107 there's no need to replace anything. */
4108 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4112 /* Truncate the buffer to the size of the file. */
4113 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4118 /* Count how many chars at the end of the file
4119 match the text at the end of the buffer. But, if we have
4120 already found that decoding is necessary, don't waste time. */
4121 while (!giveup_match_end
)
4123 int total_read
, nread
, bufpos
, curpos
, trial
;
4125 /* At what file position are we now scanning? */
4126 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4127 /* If the entire file matches the buffer tail, stop the scan. */
4130 /* How much can we scan in the next step? */
4131 trial
= min (curpos
, sizeof buffer
);
4132 if (lseek (fd
, curpos
- trial
, 0) < 0)
4133 report_file_error ("Setting file position",
4134 Fcons (orig_filename
, Qnil
));
4136 total_read
= nread
= 0;
4137 while (total_read
< trial
)
4139 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4141 error ("IO error reading %s: %s",
4142 SDATA (orig_filename
), emacs_strerror (errno
));
4143 else if (nread
== 0)
4145 total_read
+= nread
;
4148 /* Scan this bufferful from the end, comparing with
4149 the Emacs buffer. */
4150 bufpos
= total_read
;
4152 /* Compare with same_at_start to avoid counting some buffer text
4153 as matching both at the file's beginning and at the end. */
4154 while (bufpos
> 0 && same_at_end
> same_at_start
4155 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4156 same_at_end
--, bufpos
--;
4158 /* If we found a discrepancy, stop the scan.
4159 Otherwise loop around and scan the preceding bufferful. */
4162 /* If this discrepancy is because of code conversion,
4163 we cannot use this method; giveup and try the other. */
4164 if (same_at_end
> same_at_start
4165 && FETCH_BYTE (same_at_end
- 1) >= 0200
4166 && ! NILP (current_buffer
->enable_multibyte_characters
)
4167 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4168 giveup_match_end
= 1;
4177 if (! giveup_match_end
)
4181 /* We win! We can handle REPLACE the optimized way. */
4183 /* Extend the start of non-matching text area to multibyte
4184 character boundary. */
4185 if (! NILP (current_buffer
->enable_multibyte_characters
))
4186 while (same_at_start
> BEGV_BYTE
4187 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4190 /* Extend the end of non-matching text area to multibyte
4191 character boundary. */
4192 if (! NILP (current_buffer
->enable_multibyte_characters
))
4193 while (same_at_end
< ZV_BYTE
4194 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4197 /* Don't try to reuse the same piece of text twice. */
4198 overlap
= (same_at_start
- BEGV_BYTE
4199 - (same_at_end
+ st
.st_size
- ZV
));
4201 same_at_end
+= overlap
;
4203 /* Arrange to read only the nonmatching middle part of the file. */
4204 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4205 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4207 del_range_byte (same_at_start
, same_at_end
, 0);
4208 /* Insert from the file at the proper position. */
4209 temp
= BYTE_TO_CHAR (same_at_start
);
4210 SET_PT_BOTH (temp
, same_at_start
);
4212 /* If display currently starts at beginning of line,
4213 keep it that way. */
4214 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4215 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4217 replace_handled
= 1;
4221 /* If requested, replace the accessible part of the buffer
4222 with the file contents. Avoid replacing text at the
4223 beginning or end of the buffer that matches the file contents;
4224 that preserves markers pointing to the unchanged parts.
4226 Here we implement this feature for the case where code conversion
4227 is needed, in a simple way that needs a lot of memory.
4228 The preceding if-statement handles the case of no conversion
4229 in a more optimized way. */
4230 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4232 int same_at_start
= BEGV_BYTE
;
4233 int same_at_end
= ZV_BYTE
;
4236 /* Make sure that the gap is large enough. */
4237 int bufsize
= 2 * st
.st_size
;
4238 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4241 /* First read the whole file, performing code conversion into
4242 CONVERSION_BUFFER. */
4244 if (lseek (fd
, XINT (beg
), 0) < 0)
4246 xfree (conversion_buffer
);
4247 report_file_error ("Setting file position",
4248 Fcons (orig_filename
, Qnil
));
4251 total
= st
.st_size
; /* Total bytes in the file. */
4252 how_much
= 0; /* Bytes read from file so far. */
4253 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4254 unprocessed
= 0; /* Bytes not processed in previous loop. */
4256 while (how_much
< total
)
4258 /* try is reserved in some compilers (Microsoft C) */
4259 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4260 unsigned char *destination
= read_buf
+ unprocessed
;
4263 /* Allow quitting out of the actual I/O. */
4266 this = emacs_read (fd
, destination
, trytry
);
4269 if (this < 0 || this + unprocessed
== 0)
4277 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4279 int require
, result
;
4281 this += unprocessed
;
4283 /* If we are using more space than estimated,
4284 make CONVERSION_BUFFER bigger. */
4285 require
= decoding_buffer_size (&coding
, this);
4286 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4288 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4289 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4292 /* Convert this batch with results in CONVERSION_BUFFER. */
4293 if (how_much
>= total
) /* This is the last block. */
4294 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4295 if (coding
.composing
!= COMPOSITION_DISABLED
)
4296 coding_allocate_composition_data (&coding
, BEGV
);
4297 result
= decode_coding (&coding
, read_buf
,
4298 conversion_buffer
+ inserted
,
4299 this, bufsize
- inserted
);
4301 /* Save for next iteration whatever we didn't convert. */
4302 unprocessed
= this - coding
.consumed
;
4303 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4304 if (!NILP (current_buffer
->enable_multibyte_characters
))
4305 this = coding
.produced
;
4307 this = str_as_unibyte (conversion_buffer
+ inserted
,
4314 /* At this point, INSERTED is how many characters (i.e. bytes)
4315 are present in CONVERSION_BUFFER.
4316 HOW_MUCH should equal TOTAL,
4317 or should be <= 0 if we couldn't read the file. */
4321 xfree (conversion_buffer
);
4322 coding_free_composition_data (&coding
);
4324 error ("IO error reading %s: %s",
4325 SDATA (orig_filename
), emacs_strerror (errno
));
4326 else if (how_much
== -2)
4327 error ("maximum buffer size exceeded");
4330 /* Compare the beginning of the converted file
4331 with the buffer text. */
4334 while (bufpos
< inserted
&& same_at_start
< same_at_end
4335 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4336 same_at_start
++, bufpos
++;
4338 /* If the file matches the buffer completely,
4339 there's no need to replace anything. */
4341 if (bufpos
== inserted
)
4343 xfree (conversion_buffer
);
4344 coding_free_composition_data (&coding
);
4347 /* Truncate the buffer to the size of the file. */
4348 del_range_byte (same_at_start
, same_at_end
, 0);
4353 /* Extend the start of non-matching text area to multibyte
4354 character boundary. */
4355 if (! NILP (current_buffer
->enable_multibyte_characters
))
4356 while (same_at_start
> BEGV_BYTE
4357 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4360 /* Scan this bufferful from the end, comparing with
4361 the Emacs buffer. */
4364 /* Compare with same_at_start to avoid counting some buffer text
4365 as matching both at the file's beginning and at the end. */
4366 while (bufpos
> 0 && same_at_end
> same_at_start
4367 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4368 same_at_end
--, bufpos
--;
4370 /* Extend the end of non-matching text area to multibyte
4371 character boundary. */
4372 if (! NILP (current_buffer
->enable_multibyte_characters
))
4373 while (same_at_end
< ZV_BYTE
4374 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4377 /* Don't try to reuse the same piece of text twice. */
4378 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4380 same_at_end
+= overlap
;
4382 /* If display currently starts at beginning of line,
4383 keep it that way. */
4384 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4385 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4387 /* Replace the chars that we need to replace,
4388 and update INSERTED to equal the number of bytes
4389 we are taking from the file. */
4390 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4392 if (same_at_end
!= same_at_start
)
4394 del_range_byte (same_at_start
, same_at_end
, 0);
4396 same_at_start
= GPT_BYTE
;
4400 temp
= BYTE_TO_CHAR (same_at_start
);
4402 /* Insert from the file at the proper position. */
4403 SET_PT_BOTH (temp
, same_at_start
);
4404 insert_1 (conversion_buffer
+ same_at_start
- BEGV_BYTE
, inserted
,
4406 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4407 coding_restore_composition (&coding
, Fcurrent_buffer ());
4408 coding_free_composition_data (&coding
);
4410 /* Set `inserted' to the number of inserted characters. */
4411 inserted
= PT
- temp
;
4413 xfree (conversion_buffer
);
4422 register Lisp_Object temp
;
4424 total
= XINT (end
) - XINT (beg
);
4426 /* Make sure point-max won't overflow after this insertion. */
4427 XSETINT (temp
, total
);
4428 if (total
!= XINT (temp
))
4429 error ("Maximum buffer size exceeded");
4432 /* For a special file, all we can do is guess. */
4433 total
= READ_BUF_SIZE
;
4435 if (NILP (visit
) && inserted
> 0)
4437 #ifdef CLASH_DETECTION
4438 if (!NILP (current_buffer
->file_truename
)
4439 /* Make binding buffer-file-name to nil effective. */
4440 && !NILP (current_buffer
->filename
)
4441 && SAVE_MODIFF
>= MODIFF
)
4443 #endif /* CLASH_DETECTION */
4444 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
4448 if (GAP_SIZE
< total
)
4449 make_gap (total
- GAP_SIZE
);
4451 if (XINT (beg
) != 0 || !NILP (replace
))
4453 if (lseek (fd
, XINT (beg
), 0) < 0)
4454 report_file_error ("Setting file position",
4455 Fcons (orig_filename
, Qnil
));
4458 /* In the following loop, HOW_MUCH contains the total bytes read so
4459 far for a regular file, and not changed for a special file. But,
4460 before exiting the loop, it is set to a negative value if I/O
4464 /* Total bytes inserted. */
4467 /* Here, we don't do code conversion in the loop. It is done by
4468 code_convert_region after all data are read into the buffer. */
4470 int gap_size
= GAP_SIZE
;
4472 while (how_much
< total
)
4474 /* try is reserved in some compilers (Microsoft C) */
4475 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4482 /* Maybe make more room. */
4483 if (gap_size
< trytry
)
4485 make_gap (total
- gap_size
);
4486 gap_size
= GAP_SIZE
;
4489 /* Read from the file, capturing `quit'. When an
4490 error occurs, end the loop, and arrange for a quit
4491 to be signaled after decoding the text we read. */
4492 non_regular_fd
= fd
;
4493 non_regular_inserted
= inserted
;
4494 non_regular_nbytes
= trytry
;
4495 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4496 read_non_regular_quit
);
4507 /* Allow quitting out of the actual I/O. We don't make text
4508 part of the buffer until all the reading is done, so a C-g
4509 here doesn't do any harm. */
4512 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4524 /* For a regular file, where TOTAL is the real size,
4525 count HOW_MUCH to compare with it.
4526 For a special file, where TOTAL is just a buffer size,
4527 so don't bother counting in HOW_MUCH.
4528 (INSERTED is where we count the number of characters inserted.) */
4535 /* Now we have read all the file data into the gap.
4536 If it was empty, undo marking the buffer modified. */
4540 #ifdef CLASH_DETECTION
4542 unlock_file (current_buffer
->file_truename
);
4544 Vdeactivate_mark
= old_Vdeactivate_mark
;
4547 /* Make the text read part of the buffer. */
4548 GAP_SIZE
-= inserted
;
4550 GPT_BYTE
+= inserted
;
4552 ZV_BYTE
+= inserted
;
4557 /* Put an anchor to ensure multi-byte form ends at gap. */
4562 /* Discard the unwind protect for closing the file. */
4566 error ("IO error reading %s: %s",
4567 SDATA (orig_filename
), emacs_strerror (errno
));
4571 if (! coding_system_decided
)
4573 /* The coding system is not yet decided. Decide it by an
4574 optimized method for handling `coding:' tag.
4576 Note that we can get here only if the buffer was empty
4577 before the insertion. */
4581 if (!NILP (Vcoding_system_for_read
))
4582 val
= Vcoding_system_for_read
;
4585 /* Since we are sure that the current buffer was empty
4586 before the insertion, we can toggle
4587 enable-multibyte-characters directly here without taking
4588 care of marker adjustment and byte combining problem. By
4589 this way, we can run Lisp program safely before decoding
4590 the inserted text. */
4591 Lisp_Object unwind_data
;
4592 int count
= SPECPDL_INDEX ();
4594 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4595 Fcons (current_buffer
->undo_list
,
4596 Fcurrent_buffer ()));
4597 current_buffer
->enable_multibyte_characters
= Qnil
;
4598 current_buffer
->undo_list
= Qt
;
4599 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4601 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4603 val
= call2 (Vset_auto_coding_function
,
4604 filename
, make_number (inserted
));
4609 /* If the coding system is not yet decided, check
4610 file-coding-system-alist. */
4611 Lisp_Object args
[6], coding_systems
;
4613 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4614 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4615 coding_systems
= Ffind_operation_coding_system (6, args
);
4616 if (CONSP (coding_systems
))
4617 val
= XCAR (coding_systems
);
4619 unbind_to (count
, Qnil
);
4620 inserted
= Z_BYTE
- BEG_BYTE
;
4623 /* The following kludgy code is to avoid some compiler bug.
4625 setup_coding_system (val, &coding);
4628 struct coding_system temp_coding
;
4629 setup_coding_system (Fcheck_coding_system (val
), &temp_coding
);
4630 bcopy (&temp_coding
, &coding
, sizeof coding
);
4632 /* Ensure we set Vlast_coding_system_used. */
4633 set_coding_system
= 1;
4635 if (NILP (current_buffer
->enable_multibyte_characters
)
4637 /* We must suppress all character code conversion except for
4638 end-of-line conversion. */
4639 setup_raw_text_coding_system (&coding
);
4640 coding
.src_multibyte
= 0;
4641 coding
.dst_multibyte
4642 = !NILP (current_buffer
->enable_multibyte_characters
);
4646 /* Can't do this if part of the buffer might be preserved. */
4648 && (coding
.type
== coding_type_no_conversion
4649 || coding
.type
== coding_type_raw_text
))
4651 /* Visiting a file with these coding system makes the buffer
4653 current_buffer
->enable_multibyte_characters
= Qnil
;
4654 coding
.dst_multibyte
= 0;
4657 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4659 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4661 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4663 inserted
= coding
.produced_char
;
4666 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4670 /* Now INSERTED is measured in characters. */
4673 /* Use the conversion type to determine buffer-file-type
4674 (find-buffer-file-type is now used to help determine the
4676 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4677 || coding
.eol_type
== CODING_EOL_LF
)
4678 && ! CODING_REQUIRE_DECODING (&coding
))
4679 current_buffer
->buffer_file_type
= Qt
;
4681 current_buffer
->buffer_file_type
= Qnil
;
4688 if (!EQ (current_buffer
->undo_list
, Qt
))
4689 current_buffer
->undo_list
= Qnil
;
4691 stat (SDATA (filename
), &st
);
4696 current_buffer
->modtime
= st
.st_mtime
;
4697 current_buffer
->filename
= orig_filename
;
4700 SAVE_MODIFF
= MODIFF
;
4701 current_buffer
->auto_save_modified
= MODIFF
;
4702 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4703 #ifdef CLASH_DETECTION
4706 if (!NILP (current_buffer
->file_truename
))
4707 unlock_file (current_buffer
->file_truename
);
4708 unlock_file (filename
);
4710 #endif /* CLASH_DETECTION */
4712 Fsignal (Qfile_error
,
4713 Fcons (build_string ("not a regular file"),
4714 Fcons (orig_filename
, Qnil
)));
4717 if (set_coding_system
)
4718 Vlast_coding_system_used
= coding
.symbol
;
4720 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4722 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4724 if (! NILP (insval
))
4726 CHECK_NUMBER (insval
);
4727 inserted
= XFASTINT (insval
);
4731 /* Decode file format */
4734 int empty_undo_list_p
= 0;
4736 /* If we're anyway going to discard undo information, don't
4737 record it in the first place. The buffer's undo list at this
4738 point is either nil or t when visiting a file. */
4741 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4742 current_buffer
->undo_list
= Qt
;
4745 insval
= call3 (Qformat_decode
,
4746 Qnil
, make_number (inserted
), visit
);
4747 CHECK_NUMBER (insval
);
4748 inserted
= XFASTINT (insval
);
4751 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4754 /* Call after-change hooks for the inserted text, aside from the case
4755 of normal visiting (not with REPLACE), which is done in a new buffer
4756 "before" the buffer is changed. */
4757 if (inserted
> 0 && total
> 0
4758 && (NILP (visit
) || !NILP (replace
)))
4760 signal_after_change (PT
, 0, inserted
);
4761 update_compositions (PT
, PT
, CHECK_BORDER
);
4764 p
= Vafter_insert_file_functions
;
4767 insval
= call1 (XCAR (p
), make_number (inserted
));
4770 CHECK_NUMBER (insval
);
4771 inserted
= XFASTINT (insval
);
4778 && current_buffer
->modtime
== -1)
4780 /* If visiting nonexistent file, return nil. */
4781 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4785 Fsignal (Qquit
, Qnil
);
4787 /* ??? Retval needs to be dealt with in all cases consistently. */
4789 val
= Fcons (orig_filename
,
4790 Fcons (make_number (inserted
),
4793 RETURN_UNGCPRO (unbind_to (count
, val
));
4796 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4797 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4798 Lisp_Object
, Lisp_Object
));
4800 /* If build_annotations switched buffers, switch back to BUF.
4801 Kill the temporary buffer that was selected in the meantime.
4803 Since this kill only the last temporary buffer, some buffers remain
4804 not killed if build_annotations switched buffers more than once.
4808 build_annotations_unwind (buf
)
4813 if (XBUFFER (buf
) == current_buffer
)
4815 tembuf
= Fcurrent_buffer ();
4817 Fkill_buffer (tembuf
);
4821 /* Decide the coding-system to encode the data with. */
4824 choose_write_coding_system (start
, end
, filename
,
4825 append
, visit
, lockname
, coding
)
4826 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4827 struct coding_system
*coding
;
4832 && NILP (Fstring_equal (current_buffer
->filename
,
4833 current_buffer
->auto_save_file_name
)))
4835 /* We use emacs-mule for auto saving... */
4836 setup_coding_system (Qemacs_mule
, coding
);
4837 /* ... but with the special flag to indicate not to strip off
4838 leading code of eight-bit-control chars. */
4840 goto done_setup_coding
;
4842 else if (!NILP (Vcoding_system_for_write
))
4844 val
= Vcoding_system_for_write
;
4845 if (coding_system_require_warning
4846 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4847 /* Confirm that VAL can surely encode the current region. */
4848 val
= call5 (Vselect_safe_coding_system_function
,
4849 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4854 /* If the variable `buffer-file-coding-system' is set locally,
4855 it means that the file was read with some kind of code
4856 conversion or the variable is explicitly set by users. We
4857 had better write it out with the same coding system even if
4858 `enable-multibyte-characters' is nil.
4860 If it is not set locally, we anyway have to convert EOL
4861 format if the default value of `buffer-file-coding-system'
4862 tells that it is not Unix-like (LF only) format. */
4863 int using_default_coding
= 0;
4864 int force_raw_text
= 0;
4866 val
= current_buffer
->buffer_file_coding_system
;
4868 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4871 if (NILP (current_buffer
->enable_multibyte_characters
))
4877 /* Check file-coding-system-alist. */
4878 Lisp_Object args
[7], coding_systems
;
4880 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4881 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4883 coding_systems
= Ffind_operation_coding_system (7, args
);
4884 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4885 val
= XCDR (coding_systems
);
4889 && !NILP (current_buffer
->buffer_file_coding_system
))
4891 /* If we still have not decided a coding system, use the
4892 default value of buffer-file-coding-system. */
4893 val
= current_buffer
->buffer_file_coding_system
;
4894 using_default_coding
= 1;
4898 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4899 /* Confirm that VAL can surely encode the current region. */
4900 val
= call5 (Vselect_safe_coding_system_function
,
4901 start
, end
, val
, Qnil
, filename
);
4903 setup_coding_system (Fcheck_coding_system (val
), coding
);
4904 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4905 && !using_default_coding
)
4907 if (! EQ (default_buffer_file_coding
.symbol
,
4908 buffer_defaults
.buffer_file_coding_system
))
4909 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4910 &default_buffer_file_coding
);
4911 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4913 Lisp_Object subsidiaries
;
4915 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4916 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4917 if (VECTORP (subsidiaries
)
4918 && XVECTOR (subsidiaries
)->size
== 3)
4920 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4925 setup_raw_text_coding_system (coding
);
4926 goto done_setup_coding
;
4929 setup_coding_system (Fcheck_coding_system (val
), coding
);
4932 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4933 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4936 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4937 "r\nFWrite region to file: \ni\ni\ni\np",
4938 doc
: /* Write current region into specified file.
4939 When called from a program, requires three arguments:
4940 START, END and FILENAME. START and END are normally buffer positions
4941 specifying the part of the buffer to write.
4942 If START is nil, that means to use the entire buffer contents.
4943 If START is a string, then output that string to the file
4944 instead of any buffer contents; END is ignored.
4946 Optional fourth argument APPEND if non-nil means
4947 append to existing file contents (if any). If it is an integer,
4948 seek to that offset in the file before writing.
4949 Optional fifth argument VISIT, if t or a string, means
4950 set the last-save-file-modtime of buffer to this file's modtime
4951 and mark buffer not modified.
4952 If VISIT is a string, it is a second file name;
4953 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4954 VISIT is also the file name to lock and unlock for clash detection.
4955 If VISIT is neither t nor nil nor a string,
4956 that means do not display the \"Wrote file\" message.
4957 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4958 use for locking and unlocking, overriding FILENAME and VISIT.
4959 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4960 for an existing file with the same name. If MUSTBENEW is `excl',
4961 that means to get an error if the file already exists; never overwrite.
4962 If MUSTBENEW is neither nil nor `excl', that means ask for
4963 confirmation before overwriting, but do go ahead and overwrite the file
4964 if the user confirms.
4966 This does code conversion according to the value of
4967 `coding-system-for-write', `buffer-file-coding-system', or
4968 `file-coding-system-alist', and sets the variable
4969 `last-coding-system-used' to the coding system actually used. */)
4970 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4971 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4976 const unsigned char *fn
;
4979 int count
= SPECPDL_INDEX ();
4982 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4984 Lisp_Object handler
;
4985 Lisp_Object visit_file
;
4986 Lisp_Object annotations
;
4987 Lisp_Object encoded_filename
;
4988 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4989 int quietly
= !NILP (visit
);
4990 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4991 struct buffer
*given_buffer
;
4993 int buffer_file_type
= O_BINARY
;
4995 struct coding_system coding
;
4997 if (current_buffer
->base_buffer
&& visiting
)
4998 error ("Cannot do file visiting in an indirect buffer");
5000 if (!NILP (start
) && !STRINGP (start
))
5001 validate_region (&start
, &end
);
5003 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
5005 filename
= Fexpand_file_name (filename
, Qnil
);
5007 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
5008 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
5010 if (STRINGP (visit
))
5011 visit_file
= Fexpand_file_name (visit
, Qnil
);
5013 visit_file
= filename
;
5015 if (NILP (lockname
))
5016 lockname
= visit_file
;
5020 /* If the file name has special constructs in it,
5021 call the corresponding file handler. */
5022 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
5023 /* If FILENAME has no handler, see if VISIT has one. */
5024 if (NILP (handler
) && STRINGP (visit
))
5025 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
5027 if (!NILP (handler
))
5030 val
= call6 (handler
, Qwrite_region
, start
, end
,
5031 filename
, append
, visit
);
5035 SAVE_MODIFF
= MODIFF
;
5036 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5037 current_buffer
->filename
= visit_file
;
5043 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
5045 /* Special kludge to simplify auto-saving. */
5048 XSETFASTINT (start
, BEG
);
5049 XSETFASTINT (end
, Z
);
5053 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
5054 count1
= SPECPDL_INDEX ();
5056 given_buffer
= current_buffer
;
5058 if (!STRINGP (start
))
5060 annotations
= build_annotations (start
, end
);
5062 if (current_buffer
!= given_buffer
)
5064 XSETFASTINT (start
, BEGV
);
5065 XSETFASTINT (end
, ZV
);
5071 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
5073 /* Decide the coding-system to encode the data with.
5074 We used to make this choice before calling build_annotations, but that
5075 leads to problems when a write-annotate-function takes care of
5076 unsavable chars (as was the case with X-Symbol). */
5077 choose_write_coding_system (start
, end
, filename
,
5078 append
, visit
, lockname
, &coding
);
5079 Vlast_coding_system_used
= coding
.symbol
;
5081 given_buffer
= current_buffer
;
5082 if (! STRINGP (start
))
5084 annotations
= build_annotations_2 (start
, end
,
5085 coding
.pre_write_conversion
, annotations
);
5086 if (current_buffer
!= given_buffer
)
5088 XSETFASTINT (start
, BEGV
);
5089 XSETFASTINT (end
, ZV
);
5093 #ifdef CLASH_DETECTION
5096 #if 0 /* This causes trouble for GNUS. */
5097 /* If we've locked this file for some other buffer,
5098 query before proceeding. */
5099 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5100 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5103 lock_file (lockname
);
5105 #endif /* CLASH_DETECTION */
5107 encoded_filename
= ENCODE_FILE (filename
);
5109 fn
= SDATA (encoded_filename
);
5113 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5114 #else /* not DOS_NT */
5115 desc
= emacs_open (fn
, O_WRONLY
, 0);
5116 #endif /* not DOS_NT */
5118 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5120 if (auto_saving
) /* Overwrite any previous version of autosave file */
5122 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5123 desc
= emacs_open (fn
, O_RDWR
, 0);
5125 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5126 ? SDATA (current_buffer
->filename
) : 0,
5129 else /* Write to temporary name and rename if no errors */
5131 Lisp_Object temp_name
;
5132 temp_name
= Ffile_name_directory (filename
);
5134 if (!NILP (temp_name
))
5136 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5137 build_string ("$$SAVE$$")));
5138 fname
= SDATA (filename
);
5139 fn
= SDATA (temp_name
);
5140 desc
= creat_copy_attrs (fname
, fn
);
5143 /* If we can't open the temporary file, try creating a new
5144 version of the original file. VMS "creat" creates a
5145 new version rather than truncating an existing file. */
5148 desc
= creat (fn
, 0666);
5149 #if 0 /* This can clobber an existing file and fail to replace it,
5150 if the user runs out of space. */
5153 /* We can't make a new version;
5154 try to truncate and rewrite existing version if any. */
5156 desc
= emacs_open (fn
, O_RDWR
, 0);
5162 desc
= creat (fn
, 0666);
5166 desc
= emacs_open (fn
,
5167 O_WRONLY
| O_CREAT
| buffer_file_type
5168 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5169 S_IREAD
| S_IWRITE
);
5170 #else /* not DOS_NT */
5171 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5172 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5173 auto_saving
? auto_save_mode_bits
: 0666);
5174 #endif /* not DOS_NT */
5175 #endif /* not VMS */
5179 #ifdef CLASH_DETECTION
5181 if (!auto_saving
) unlock_file (lockname
);
5183 #endif /* CLASH_DETECTION */
5185 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5188 record_unwind_protect (close_file_unwind
, make_number (desc
));
5190 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5194 if (NUMBERP (append
))
5195 ret
= lseek (desc
, XINT (append
), 1);
5197 ret
= lseek (desc
, 0, 2);
5200 #ifdef CLASH_DETECTION
5201 if (!auto_saving
) unlock_file (lockname
);
5202 #endif /* CLASH_DETECTION */
5204 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5212 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5213 * if we do writes that don't end with a carriage return. Furthermore
5214 * it cannot handle writes of more then 16K. The modified
5215 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5216 * this EXCEPT for the last record (iff it doesn't end with a carriage
5217 * return). This implies that if your buffer doesn't end with a carriage
5218 * return, you get one free... tough. However it also means that if
5219 * we make two calls to sys_write (a la the following code) you can
5220 * get one at the gap as well. The easiest way to fix this (honest)
5221 * is to move the gap to the next newline (or the end of the buffer).
5226 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5227 move_gap (find_next_newline (GPT
, 1));
5229 /* Whether VMS or not, we must move the gap to the next of newline
5230 when we must put designation sequences at beginning of line. */
5231 if (INTEGERP (start
)
5232 && coding
.type
== coding_type_iso2022
5233 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5234 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5236 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5237 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5238 move_gap_both (PT
, PT_BYTE
);
5239 SET_PT_BOTH (opoint
, opoint_byte
);
5246 if (STRINGP (start
))
5248 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5249 &annotations
, &coding
);
5252 else if (XINT (start
) != XINT (end
))
5254 tem
= CHAR_TO_BYTE (XINT (start
));
5256 if (XINT (start
) < GPT
)
5258 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5259 min (GPT
, XINT (end
)) - XINT (start
),
5260 &annotations
, &coding
);
5264 if (XINT (end
) > GPT
&& !failure
)
5266 tem
= max (XINT (start
), GPT
);
5267 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5268 &annotations
, &coding
);
5274 /* If file was empty, still need to write the annotations */
5275 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5276 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5280 if (CODING_REQUIRE_FLUSHING (&coding
)
5281 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5284 /* We have to flush out a data. */
5285 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5286 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5293 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5294 Disk full in NFS may be reported here. */
5295 /* mib says that closing the file will try to write as fast as NFS can do
5296 it, and that means the fsync here is not crucial for autosave files. */
5297 if (!auto_saving
&& fsync (desc
) < 0)
5299 /* If fsync fails with EINTR, don't treat that as serious. */
5301 failure
= 1, save_errno
= errno
;
5305 /* Spurious "file has changed on disk" warnings have been
5306 observed on Suns as well.
5307 It seems that `close' can change the modtime, under nfs.
5309 (This has supposedly been fixed in Sunos 4,
5310 but who knows about all the other machines with NFS?) */
5313 /* On VMS and APOLLO, must do the stat after the close
5314 since closing changes the modtime. */
5317 /* Recall that #if defined does not work on VMS. */
5324 /* NFS can report a write failure now. */
5325 if (emacs_close (desc
) < 0)
5326 failure
= 1, save_errno
= errno
;
5329 /* If we wrote to a temporary name and had no errors, rename to real name. */
5333 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5341 /* Discard the unwind protect for close_file_unwind. */
5342 specpdl_ptr
= specpdl
+ count1
;
5343 /* Restore the original current buffer. */
5344 visit_file
= unbind_to (count
, visit_file
);
5346 #ifdef CLASH_DETECTION
5348 unlock_file (lockname
);
5349 #endif /* CLASH_DETECTION */
5351 /* Do this before reporting IO error
5352 to avoid a "file has changed on disk" warning on
5353 next attempt to save. */
5355 current_buffer
->modtime
= st
.st_mtime
;
5358 error ("IO error writing %s: %s", SDATA (filename
),
5359 emacs_strerror (save_errno
));
5363 SAVE_MODIFF
= MODIFF
;
5364 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5365 current_buffer
->filename
= visit_file
;
5366 update_mode_lines
++;
5371 && ! NILP (Fstring_equal (current_buffer
->filename
,
5372 current_buffer
->auto_save_file_name
)))
5373 SAVE_MODIFF
= MODIFF
;
5379 message_with_string ((INTEGERP (append
)
5389 Lisp_Object
merge ();
5391 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5392 doc
: /* Return t if (car A) is numerically less than (car B). */)
5396 return Flss (Fcar (a
), Fcar (b
));
5399 /* Build the complete list of annotations appropriate for writing out
5400 the text between START and END, by calling all the functions in
5401 write-region-annotate-functions and merging the lists they return.
5402 If one of these functions switches to a different buffer, we assume
5403 that buffer contains altered text. Therefore, the caller must
5404 make sure to restore the current buffer in all cases,
5405 as save-excursion would do. */
5408 build_annotations (start
, end
)
5409 Lisp_Object start
, end
;
5411 Lisp_Object annotations
;
5413 struct gcpro gcpro1
, gcpro2
;
5414 Lisp_Object original_buffer
;
5415 int i
, used_global
= 0;
5417 XSETBUFFER (original_buffer
, current_buffer
);
5420 p
= Vwrite_region_annotate_functions
;
5421 GCPRO2 (annotations
, p
);
5424 struct buffer
*given_buffer
= current_buffer
;
5425 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5426 { /* Use the global value of the hook. */
5429 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5431 p
= Fappend (2, arg
);
5434 Vwrite_region_annotations_so_far
= annotations
;
5435 res
= call2 (XCAR (p
), start
, end
);
5436 /* If the function makes a different buffer current,
5437 assume that means this buffer contains altered text to be output.
5438 Reset START and END from the buffer bounds
5439 and discard all previous annotations because they should have
5440 been dealt with by this function. */
5441 if (current_buffer
!= given_buffer
)
5443 XSETFASTINT (start
, BEGV
);
5444 XSETFASTINT (end
, ZV
);
5447 Flength (res
); /* Check basic validity of return value */
5448 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5452 /* Now do the same for annotation functions implied by the file-format */
5453 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
5454 p
= current_buffer
->auto_save_file_format
;
5456 p
= current_buffer
->file_format
;
5457 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5459 struct buffer
*given_buffer
= current_buffer
;
5461 Vwrite_region_annotations_so_far
= annotations
;
5463 /* Value is either a list of annotations or nil if the function
5464 has written annotations to a temporary buffer, which is now
5466 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5467 original_buffer
, make_number (i
));
5468 if (current_buffer
!= given_buffer
)
5470 XSETFASTINT (start
, BEGV
);
5471 XSETFASTINT (end
, ZV
);
5476 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5484 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5485 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5487 struct gcpro gcpro1
;
5490 GCPRO1 (annotations
);
5491 /* At last, do the same for the function PRE_WRITE_CONVERSION
5492 implied by the current coding-system. */
5493 if (!NILP (pre_write_conversion
))
5495 struct buffer
*given_buffer
= current_buffer
;
5496 Vwrite_region_annotations_so_far
= annotations
;
5497 res
= call2 (pre_write_conversion
, start
, end
);
5499 annotations
= (current_buffer
!= given_buffer
5501 : merge (annotations
, res
, Qcar_less_than_car
));
5508 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5509 If STRING is nil, POS is the character position in the current buffer.
5510 Intersperse with them the annotations from *ANNOT
5511 which fall within the range of POS to POS + NCHARS,
5512 each at its appropriate position.
5514 We modify *ANNOT by discarding elements as we use them up.
5516 The return value is negative in case of system call failure. */
5519 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5522 register int nchars
;
5525 struct coding_system
*coding
;
5529 int lastpos
= pos
+ nchars
;
5531 while (NILP (*annot
) || CONSP (*annot
))
5533 tem
= Fcar_safe (Fcar (*annot
));
5536 nextpos
= XFASTINT (tem
);
5538 /* If there are no more annotations in this range,
5539 output the rest of the range all at once. */
5540 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5541 return e_write (desc
, string
, pos
, lastpos
, coding
);
5543 /* Output buffer text up to the next annotation's position. */
5546 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5550 /* Output the annotation. */
5551 tem
= Fcdr (Fcar (*annot
));
5554 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5557 *annot
= Fcdr (*annot
);
5562 #ifndef WRITE_BUF_SIZE
5563 #define WRITE_BUF_SIZE (16 * 1024)
5566 /* Write text in the range START and END into descriptor DESC,
5567 encoding them with coding system CODING. If STRING is nil, START
5568 and END are character positions of the current buffer, else they
5569 are indexes to the string STRING. */
5572 e_write (desc
, string
, start
, end
, coding
)
5576 struct coding_system
*coding
;
5578 register char *addr
;
5579 register int nbytes
;
5580 char buf
[WRITE_BUF_SIZE
];
5584 coding
->composing
= COMPOSITION_DISABLED
;
5585 if (coding
->composing
!= COMPOSITION_DISABLED
)
5586 coding_save_composition (coding
, start
, end
, string
);
5588 if (STRINGP (string
))
5590 addr
= SDATA (string
);
5591 nbytes
= SBYTES (string
);
5592 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5594 else if (start
< end
)
5596 /* It is assured that the gap is not in the range START and END-1. */
5597 addr
= CHAR_POS_ADDR (start
);
5598 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5599 coding
->src_multibyte
5600 = !NILP (current_buffer
->enable_multibyte_characters
);
5606 coding
->src_multibyte
= 1;
5609 /* We used to have a code for handling selective display here. But,
5610 now it is handled within encode_coding. */
5615 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5616 if (coding
->produced
> 0)
5618 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5619 if (coding
->produced
)
5625 nbytes
-= coding
->consumed
;
5626 addr
+= coding
->consumed
;
5627 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5630 /* The source text ends by an incomplete multibyte form.
5631 There's no way other than write it out as is. */
5632 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5641 start
+= coding
->consumed_char
;
5642 if (coding
->cmp_data
)
5643 coding_adjust_composition_offset (coding
, start
);
5646 if (coding
->cmp_data
)
5647 coding_free_composition_data (coding
);
5652 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5653 Sverify_visited_file_modtime
, 1, 1, 0,
5654 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5655 This means that the file has not been changed since it was visited or saved.
5656 See Info node `(elisp)Modification Time' for more details. */)
5662 Lisp_Object handler
;
5663 Lisp_Object filename
;
5668 if (!STRINGP (b
->filename
)) return Qt
;
5669 if (b
->modtime
== 0) return Qt
;
5671 /* If the file name has special constructs in it,
5672 call the corresponding file handler. */
5673 handler
= Ffind_file_name_handler (b
->filename
,
5674 Qverify_visited_file_modtime
);
5675 if (!NILP (handler
))
5676 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5678 filename
= ENCODE_FILE (b
->filename
);
5680 if (stat (SDATA (filename
), &st
) < 0)
5682 /* If the file doesn't exist now and didn't exist before,
5683 we say that it isn't modified, provided the error is a tame one. */
5684 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5689 if (st
.st_mtime
== b
->modtime
5690 /* If both are positive, accept them if they are off by one second. */
5691 || (st
.st_mtime
> 0 && b
->modtime
> 0
5692 && (st
.st_mtime
== b
->modtime
+ 1
5693 || st
.st_mtime
== b
->modtime
- 1)))
5698 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5699 Sclear_visited_file_modtime
, 0, 0, 0,
5700 doc
: /* Clear out records of last mod time of visited file.
5701 Next attempt to save will certainly not complain of a discrepancy. */)
5704 current_buffer
->modtime
= 0;
5708 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5709 Svisited_file_modtime
, 0, 0, 0,
5710 doc
: /* Return the current buffer's recorded visited file modification time.
5711 The value is a list of the form (HIGH LOW), like the time values
5712 that `file-attributes' returns. If the current buffer has no recorded
5713 file modification time, this function returns 0.
5714 See Info node `(elisp)Modification Time' for more details. */)
5718 tcons
= long_to_cons ((unsigned long) current_buffer
->modtime
);
5720 return list2 (XCAR (tcons
), XCDR (tcons
));
5724 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5725 Sset_visited_file_modtime
, 0, 1, 0,
5726 doc
: /* Update buffer's recorded modification time from the visited file's time.
5727 Useful if the buffer was not read from the file normally
5728 or if the file itself has been changed for some known benign reason.
5729 An argument specifies the modification time value to use
5730 \(instead of that of the visited file), in the form of a list
5731 \(HIGH . LOW) or (HIGH LOW). */)
5733 Lisp_Object time_list
;
5735 if (!NILP (time_list
))
5736 current_buffer
->modtime
= cons_to_long (time_list
);
5739 register Lisp_Object filename
;
5741 Lisp_Object handler
;
5743 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5745 /* If the file name has special constructs in it,
5746 call the corresponding file handler. */
5747 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5748 if (!NILP (handler
))
5749 /* The handler can find the file name the same way we did. */
5750 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5752 filename
= ENCODE_FILE (filename
);
5754 if (stat (SDATA (filename
), &st
) >= 0)
5755 current_buffer
->modtime
= st
.st_mtime
;
5762 auto_save_error (error
)
5765 Lisp_Object args
[3], msg
;
5767 struct gcpro gcpro1
;
5771 args
[0] = build_string ("Auto-saving %s: %s");
5772 args
[1] = current_buffer
->name
;
5773 args
[2] = Ferror_message_string (error
);
5774 msg
= Fformat (3, args
);
5776 nbytes
= SBYTES (msg
);
5778 for (i
= 0; i
< 3; ++i
)
5781 message2 (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5783 message2_nolog (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5784 Fsleep_for (make_number (1), Qnil
);
5797 auto_save_mode_bits
= 0666;
5799 /* Get visited file's mode to become the auto save file's mode. */
5800 if (! NILP (current_buffer
->filename
))
5802 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5803 /* But make sure we can overwrite it later! */
5804 auto_save_mode_bits
= st
.st_mode
| 0600;
5805 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5807 /* Remote files don't cooperate with stat. */
5808 auto_save_mode_bits
= XINT (modes
) | 0600;
5812 Fwrite_region (Qnil
, Qnil
,
5813 current_buffer
->auto_save_file_name
,
5814 Qnil
, Qlambda
, Qnil
, Qnil
);
5818 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5823 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5824 | XFASTINT (XCDR (stream
))));
5829 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5832 minibuffer_auto_raise
= XINT (value
);
5837 do_auto_save_make_dir (dir
)
5840 return call2 (Qmake_directory
, dir
, Qt
);
5844 do_auto_save_eh (ignore
)
5850 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5851 doc
: /* Auto-save all buffers that need it.
5852 This is all buffers that have auto-saving enabled
5853 and are changed since last auto-saved.
5854 Auto-saving writes the buffer into a file
5855 so that your editing is not lost if the system crashes.
5856 This file is not the file you visited; that changes only when you save.
5857 Normally we run the normal hook `auto-save-hook' before saving.
5859 A non-nil NO-MESSAGE argument means do not print any message if successful.
5860 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5861 (no_message
, current_only
)
5862 Lisp_Object no_message
, current_only
;
5864 struct buffer
*old
= current_buffer
, *b
;
5865 Lisp_Object tail
, buf
;
5867 int do_handled_files
;
5870 Lisp_Object lispstream
;
5871 int count
= SPECPDL_INDEX ();
5872 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5873 int old_message_p
= 0;
5874 struct gcpro gcpro1
, gcpro2
;
5876 if (max_specpdl_size
< specpdl_size
+ 40)
5877 max_specpdl_size
= specpdl_size
+ 40;
5882 if (NILP (no_message
))
5884 old_message_p
= push_message ();
5885 record_unwind_protect (pop_message_unwind
, Qnil
);
5888 /* Ordinarily don't quit within this function,
5889 but don't make it impossible to quit (in case we get hung in I/O). */
5893 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5894 point to non-strings reached from Vbuffer_alist. */
5896 if (!NILP (Vrun_hooks
))
5897 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5899 if (STRINGP (Vauto_save_list_file_name
))
5901 Lisp_Object listfile
;
5903 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5905 /* Don't try to create the directory when shutting down Emacs,
5906 because creating the directory might signal an error, and
5907 that would leave Emacs in a strange state. */
5908 if (!NILP (Vrun_hooks
))
5912 GCPRO2 (dir
, listfile
);
5913 dir
= Ffile_name_directory (listfile
);
5914 if (NILP (Ffile_directory_p (dir
)))
5915 internal_condition_case_1 (do_auto_save_make_dir
,
5916 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5921 stream
= fopen (SDATA (listfile
), "w");
5924 /* Arrange to close that file whether or not we get an error.
5925 Also reset auto_saving to 0. */
5926 lispstream
= Fcons (Qnil
, Qnil
);
5927 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
5928 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
5939 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5940 record_unwind_protect (do_auto_save_unwind_1
,
5941 make_number (minibuffer_auto_raise
));
5942 minibuffer_auto_raise
= 0;
5945 /* On first pass, save all files that don't have handlers.
5946 On second pass, save all files that do have handlers.
5948 If Emacs is crashing, the handlers may tweak what is causing
5949 Emacs to crash in the first place, and it would be a shame if
5950 Emacs failed to autosave perfectly ordinary files because it
5951 couldn't handle some ange-ftp'd file. */
5953 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5954 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5956 buf
= XCDR (XCAR (tail
));
5959 /* Record all the buffers that have auto save mode
5960 in the special file that lists them. For each of these buffers,
5961 Record visited name (if any) and auto save name. */
5962 if (STRINGP (b
->auto_save_file_name
)
5963 && stream
!= NULL
&& do_handled_files
== 0)
5965 if (!NILP (b
->filename
))
5967 fwrite (SDATA (b
->filename
), 1,
5968 SBYTES (b
->filename
), stream
);
5970 putc ('\n', stream
);
5971 fwrite (SDATA (b
->auto_save_file_name
), 1,
5972 SBYTES (b
->auto_save_file_name
), stream
);
5973 putc ('\n', stream
);
5976 if (!NILP (current_only
)
5977 && b
!= current_buffer
)
5980 /* Don't auto-save indirect buffers.
5981 The base buffer takes care of it. */
5985 /* Check for auto save enabled
5986 and file changed since last auto save
5987 and file changed since last real save. */
5988 if (STRINGP (b
->auto_save_file_name
)
5989 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5990 && b
->auto_save_modified
< BUF_MODIFF (b
)
5991 /* -1 means we've turned off autosaving for a while--see below. */
5992 && XINT (b
->save_length
) >= 0
5993 && (do_handled_files
5994 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5997 EMACS_TIME before_time
, after_time
;
5999 EMACS_GET_TIME (before_time
);
6001 /* If we had a failure, don't try again for 20 minutes. */
6002 if (b
->auto_save_failure_time
>= 0
6003 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
6006 if ((XFASTINT (b
->save_length
) * 10
6007 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
6008 /* A short file is likely to change a large fraction;
6009 spare the user annoying messages. */
6010 && XFASTINT (b
->save_length
) > 5000
6011 /* These messages are frequent and annoying for `*mail*'. */
6012 && !EQ (b
->filename
, Qnil
)
6013 && NILP (no_message
))
6015 /* It has shrunk too much; turn off auto-saving here. */
6016 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
6017 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
6019 minibuffer_auto_raise
= 0;
6020 /* Turn off auto-saving until there's a real save,
6021 and prevent any more warnings. */
6022 XSETINT (b
->save_length
, -1);
6023 Fsleep_for (make_number (1), Qnil
);
6026 set_buffer_internal (b
);
6027 if (!auto_saved
&& NILP (no_message
))
6028 message1 ("Auto-saving...");
6029 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
6031 b
->auto_save_modified
= BUF_MODIFF (b
);
6032 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6033 set_buffer_internal (old
);
6035 EMACS_GET_TIME (after_time
);
6037 /* If auto-save took more than 60 seconds,
6038 assume it was an NFS failure that got a timeout. */
6039 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
6040 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
6044 /* Prevent another auto save till enough input events come in. */
6045 record_auto_save ();
6047 if (auto_saved
&& NILP (no_message
))
6051 /* If we are going to restore an old message,
6052 give time to read ours. */
6053 sit_for (1, 0, 0, 0, 0);
6057 /* If we displayed a message and then restored a state
6058 with no message, leave a "done" message on the screen. */
6059 message1 ("Auto-saving...done");
6064 /* This restores the message-stack status. */
6065 unbind_to (count
, Qnil
);
6069 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
6070 Sset_buffer_auto_saved
, 0, 0, 0,
6071 doc
: /* Mark current buffer as auto-saved with its current text.
6072 No auto-save file will be written until the buffer changes again. */)
6075 current_buffer
->auto_save_modified
= MODIFF
;
6076 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6077 current_buffer
->auto_save_failure_time
= -1;
6081 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
6082 Sclear_buffer_auto_save_failure
, 0, 0, 0,
6083 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
6086 current_buffer
->auto_save_failure_time
= -1;
6090 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6092 doc
: /* Return t if current buffer has been auto-saved recently.
6093 More precisely, if it has been auto-saved since last read from or saved
6094 in the visited file. If the buffer has no visited file,
6095 then any auto-save counts as "recent". */)
6098 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6101 /* Reading and completing file names */
6102 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
6104 /* In the string VAL, change each $ to $$ and return the result. */
6107 double_dollars (val
)
6110 register const unsigned char *old
;
6111 register unsigned char *new;
6115 osize
= SBYTES (val
);
6117 /* Count the number of $ characters. */
6118 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
6119 if (*old
++ == '$') count
++;
6123 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
6126 for (n
= osize
; n
> 0; n
--)
6140 read_file_name_cleanup (arg
)
6143 return (current_buffer
->directory
= arg
);
6146 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
6148 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
6149 (string
, dir
, action
)
6150 Lisp_Object string
, dir
, action
;
6151 /* action is nil for complete, t for return list of completions,
6152 lambda for verify final value */
6154 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
6156 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
6158 CHECK_STRING (string
);
6165 /* No need to protect ACTION--we only compare it with t and nil. */
6166 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6168 if (SCHARS (string
) == 0)
6170 if (EQ (action
, Qlambda
))
6178 orig_string
= string
;
6179 string
= Fsubstitute_in_file_name (string
);
6180 changed
= NILP (Fstring_equal (string
, orig_string
));
6181 name
= Ffile_name_nondirectory (string
);
6182 val
= Ffile_name_directory (string
);
6184 realdir
= Fexpand_file_name (val
, realdir
);
6189 specdir
= Ffile_name_directory (string
);
6190 val
= Ffile_name_completion (name
, realdir
);
6195 return double_dollars (string
);
6199 if (!NILP (specdir
))
6200 val
= concat2 (specdir
, val
);
6202 return double_dollars (val
);
6205 #endif /* not VMS */
6209 if (EQ (action
, Qt
))
6211 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6215 if (NILP (Vread_file_name_predicate
)
6216 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6220 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6222 /* Brute-force speed up for directory checking:
6223 Discard strings which don't end in a slash. */
6224 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6226 Lisp_Object tem
= XCAR (all
);
6228 if (STRINGP (tem
) &&
6229 (len
= SCHARS (tem
), len
> 0) &&
6230 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6231 comp
= Fcons (tem
, comp
);
6237 /* Must do it the hard (and slow) way. */
6238 GCPRO3 (all
, comp
, specdir
);
6239 count
= SPECPDL_INDEX ();
6240 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6241 current_buffer
->directory
= realdir
;
6242 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6243 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
6244 comp
= Fcons (XCAR (all
), comp
);
6245 unbind_to (count
, Qnil
);
6248 return Fnreverse (comp
);
6251 /* Only other case actually used is ACTION = lambda */
6253 /* Supposedly this helps commands such as `cd' that read directory names,
6254 but can someone explain how it helps them? -- RMS */
6255 if (SCHARS (name
) == 0)
6258 string
= Fexpand_file_name (string
, dir
);
6259 if (!NILP (Vread_file_name_predicate
))
6260 return call1 (Vread_file_name_predicate
, string
);
6261 return Ffile_exists_p (string
);
6264 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
6265 Snext_read_file_uses_dialog_p
, 0, 0, 0,
6266 doc
: /* Return t if a call to `read-file-name' will use a dialog.
6267 The return value is only relevant for a call to `read-file-name' that happens
6268 before any other event (mouse or keypress) is handeled. */)
6271 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6272 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6281 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6282 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6283 Value is not expanded---you must call `expand-file-name' yourself.
6284 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6285 the same non-empty string that was inserted by this function.
6286 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6287 except that if INITIAL is specified, that combined with DIR is used.)
6288 If the user exits with an empty minibuffer, this function returns
6289 an empty string. (This can only happen if the user erased the
6290 pre-inserted contents or if `insert-default-directory' is nil.)
6291 Fourth arg MUSTMATCH non-nil means require existing file's name.
6292 Non-nil and non-t means also require confirmation after completion.
6293 Fifth arg INITIAL specifies text to start with.
6294 If optional sixth arg PREDICATE is non-nil, possible completions and
6295 the resulting file name must satisfy (funcall PREDICATE NAME).
6296 DIR should be an absolute directory name. It defaults to the value of
6297 `default-directory'.
6299 If this command was invoked with the mouse, use a file dialog box if
6300 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6301 provides a file dialog box.
6303 See also `read-file-name-completion-ignore-case'
6304 and `read-file-name-function'. */)
6305 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6306 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6308 Lisp_Object val
, insdef
, tem
;
6309 struct gcpro gcpro1
, gcpro2
;
6310 register char *homedir
;
6311 Lisp_Object decoded_homedir
;
6312 int replace_in_history
= 0;
6313 int add_to_history
= 0;
6317 dir
= current_buffer
->directory
;
6318 if (NILP (Ffile_name_absolute_p (dir
)))
6319 dir
= Fexpand_file_name (dir
, Qnil
);
6320 if (NILP (default_filename
))
6323 ? Fexpand_file_name (initial
, dir
)
6324 : current_buffer
->filename
);
6326 /* If dir starts with user's homedir, change that to ~. */
6327 homedir
= (char *) egetenv ("HOME");
6329 /* homedir can be NULL in temacs, since Vprocess_environment is not
6330 yet set up. We shouldn't crash in that case. */
6333 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6334 CORRECT_DIR_SEPS (homedir
);
6339 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6342 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6343 SBYTES (decoded_homedir
))
6344 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6346 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6347 dir
= concat2 (build_string ("~"), dir
);
6349 /* Likewise for default_filename. */
6351 && STRINGP (default_filename
)
6352 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6353 SBYTES (decoded_homedir
))
6354 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6357 = Fsubstring (default_filename
,
6358 make_number (SCHARS (decoded_homedir
)), Qnil
);
6359 default_filename
= concat2 (build_string ("~"), default_filename
);
6361 if (!NILP (default_filename
))
6363 CHECK_STRING (default_filename
);
6364 default_filename
= double_dollars (default_filename
);
6367 if (insert_default_directory
&& STRINGP (dir
))
6370 if (!NILP (initial
))
6372 Lisp_Object args
[2], pos
;
6376 insdef
= Fconcat (2, args
);
6377 pos
= make_number (SCHARS (double_dollars (dir
)));
6378 insdef
= Fcons (double_dollars (insdef
), pos
);
6381 insdef
= double_dollars (insdef
);
6383 else if (STRINGP (initial
))
6384 insdef
= Fcons (double_dollars (initial
), make_number (0));
6388 if (!NILP (Vread_file_name_function
))
6390 Lisp_Object args
[7];
6392 GCPRO2 (insdef
, default_filename
);
6393 args
[0] = Vread_file_name_function
;
6396 args
[3] = default_filename
;
6397 args
[4] = mustmatch
;
6399 args
[6] = predicate
;
6400 RETURN_UNGCPRO (Ffuncall (7, args
));
6403 count
= SPECPDL_INDEX ();
6404 specbind (intern ("completion-ignore-case"),
6405 read_file_name_completion_ignore_case
? Qt
: Qnil
);
6406 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6407 specbind (intern ("read-file-name-predicate"),
6408 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6410 GCPRO2 (insdef
, default_filename
);
6412 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6413 if (! NILP (Fnext_read_file_uses_dialog_p ()))
6415 /* If DIR contains a file name, split it. */
6417 file
= Ffile_name_nondirectory (dir
);
6418 if (SCHARS (file
) && NILP (default_filename
))
6420 default_filename
= file
;
6421 dir
= Ffile_name_directory (dir
);
6423 if (!NILP(default_filename
))
6424 default_filename
= Fexpand_file_name (default_filename
, dir
);
6425 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
,
6426 EQ (predicate
, Qfile_directory_p
) ? Qt
: Qnil
);
6431 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6432 dir
, mustmatch
, insdef
,
6433 Qfile_name_history
, default_filename
, Qnil
);
6435 tem
= Fsymbol_value (Qfile_name_history
);
6436 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6437 replace_in_history
= 1;
6439 /* If Fcompleting_read returned the inserted default string itself
6440 (rather than a new string with the same contents),
6441 it has to mean that the user typed RET with the minibuffer empty.
6442 In that case, we really want to return ""
6443 so that commands such as set-visited-file-name can distinguish. */
6444 if (EQ (val
, default_filename
))
6446 /* In this case, Fcompleting_read has not added an element
6447 to the history. Maybe we should. */
6448 if (! replace_in_history
)
6454 unbind_to (count
, Qnil
);
6457 error ("No file name specified");
6459 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6461 if (!NILP (tem
) && !NILP (default_filename
))
6462 val
= default_filename
;
6463 val
= Fsubstitute_in_file_name (val
);
6465 if (replace_in_history
)
6466 /* Replace what Fcompleting_read added to the history
6467 with what we will actually return. */
6469 Lisp_Object val1
= double_dollars (val
);
6470 tem
= Fsymbol_value (Qfile_name_history
);
6471 if (history_delete_duplicates
)
6472 XSETCDR (tem
, Fdelete (val1
, XCDR(tem
)));
6473 XSETCAR (tem
, val1
);
6475 else if (add_to_history
)
6477 /* Add the value to the history--but not if it matches
6478 the last value already there. */
6479 Lisp_Object val1
= double_dollars (val
);
6480 tem
= Fsymbol_value (Qfile_name_history
);
6481 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6483 if (history_delete_duplicates
) tem
= Fdelete (val1
, tem
);
6484 Fset (Qfile_name_history
, Fcons (val1
, tem
));
6495 /* Must be set before any path manipulation is performed. */
6496 XSETFASTINT (Vdirectory_sep_char
, '/');
6503 Qoperations
= intern ("operations");
6504 Qexpand_file_name
= intern ("expand-file-name");
6505 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6506 Qdirectory_file_name
= intern ("directory-file-name");
6507 Qfile_name_directory
= intern ("file-name-directory");
6508 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6509 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6510 Qfile_name_as_directory
= intern ("file-name-as-directory");
6511 Qcopy_file
= intern ("copy-file");
6512 Qmake_directory_internal
= intern ("make-directory-internal");
6513 Qmake_directory
= intern ("make-directory");
6514 Qdelete_directory
= intern ("delete-directory");
6515 Qdelete_file
= intern ("delete-file");
6516 Qrename_file
= intern ("rename-file");
6517 Qadd_name_to_file
= intern ("add-name-to-file");
6518 Qmake_symbolic_link
= intern ("make-symbolic-link");
6519 Qfile_exists_p
= intern ("file-exists-p");
6520 Qfile_executable_p
= intern ("file-executable-p");
6521 Qfile_readable_p
= intern ("file-readable-p");
6522 Qfile_writable_p
= intern ("file-writable-p");
6523 Qfile_symlink_p
= intern ("file-symlink-p");
6524 Qaccess_file
= intern ("access-file");
6525 Qfile_directory_p
= intern ("file-directory-p");
6526 Qfile_regular_p
= intern ("file-regular-p");
6527 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6528 Qfile_modes
= intern ("file-modes");
6529 Qset_file_modes
= intern ("set-file-modes");
6530 Qset_file_times
= intern ("set-file-times");
6531 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6532 Qinsert_file_contents
= intern ("insert-file-contents");
6533 Qwrite_region
= intern ("write-region");
6534 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6535 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6536 Qauto_save_coding
= intern ("auto-save-coding");
6538 staticpro (&Qoperations
);
6539 staticpro (&Qexpand_file_name
);
6540 staticpro (&Qsubstitute_in_file_name
);
6541 staticpro (&Qdirectory_file_name
);
6542 staticpro (&Qfile_name_directory
);
6543 staticpro (&Qfile_name_nondirectory
);
6544 staticpro (&Qunhandled_file_name_directory
);
6545 staticpro (&Qfile_name_as_directory
);
6546 staticpro (&Qcopy_file
);
6547 staticpro (&Qmake_directory_internal
);
6548 staticpro (&Qmake_directory
);
6549 staticpro (&Qdelete_directory
);
6550 staticpro (&Qdelete_file
);
6551 staticpro (&Qrename_file
);
6552 staticpro (&Qadd_name_to_file
);
6553 staticpro (&Qmake_symbolic_link
);
6554 staticpro (&Qfile_exists_p
);
6555 staticpro (&Qfile_executable_p
);
6556 staticpro (&Qfile_readable_p
);
6557 staticpro (&Qfile_writable_p
);
6558 staticpro (&Qaccess_file
);
6559 staticpro (&Qfile_symlink_p
);
6560 staticpro (&Qfile_directory_p
);
6561 staticpro (&Qfile_regular_p
);
6562 staticpro (&Qfile_accessible_directory_p
);
6563 staticpro (&Qfile_modes
);
6564 staticpro (&Qset_file_modes
);
6565 staticpro (&Qset_file_times
);
6566 staticpro (&Qfile_newer_than_file_p
);
6567 staticpro (&Qinsert_file_contents
);
6568 staticpro (&Qwrite_region
);
6569 staticpro (&Qverify_visited_file_modtime
);
6570 staticpro (&Qset_visited_file_modtime
);
6571 staticpro (&Qauto_save_coding
);
6573 Qfile_name_history
= intern ("file-name-history");
6574 Fset (Qfile_name_history
, Qnil
);
6575 staticpro (&Qfile_name_history
);
6577 Qfile_error
= intern ("file-error");
6578 staticpro (&Qfile_error
);
6579 Qfile_already_exists
= intern ("file-already-exists");
6580 staticpro (&Qfile_already_exists
);
6581 Qfile_date_error
= intern ("file-date-error");
6582 staticpro (&Qfile_date_error
);
6583 Qexcl
= intern ("excl");
6587 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6588 staticpro (&Qfind_buffer_file_type
);
6591 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6592 doc
: /* *Coding system for encoding file names.
6593 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6594 Vfile_name_coding_system
= Qnil
;
6596 DEFVAR_LISP ("default-file-name-coding-system",
6597 &Vdefault_file_name_coding_system
,
6598 doc
: /* Default coding system for encoding file names.
6599 This variable is used only when `file-name-coding-system' is nil.
6601 This variable is set/changed by the command `set-language-environment'.
6602 User should not set this variable manually,
6603 instead use `file-name-coding-system' to get a constant encoding
6604 of file names regardless of the current language environment. */);
6605 Vdefault_file_name_coding_system
= Qnil
;
6607 Qformat_decode
= intern ("format-decode");
6608 staticpro (&Qformat_decode
);
6609 Qformat_annotate_function
= intern ("format-annotate-function");
6610 staticpro (&Qformat_annotate_function
);
6611 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6612 staticpro (&Qafter_insert_file_set_coding
);
6614 Qcar_less_than_car
= intern ("car-less-than-car");
6615 staticpro (&Qcar_less_than_car
);
6617 Fput (Qfile_error
, Qerror_conditions
,
6618 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6619 Fput (Qfile_error
, Qerror_message
,
6620 build_string ("File error"));
6622 Fput (Qfile_already_exists
, Qerror_conditions
,
6623 Fcons (Qfile_already_exists
,
6624 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6625 Fput (Qfile_already_exists
, Qerror_message
,
6626 build_string ("File already exists"));
6628 Fput (Qfile_date_error
, Qerror_conditions
,
6629 Fcons (Qfile_date_error
,
6630 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6631 Fput (Qfile_date_error
, Qerror_message
,
6632 build_string ("Cannot set file date"));
6634 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6635 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6636 Vread_file_name_function
= Qnil
;
6638 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6639 doc
: /* Current predicate used by `read-file-name-internal'. */);
6640 Vread_file_name_predicate
= Qnil
;
6642 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case
,
6643 doc
: /* *Non-nil means when reading a file name completion ignores case. */);
6644 #if defined VMS || defined DOS_NT || defined MAC_OS
6645 read_file_name_completion_ignore_case
= 1;
6647 read_file_name_completion_ignore_case
= 0;
6650 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6651 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6652 If the initial minibuffer contents are non-empty, you can usually
6653 request a default filename by typing RETURN without editing. For some
6654 commands, exiting with an empty minibuffer has a special meaning,
6655 such as making the current buffer visit no file in the case of
6656 `set-visited-file-name'.
6657 If this variable is non-nil, the minibuffer contents are always
6658 initially non-empty and typing RETURN without editing will fetch the
6659 default name, if one is provided. Note however that this default name
6660 is not necessarily the name originally inserted in the minibuffer, if
6661 that is just the default directory.
6662 If this variable is nil, the minibuffer often starts out empty. In
6663 that case you may have to explicitly fetch the next history element to
6664 request the default name. */);
6665 insert_default_directory
= 1;
6667 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6668 doc
: /* *Non-nil means write new files with record format `stmlf'.
6669 nil means use format `var'. This variable is meaningful only on VMS. */);
6670 vms_stmlf_recfm
= 0;
6672 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6673 doc
: /* Directory separator character for built-in functions that return file names.
6674 The value is always ?/. Don't use this variable, just use `/'. */);
6676 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6677 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6678 If a file name matches REGEXP, then all I/O on that file is done by calling
6681 The first argument given to HANDLER is the name of the I/O primitive
6682 to be handled; the remaining arguments are the arguments that were
6683 passed to that primitive. For example, if you do
6684 (file-exists-p FILENAME)
6685 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6686 (funcall HANDLER 'file-exists-p FILENAME)
6687 The function `find-file-name-handler' checks this list for a handler
6688 for its argument. */);
6689 Vfile_name_handler_alist
= Qnil
;
6691 DEFVAR_LISP ("set-auto-coding-function",
6692 &Vset_auto_coding_function
,
6693 doc
: /* If non-nil, a function to call to decide a coding system of file.
6694 Two arguments are passed to this function: the file name
6695 and the length of a file contents following the point.
6696 This function should return a coding system to decode the file contents.
6697 It should check the file name against `auto-coding-alist'.
6698 If no coding system is decided, it should check a coding system
6699 specified in the heading lines with the format:
6700 -*- ... coding: CODING-SYSTEM; ... -*-
6701 or local variable spec of the tailing lines with `coding:' tag. */);
6702 Vset_auto_coding_function
= Qnil
;
6704 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6705 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6706 Each is passed one argument, the number of characters inserted.
6707 It should return the new character count, and leave point the same.
6708 If `insert-file-contents' is intercepted by a handler from
6709 `file-name-handler-alist', that handler is responsible for calling the
6710 functions in `after-insert-file-functions' if appropriate. */);
6711 Vafter_insert_file_functions
= Qnil
;
6713 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6714 doc
: /* A list of functions to be called at the start of `write-region'.
6715 Each is passed two arguments, START and END as for `write-region'.
6716 These are usually two numbers but not always; see the documentation
6717 for `write-region'. The function should return a list of pairs
6718 of the form (POSITION . STRING), consisting of strings to be effectively
6719 inserted at the specified positions of the file being written (1 means to
6720 insert before the first byte written). The POSITIONs must be sorted into
6721 increasing order. If there are several functions in the list, the several
6722 lists are merged destructively. Alternatively, the function can return
6723 with a different buffer current; in that case it should pay attention
6724 to the annotations returned by previous functions and listed in
6725 `write-region-annotations-so-far'.*/);
6726 Vwrite_region_annotate_functions
= Qnil
;
6727 staticpro (&Qwrite_region_annotate_functions
);
6728 Qwrite_region_annotate_functions
6729 = intern ("write-region-annotate-functions");
6731 DEFVAR_LISP ("write-region-annotations-so-far",
6732 &Vwrite_region_annotations_so_far
,
6733 doc
: /* When an annotation function is called, this holds the previous annotations.
6734 These are the annotations made by other annotation functions
6735 that were already called. See also `write-region-annotate-functions'. */);
6736 Vwrite_region_annotations_so_far
= Qnil
;
6738 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6739 doc
: /* A list of file name handlers that temporarily should not be used.
6740 This applies only to the operation `inhibit-file-name-operation'. */);
6741 Vinhibit_file_name_handlers
= Qnil
;
6743 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6744 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6745 Vinhibit_file_name_operation
= Qnil
;
6747 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6748 doc
: /* File name in which we write a list of all auto save file names.
6749 This variable is initialized automatically from `auto-save-list-file-prefix'
6750 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6751 a non-nil value. */);
6752 Vauto_save_list_file_name
= Qnil
;
6754 defsubr (&Sfind_file_name_handler
);
6755 defsubr (&Sfile_name_directory
);
6756 defsubr (&Sfile_name_nondirectory
);
6757 defsubr (&Sunhandled_file_name_directory
);
6758 defsubr (&Sfile_name_as_directory
);
6759 defsubr (&Sdirectory_file_name
);
6760 defsubr (&Smake_temp_name
);
6761 defsubr (&Sexpand_file_name
);
6762 defsubr (&Ssubstitute_in_file_name
);
6763 defsubr (&Scopy_file
);
6764 defsubr (&Smake_directory_internal
);
6765 defsubr (&Sdelete_directory
);
6766 defsubr (&Sdelete_file
);
6767 defsubr (&Srename_file
);
6768 defsubr (&Sadd_name_to_file
);
6770 defsubr (&Smake_symbolic_link
);
6771 #endif /* S_IFLNK */
6773 defsubr (&Sdefine_logical_name
);
6776 defsubr (&Ssysnetunam
);
6777 #endif /* HPUX_NET */
6778 defsubr (&Sfile_name_absolute_p
);
6779 defsubr (&Sfile_exists_p
);
6780 defsubr (&Sfile_executable_p
);
6781 defsubr (&Sfile_readable_p
);
6782 defsubr (&Sfile_writable_p
);
6783 defsubr (&Saccess_file
);
6784 defsubr (&Sfile_symlink_p
);
6785 defsubr (&Sfile_directory_p
);
6786 defsubr (&Sfile_accessible_directory_p
);
6787 defsubr (&Sfile_regular_p
);
6788 defsubr (&Sfile_modes
);
6789 defsubr (&Sset_file_modes
);
6790 defsubr (&Sset_file_times
);
6791 defsubr (&Sset_default_file_modes
);
6792 defsubr (&Sdefault_file_modes
);
6793 defsubr (&Sfile_newer_than_file_p
);
6794 defsubr (&Sinsert_file_contents
);
6795 defsubr (&Swrite_region
);
6796 defsubr (&Scar_less_than_car
);
6797 defsubr (&Sverify_visited_file_modtime
);
6798 defsubr (&Sclear_visited_file_modtime
);
6799 defsubr (&Svisited_file_modtime
);
6800 defsubr (&Sset_visited_file_modtime
);
6801 defsubr (&Sdo_auto_save
);
6802 defsubr (&Sset_buffer_auto_saved
);
6803 defsubr (&Sclear_buffer_auto_save_failure
);
6804 defsubr (&Srecent_auto_save_p
);
6806 defsubr (&Sread_file_name_internal
);
6807 defsubr (&Sread_file_name
);
6808 defsubr (&Snext_read_file_uses_dialog_p
);
6811 defsubr (&Sunix_sync
);
6815 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6816 (do not change this comment) */