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"
76 #include "character.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
;
269 synchronize_system_messages_locale ();
270 str
= strerror (errorno
);
271 errstring
= code_convert_string_norecord (make_unibyte_string (str
,
273 Vlocale_coding_system
, 0);
279 Fsignal (Qfile_already_exists
, Fcons (errstring
, data
));
282 /* System error messages are capitalized. Downcase the initial
283 unless it is followed by a slash. */
284 if (SREF (errstring
, 1) != '/')
285 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
287 Fsignal (Qfile_error
,
288 Fcons (build_string (string
), Fcons (errstring
, data
)));
293 close_file_unwind (fd
)
296 emacs_close (XFASTINT (fd
));
300 /* Restore point, having saved it as a marker. */
303 restore_point_unwind (location
)
304 Lisp_Object location
;
306 Fgoto_char (location
);
307 Fset_marker (location
, Qnil
, Qnil
);
312 Lisp_Object Qexpand_file_name
;
313 Lisp_Object Qsubstitute_in_file_name
;
314 Lisp_Object Qdirectory_file_name
;
315 Lisp_Object Qfile_name_directory
;
316 Lisp_Object Qfile_name_nondirectory
;
317 Lisp_Object Qunhandled_file_name_directory
;
318 Lisp_Object Qfile_name_as_directory
;
319 Lisp_Object Qcopy_file
;
320 Lisp_Object Qmake_directory_internal
;
321 Lisp_Object Qmake_directory
;
322 Lisp_Object Qdelete_directory
;
323 Lisp_Object Qdelete_file
;
324 Lisp_Object Qrename_file
;
325 Lisp_Object Qadd_name_to_file
;
326 Lisp_Object Qmake_symbolic_link
;
327 Lisp_Object Qfile_exists_p
;
328 Lisp_Object Qfile_executable_p
;
329 Lisp_Object Qfile_readable_p
;
330 Lisp_Object Qfile_writable_p
;
331 Lisp_Object Qfile_symlink_p
;
332 Lisp_Object Qaccess_file
;
333 Lisp_Object Qfile_directory_p
;
334 Lisp_Object Qfile_regular_p
;
335 Lisp_Object Qfile_accessible_directory_p
;
336 Lisp_Object Qfile_modes
;
337 Lisp_Object Qset_file_modes
;
338 Lisp_Object Qset_file_times
;
339 Lisp_Object Qfile_newer_than_file_p
;
340 Lisp_Object Qinsert_file_contents
;
341 Lisp_Object Qwrite_region
;
342 Lisp_Object Qverify_visited_file_modtime
;
343 Lisp_Object Qset_visited_file_modtime
;
345 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
346 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
347 Otherwise, return nil.
348 A file name is handled if one of the regular expressions in
349 `file-name-handler-alist' matches it.
351 If OPERATION equals `inhibit-file-name-operation', then we ignore
352 any handlers that are members of `inhibit-file-name-handlers',
353 but we still do run any other handlers. This lets handlers
354 use the standard functions without calling themselves recursively. */)
355 (filename
, operation
)
356 Lisp_Object filename
, operation
;
358 /* This function must not munge the match data. */
359 Lisp_Object chain
, inhibited_handlers
, result
;
363 CHECK_STRING (filename
);
365 if (EQ (operation
, Vinhibit_file_name_operation
))
366 inhibited_handlers
= Vinhibit_file_name_handlers
;
368 inhibited_handlers
= Qnil
;
370 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
371 chain
= XCDR (chain
))
377 Lisp_Object string
= XCAR (elt
);
379 Lisp_Object handler
= XCDR (elt
);
380 Lisp_Object operations
= Qnil
;
382 if (SYMBOLP (handler
))
383 operations
= Fget (handler
, Qoperations
);
386 && (match_pos
= fast_string_match (string
, filename
)) > pos
387 && (NILP (operations
) || ! NILP (Fmemq (operation
, operations
))))
391 handler
= XCDR (elt
);
392 tem
= Fmemq (handler
, inhibited_handlers
);
406 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
408 doc
: /* Return the directory component in file name FILENAME.
409 Return nil if FILENAME does not include a directory.
410 Otherwise return a directory spec.
411 Given a Unix syntax file name, returns a string ending in slash;
412 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
414 Lisp_Object filename
;
417 register const unsigned char *beg
;
419 register unsigned char *beg
;
421 register const unsigned char *p
;
424 CHECK_STRING (filename
);
426 /* If the file name has special constructs in it,
427 call the corresponding file handler. */
428 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
430 return call2 (handler
, Qfile_name_directory
, filename
);
432 filename
= FILE_SYSTEM_CASE (filename
);
433 beg
= SDATA (filename
);
435 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
437 p
= beg
+ SBYTES (filename
);
439 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
441 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
444 /* only recognise drive specifier at the beginning */
446 /* handle the "/:d:foo" and "/:foo" cases correctly */
447 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
448 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
455 /* Expansion of "c:" to drive and default directory. */
458 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
459 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
460 unsigned char *r
= res
;
462 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
464 strncpy (res
, beg
, 2);
469 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
471 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
474 p
= beg
+ strlen (beg
);
477 CORRECT_DIR_SEPS (beg
);
480 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
483 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
484 Sfile_name_nondirectory
, 1, 1, 0,
485 doc
: /* Return file name FILENAME sans its directory.
486 For example, in a Unix-syntax file name,
487 this is everything after the last slash,
488 or the entire name if it contains no slash. */)
490 Lisp_Object filename
;
492 register const unsigned char *beg
, *p
, *end
;
495 CHECK_STRING (filename
);
497 /* If the file name has special constructs in it,
498 call the corresponding file handler. */
499 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
501 return call2 (handler
, Qfile_name_nondirectory
, filename
);
503 beg
= SDATA (filename
);
504 end
= p
= beg
+ SBYTES (filename
);
506 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
508 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
511 /* only recognise drive specifier at beginning */
513 /* handle the "/:d:foo" case correctly */
514 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
519 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
522 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
523 Sunhandled_file_name_directory
, 1, 1, 0,
524 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
525 A `directly usable' directory name is one that may be used without the
526 intervention of any file handler.
527 If FILENAME is a directly usable file itself, return
528 \(file-name-directory FILENAME).
529 The `call-process' and `start-process' functions use this function to
530 get a current directory to run processes in. */)
532 Lisp_Object filename
;
536 /* If the file name has special constructs in it,
537 call the corresponding file handler. */
538 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
540 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
542 return Ffile_name_directory (filename
);
547 file_name_as_directory (out
, in
)
550 int size
= strlen (in
) - 1;
563 /* Is it already a directory string? */
564 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
566 /* Is it a VMS directory file name? If so, hack VMS syntax. */
567 else if (! index (in
, '/')
568 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
569 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
570 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
571 || ! strncmp (&in
[size
- 5], ".dir", 4))
572 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
573 && in
[size
] == '1')))
575 register char *p
, *dot
;
579 dir:x.dir --> dir:[x]
580 dir:[x]y.dir --> dir:[x.y] */
582 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
585 strncpy (out
, in
, p
- in
);
604 dot
= index (p
, '.');
607 /* blindly remove any extension */
608 size
= strlen (out
) + (dot
- p
);
609 strncat (out
, p
, dot
- p
);
620 /* For Unix syntax, Append a slash if necessary */
621 if (!IS_DIRECTORY_SEP (out
[size
]))
623 /* Cannot use DIRECTORY_SEP, which could have any value */
625 out
[size
+ 2] = '\0';
628 CORRECT_DIR_SEPS (out
);
634 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
635 Sfile_name_as_directory
, 1, 1, 0,
636 doc
: /* Return a string representing the file name FILE interpreted as a directory.
637 This operation exists because a directory is also a file, but its name as
638 a directory is different from its name as a file.
639 The result can be used as the value of `default-directory'
640 or passed as second argument to `expand-file-name'.
641 For a Unix-syntax file name, just appends a slash.
642 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
653 /* If the file name has special constructs in it,
654 call the corresponding file handler. */
655 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
657 return call2 (handler
, Qfile_name_as_directory
, file
);
659 buf
= (char *) alloca (SBYTES (file
) + 10);
660 file_name_as_directory (buf
, SDATA (file
));
661 return make_specified_string (buf
, -1, strlen (buf
),
662 STRING_MULTIBYTE (file
));
666 * Convert from directory name to filename.
668 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
669 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
670 * On UNIX, it's simple: just make sure there isn't a terminating /
672 * Value is nonzero if the string output is different from the input.
676 directory_file_name (src
, dst
)
684 struct FAB fab
= cc$rms_fab
;
685 struct NAM nam
= cc$rms_nam
;
686 char esa
[NAM$C_MAXRSS
];
691 if (! index (src
, '/')
692 && (src
[slen
- 1] == ']'
693 || src
[slen
- 1] == ':'
694 || src
[slen
- 1] == '>'))
696 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
698 fab
.fab$b_fns
= slen
;
699 fab
.fab$l_nam
= &nam
;
700 fab
.fab$l_fop
= FAB$M_NAM
;
703 nam
.nam$b_ess
= sizeof esa
;
704 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
706 /* We call SYS$PARSE to handle such things as [--] for us. */
707 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
709 slen
= nam
.nam$b_esl
;
710 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
715 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
717 /* what about when we have logical_name:???? */
718 if (src
[slen
- 1] == ':')
719 { /* Xlate logical name and see what we get */
720 ptr
= strcpy (dst
, src
); /* upper case for getenv */
723 if ('a' <= *ptr
&& *ptr
<= 'z')
727 dst
[slen
- 1] = 0; /* remove colon */
728 if (!(src
= egetenv (dst
)))
730 /* should we jump to the beginning of this procedure?
731 Good points: allows us to use logical names that xlate
733 Bad points: can be a problem if we just translated to a device
735 For now, I'll punt and always expect VMS names, and hope for
738 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
739 { /* no recursion here! */
745 { /* not a directory spec */
750 bracket
= src
[slen
- 1];
752 /* If bracket is ']' or '>', bracket - 2 is the corresponding
754 ptr
= index (src
, bracket
- 2);
756 { /* no opening bracket */
760 if (!(rptr
= rindex (src
, '.')))
763 strncpy (dst
, src
, slen
);
767 dst
[slen
++] = bracket
;
772 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
773 then translate the device and recurse. */
774 if (dst
[slen
- 1] == ':'
775 && dst
[slen
- 2] != ':' /* skip decnet nodes */
776 && strcmp (src
+ slen
, "[000000]") == 0)
778 dst
[slen
- 1] = '\0';
779 if ((ptr
= egetenv (dst
))
780 && (rlen
= strlen (ptr
) - 1) > 0
781 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
782 && ptr
[rlen
- 1] == '.')
784 char * buf
= (char *) alloca (strlen (ptr
) + 1);
788 return directory_file_name (buf
, dst
);
793 strcat (dst
, "[000000]");
797 rlen
= strlen (rptr
) - 1;
798 strncat (dst
, rptr
, rlen
);
799 dst
[slen
+ rlen
] = '\0';
800 strcat (dst
, ".DIR.1");
804 /* Process as Unix format: just remove any final slash.
805 But leave "/" unchanged; do not change it to "". */
808 /* Handle // as root for apollo's. */
809 if ((slen
> 2 && dst
[slen
- 1] == '/')
810 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
814 && IS_DIRECTORY_SEP (dst
[slen
- 1])
816 && !IS_ANY_SEP (dst
[slen
- 2])
822 CORRECT_DIR_SEPS (dst
);
827 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
829 doc
: /* Returns the file name of the directory named DIRECTORY.
830 This is the name of the file that holds the data for the directory DIRECTORY.
831 This operation exists because a directory is also a file, but its name as
832 a directory is different from its name as a file.
833 In Unix-syntax, this function just removes the final slash.
834 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
835 it returns a file name such as \"[X]Y.DIR.1\". */)
837 Lisp_Object directory
;
842 CHECK_STRING (directory
);
844 if (NILP (directory
))
847 /* If the file name has special constructs in it,
848 call the corresponding file handler. */
849 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
851 return call2 (handler
, Qdirectory_file_name
, directory
);
854 /* 20 extra chars is insufficient for VMS, since we might perform a
855 logical name translation. an equivalence string can be up to 255
856 chars long, so grab that much extra space... - sss */
857 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
859 buf
= (char *) alloca (SBYTES (directory
) + 20);
861 directory_file_name (SDATA (directory
), buf
);
862 return make_specified_string (buf
, -1, strlen (buf
),
863 STRING_MULTIBYTE (directory
));
866 static char make_temp_name_tbl
[64] =
868 'A','B','C','D','E','F','G','H',
869 'I','J','K','L','M','N','O','P',
870 'Q','R','S','T','U','V','W','X',
871 'Y','Z','a','b','c','d','e','f',
872 'g','h','i','j','k','l','m','n',
873 'o','p','q','r','s','t','u','v',
874 'w','x','y','z','0','1','2','3',
875 '4','5','6','7','8','9','-','_'
878 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
880 /* Value is a temporary file name starting with PREFIX, a string.
882 The Emacs process number forms part of the result, so there is
883 no danger of generating a name being used by another process.
884 In addition, this function makes an attempt to choose a name
885 which has no existing file. To make this work, PREFIX should be
886 an absolute file name.
888 BASE64_P non-zero means add the pid as 3 characters in base64
889 encoding. In this case, 6 characters will be added to PREFIX to
890 form the file name. Otherwise, if Emacs is running on a system
891 with long file names, add the pid as a decimal number.
893 This function signals an error if no unique file name could be
897 make_temp_name (prefix
, base64_p
)
904 unsigned char *p
, *data
;
908 CHECK_STRING (prefix
);
910 /* VAL is created by adding 6 characters to PREFIX. The first
911 three are the PID of this process, in base 64, and the second
912 three are incremented if the file already exists. This ensures
913 262144 unique file names per PID per PREFIX. */
915 pid
= (int) getpid ();
919 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
920 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
921 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
926 #ifdef HAVE_LONG_FILE_NAMES
927 sprintf (pidbuf
, "%d", pid
);
928 pidlen
= strlen (pidbuf
);
930 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
931 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
932 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
937 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
938 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
939 if (!STRING_MULTIBYTE (prefix
))
940 STRING_SET_UNIBYTE (val
);
942 bcopy(SDATA (prefix
), data
, len
);
945 bcopy (pidbuf
, p
, pidlen
);
948 /* Here we try to minimize useless stat'ing when this function is
949 invoked many times successively with the same PREFIX. We achieve
950 this by initializing count to a random value, and incrementing it
953 We don't want make-temp-name to be called while dumping,
954 because then make_temp_name_count_initialized_p would get set
955 and then make_temp_name_count would not be set when Emacs starts. */
957 if (!make_temp_name_count_initialized_p
)
959 make_temp_name_count
= (unsigned) time (NULL
);
960 make_temp_name_count_initialized_p
= 1;
966 unsigned num
= make_temp_name_count
;
968 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
969 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
970 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
972 /* Poor man's congruential RN generator. Replace with
973 ++make_temp_name_count for debugging. */
974 make_temp_name_count
+= 25229;
975 make_temp_name_count
%= 225307;
977 if (stat (data
, &ignored
) < 0)
979 /* We want to return only if errno is ENOENT. */
983 /* The error here is dubious, but there is little else we
984 can do. The alternatives are to return nil, which is
985 as bad as (and in many cases worse than) throwing the
986 error, or to ignore the error, which will likely result
987 in looping through 225307 stat's, which is not only
988 dog-slow, but also useless since it will fallback to
989 the errow below, anyway. */
990 report_file_error ("Cannot create temporary name for prefix",
991 Fcons (prefix
, Qnil
));
996 error ("Cannot create temporary name for prefix `%s'",
1002 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
1003 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
1004 The Emacs process number forms part of the result,
1005 so there is no danger of generating a name being used by another process.
1007 In addition, this function makes an attempt to choose a name
1008 which has no existing file. To make this work,
1009 PREFIX should be an absolute file name.
1011 There is a race condition between calling `make-temp-name' and creating the
1012 file which opens all kinds of security holes. For that reason, you should
1013 probably use `make-temp-file' instead, except in three circumstances:
1015 * If you are creating the file in the user's home directory.
1016 * If you are creating a directory rather than an ordinary file.
1017 * If you are taking special precautions as `make-temp-file' does. */)
1021 return make_temp_name (prefix
, 0);
1026 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1027 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1028 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1029 \(does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
1030 the current buffer's value of `default-directory' is used.
1031 File name components that are `.' are removed, and
1032 so are file name components followed by `..', along with the `..' itself;
1033 note that these simplifications are done without checking the resulting
1034 file names in the file system.
1035 An initial `~/' expands to your home directory.
1036 An initial `~USER/' expands to USER's home directory.
1037 See also the function `substitute-in-file-name'. */)
1038 (name
, default_directory
)
1039 Lisp_Object name
, default_directory
;
1043 register unsigned char *newdir
, *p
, *o
;
1045 unsigned char *target
;
1048 unsigned char * colon
= 0;
1049 unsigned char * close
= 0;
1050 unsigned char * slash
= 0;
1051 unsigned char * brack
= 0;
1052 int lbrack
= 0, rbrack
= 0;
1057 int collapse_newdir
= 1;
1061 Lisp_Object handler
, result
;
1063 CHECK_STRING (name
);
1065 /* If the file name has special constructs in it,
1066 call the corresponding file handler. */
1067 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1068 if (!NILP (handler
))
1069 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1071 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1072 if (NILP (default_directory
))
1073 default_directory
= current_buffer
->directory
;
1074 if (! STRINGP (default_directory
))
1077 /* "/" is not considered a root directory on DOS_NT, so using "/"
1078 here causes an infinite recursion in, e.g., the following:
1080 (let (default-directory)
1081 (expand-file-name "a"))
1083 To avoid this, we set default_directory to the root of the
1085 extern char *emacs_root_dir (void);
1087 default_directory
= build_string (emacs_root_dir ());
1089 default_directory
= build_string ("/");
1093 if (!NILP (default_directory
))
1095 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1096 if (!NILP (handler
))
1097 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1100 o
= SDATA (default_directory
);
1102 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1103 It would be better to do this down below where we actually use
1104 default_directory. Unfortunately, calling Fexpand_file_name recursively
1105 could invoke GC, and the strings might be relocated. This would
1106 be annoying because we have pointers into strings lying around
1107 that would need adjusting, and people would add new pointers to
1108 the code and forget to adjust them, resulting in intermittent bugs.
1109 Putting this call here avoids all that crud.
1111 The EQ test avoids infinite recursion. */
1112 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1113 /* Save time in some common cases - as long as default_directory
1114 is not relative, it can be canonicalized with name below (if it
1115 is needed at all) without requiring it to be expanded now. */
1117 /* Detect MSDOS file names with drive specifiers. */
1118 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1120 /* Detect Windows file names in UNC format. */
1121 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1123 #else /* not DOS_NT */
1124 /* Detect Unix absolute file names (/... alone is not absolute on
1126 && ! (IS_DIRECTORY_SEP (o
[0]))
1127 #endif /* not DOS_NT */
1130 struct gcpro gcpro1
;
1133 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1137 name
= FILE_SYSTEM_CASE (name
);
1141 /* We will force directory separators to be either all \ or /, so make
1142 a local copy to modify, even if there ends up being no change. */
1143 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1145 /* Note if special escape prefix is present, but remove for now. */
1146 if (nm
[0] == '/' && nm
[1] == ':')
1152 /* Find and remove drive specifier if present; this makes nm absolute
1153 even if the rest of the name appears to be relative. Only look for
1154 drive specifier at the beginning. */
1155 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1162 /* If we see "c://somedir", we want to strip the first slash after the
1163 colon when stripping the drive letter. Otherwise, this expands to
1165 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1167 #endif /* WINDOWSNT */
1171 /* Discard any previous drive specifier if nm is now in UNC format. */
1172 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1178 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1179 none are found, we can probably return right away. We will avoid
1180 allocating a new string if name is already fully expanded. */
1182 IS_DIRECTORY_SEP (nm
[0])
1184 && drive
&& !is_escaped
1187 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1194 /* If it turns out that the filename we want to return is just a
1195 suffix of FILENAME, we don't need to go through and edit
1196 things; we just need to construct a new string using data
1197 starting at the middle of FILENAME. If we set lose to a
1198 non-zero value, that means we've discovered that we can't do
1205 /* Since we know the name is absolute, we can assume that each
1206 element starts with a "/". */
1208 /* "." and ".." are hairy. */
1209 if (IS_DIRECTORY_SEP (p
[0])
1211 && (IS_DIRECTORY_SEP (p
[2])
1213 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1216 /* We want to replace multiple `/' in a row with a single
1219 && IS_DIRECTORY_SEP (p
[0])
1220 && IS_DIRECTORY_SEP (p
[1]))
1227 /* if dev:[dir]/, move nm to / */
1228 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1229 nm
= (brack
? brack
+ 1 : colon
+ 1);
1230 lbrack
= rbrack
= 0;
1237 #ifdef NO_HYPHENS_IN_FILENAMES
1238 if (lbrack
== rbrack
)
1240 /* Avoid clobbering negative version numbers. */
1245 #endif /* NO_HYPHENS_IN_FILENAMES */
1246 if (lbrack
> rbrack
&&
1247 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1248 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1250 #ifdef NO_HYPHENS_IN_FILENAMES
1253 #endif /* NO_HYPHENS_IN_FILENAMES */
1254 /* count open brackets, reset close bracket pointer */
1255 if (p
[0] == '[' || p
[0] == '<')
1256 lbrack
++, brack
= 0;
1257 /* count close brackets, set close bracket pointer */
1258 if (p
[0] == ']' || p
[0] == '>')
1259 rbrack
++, brack
= p
;
1260 /* detect ][ or >< */
1261 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1263 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1264 nm
= p
+ 1, lose
= 1;
1265 if (p
[0] == ':' && (colon
|| slash
))
1266 /* if dev1:[dir]dev2:, move nm to dev2: */
1272 /* if /name/dev:, move nm to dev: */
1275 /* if node::dev:, move colon following dev */
1276 else if (colon
&& colon
[-1] == ':')
1278 /* if dev1:dev2:, move nm to dev2: */
1279 else if (colon
&& colon
[-1] != ':')
1284 if (p
[0] == ':' && !colon
)
1290 if (lbrack
== rbrack
)
1293 else if (p
[0] == '.')
1301 if (index (nm
, '/'))
1303 nm
= sys_translate_unix (nm
);
1304 return make_specified_string (nm
, -1, strlen (nm
),
1305 STRING_MULTIBYTE (name
));
1309 /* Make sure directories are all separated with / or \ as
1310 desired, but avoid allocation of a new string when not
1312 CORRECT_DIR_SEPS (nm
);
1314 if (IS_DIRECTORY_SEP (nm
[1]))
1316 if (strcmp (nm
, SDATA (name
)) != 0)
1317 name
= make_specified_string (nm
, -1, strlen (nm
),
1318 STRING_MULTIBYTE (name
));
1322 /* drive must be set, so this is okay */
1323 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1327 name
= make_specified_string (nm
, -1, p
- nm
,
1328 STRING_MULTIBYTE (name
));
1329 temp
[0] = DRIVE_LETTER (drive
);
1330 name
= concat2 (build_string (temp
), name
);
1333 #else /* not DOS_NT */
1334 if (nm
== SDATA (name
))
1336 return make_specified_string (nm
, -1, strlen (nm
),
1337 STRING_MULTIBYTE (name
));
1338 #endif /* not DOS_NT */
1342 /* At this point, nm might or might not be an absolute file name. We
1343 need to expand ~ or ~user if present, otherwise prefix nm with
1344 default_directory if nm is not absolute, and finally collapse /./
1345 and /foo/../ sequences.
1347 We set newdir to be the appropriate prefix if one is needed:
1348 - the relevant user directory if nm starts with ~ or ~user
1349 - the specified drive's working dir (DOS/NT only) if nm does not
1351 - the value of default_directory.
1353 Note that these prefixes are not guaranteed to be absolute (except
1354 for the working dir of a drive). Therefore, to ensure we always
1355 return an absolute name, if the final prefix is not absolute we
1356 append it to the current working directory. */
1360 if (nm
[0] == '~') /* prefix ~ */
1362 if (IS_DIRECTORY_SEP (nm
[1])
1366 || nm
[1] == 0) /* ~ by itself */
1368 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1369 newdir
= (unsigned char *) "";
1372 collapse_newdir
= 0;
1375 nm
++; /* Don't leave the slash in nm. */
1378 else /* ~user/filename */
1380 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1385 o
= (unsigned char *) alloca (p
- nm
+ 1);
1386 bcopy ((char *) nm
, o
, p
- nm
);
1389 pw
= (struct passwd
*) getpwnam (o
+ 1);
1392 newdir
= (unsigned char *) pw
-> pw_dir
;
1394 nm
= p
+ 1; /* skip the terminator */
1398 collapse_newdir
= 0;
1403 /* If we don't find a user of that name, leave the name
1404 unchanged; don't move nm forward to p. */
1409 /* On DOS and Windows, nm is absolute if a drive name was specified;
1410 use the drive's current directory as the prefix if needed. */
1411 if (!newdir
&& drive
)
1413 /* Get default directory if needed to make nm absolute. */
1414 if (!IS_DIRECTORY_SEP (nm
[0]))
1416 newdir
= alloca (MAXPATHLEN
+ 1);
1417 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1422 /* Either nm starts with /, or drive isn't mounted. */
1423 newdir
= alloca (4);
1424 newdir
[0] = DRIVE_LETTER (drive
);
1432 /* Finally, if no prefix has been specified and nm is not absolute,
1433 then it must be expanded relative to default_directory. */
1437 /* /... alone is not absolute on DOS and Windows. */
1438 && !IS_DIRECTORY_SEP (nm
[0])
1441 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1448 newdir
= SDATA (default_directory
);
1450 /* Note if special escape prefix is present, but remove for now. */
1451 if (newdir
[0] == '/' && newdir
[1] == ':')
1462 /* First ensure newdir is an absolute name. */
1464 /* Detect MSDOS file names with drive specifiers. */
1465 ! (IS_DRIVE (newdir
[0])
1466 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1468 /* Detect Windows file names in UNC format. */
1469 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1473 /* Effectively, let newdir be (expand-file-name newdir cwd).
1474 Because of the admonition against calling expand-file-name
1475 when we have pointers into lisp strings, we accomplish this
1476 indirectly by prepending newdir to nm if necessary, and using
1477 cwd (or the wd of newdir's drive) as the new newdir. */
1479 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1484 if (!IS_DIRECTORY_SEP (nm
[0]))
1486 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1487 file_name_as_directory (tmp
, newdir
);
1491 newdir
= alloca (MAXPATHLEN
+ 1);
1494 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1501 /* Strip off drive name from prefix, if present. */
1502 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1508 /* Keep only a prefix from newdir if nm starts with slash
1509 (//server/share for UNC, nothing otherwise). */
1510 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1513 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1515 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1517 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1519 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1531 /* Get rid of any slash at the end of newdir, unless newdir is
1532 just / or // (an incomplete UNC name). */
1533 length
= strlen (newdir
);
1534 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1536 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1540 unsigned char *temp
= (unsigned char *) alloca (length
);
1541 bcopy (newdir
, temp
, length
- 1);
1542 temp
[length
- 1] = 0;
1550 /* Now concatenate the directory and name to new space in the stack frame */
1551 tlen
+= strlen (nm
) + 1;
1553 /* Reserve space for drive specifier and escape prefix, since either
1554 or both may need to be inserted. (The Microsoft x86 compiler
1555 produces incorrect code if the following two lines are combined.) */
1556 target
= (unsigned char *) alloca (tlen
+ 4);
1558 #else /* not DOS_NT */
1559 target
= (unsigned char *) alloca (tlen
);
1560 #endif /* not DOS_NT */
1566 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1569 /* If newdir is effectively "C:/", then the drive letter will have
1570 been stripped and newdir will be "/". Concatenating with an
1571 absolute directory in nm produces "//", which will then be
1572 incorrectly treated as a network share. Ignore newdir in
1573 this case (keeping the drive letter). */
1574 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1575 && newdir
[1] == '\0'))
1577 strcpy (target
, newdir
);
1581 file_name_as_directory (target
, newdir
);
1584 strcat (target
, nm
);
1586 if (index (target
, '/'))
1587 strcpy (target
, sys_translate_unix (target
));
1590 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1592 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1601 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1607 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1608 /* brackets are offset from each other by 2 */
1611 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1612 /* convert [foo][bar] to [bar] */
1613 while (o
[-1] != '[' && o
[-1] != '<')
1615 else if (*p
== '-' && *o
!= '.')
1618 else if (p
[0] == '-' && o
[-1] == '.' &&
1619 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1620 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1624 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1625 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1627 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1629 /* else [foo.-] ==> [-] */
1633 #ifdef NO_HYPHENS_IN_FILENAMES
1635 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1636 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1638 #endif /* NO_HYPHENS_IN_FILENAMES */
1642 if (!IS_DIRECTORY_SEP (*p
))
1646 else if (IS_DIRECTORY_SEP (p
[0])
1648 && (IS_DIRECTORY_SEP (p
[2])
1651 /* If "/." is the entire filename, keep the "/". Otherwise,
1652 just delete the whole "/.". */
1653 if (o
== target
&& p
[2] == '\0')
1657 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1658 /* `/../' is the "superroot" on certain file systems.
1659 Turned off on DOS_NT systems because they have no
1660 "superroot" and because this causes us to produce
1661 file names like "d:/../foo" which fail file-related
1662 functions of the underlying OS. (To reproduce, try a
1663 long series of "../../" in default_directory, longer
1664 than the number of levels from the root.) */
1668 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1670 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1672 /* Keep initial / only if this is the whole name. */
1673 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1678 && IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1]))
1680 /* Collapse multiple `/' in a row. */
1682 while (IS_DIRECTORY_SEP (*p
))
1689 #endif /* not VMS */
1693 /* At last, set drive name. */
1695 /* Except for network file name. */
1696 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1697 #endif /* WINDOWSNT */
1699 if (!drive
) abort ();
1701 target
[0] = DRIVE_LETTER (drive
);
1704 /* Reinsert the escape prefix if required. */
1711 CORRECT_DIR_SEPS (target
);
1714 result
= make_specified_string (target
, -1, o
- target
,
1715 STRING_MULTIBYTE (name
));
1717 /* Again look to see if the file name has special constructs in it
1718 and perhaps call the corresponding file handler. This is needed
1719 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1720 the ".." component gives us "/user@host:/bar/../baz" which needs
1721 to be expanded again. */
1722 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1723 if (!NILP (handler
))
1724 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1730 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1731 This is the old version of expand-file-name, before it was thoroughly
1732 rewritten for Emacs 10.31. We leave this version here commented-out,
1733 because the code is very complex and likely to have subtle bugs. If
1734 bugs _are_ found, it might be of interest to look at the old code and
1735 see what did it do in the relevant situation.
1737 Don't remove this code: it's true that it will be accessible via CVS,
1738 but a few years from deletion, people will forget it is there. */
1740 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1741 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1742 "Convert FILENAME to absolute, and canonicalize it.\n\
1743 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1744 \(does not start with slash); if DEFAULT is nil or missing,\n\
1745 the current buffer's value of default-directory is used.\n\
1746 Filenames containing `.' or `..' as components are simplified;\n\
1747 initial `~/' expands to your home directory.\n\
1748 See also the function `substitute-in-file-name'.")
1750 Lisp_Object name
, defalt
;
1754 register unsigned char *newdir
, *p
, *o
;
1756 unsigned char *target
;
1760 unsigned char * colon
= 0;
1761 unsigned char * close
= 0;
1762 unsigned char * slash
= 0;
1763 unsigned char * brack
= 0;
1764 int lbrack
= 0, rbrack
= 0;
1768 CHECK_STRING (name
);
1771 /* Filenames on VMS are always upper case. */
1772 name
= Fupcase (name
);
1777 /* If nm is absolute, flush ...// and detect /./ and /../.
1778 If no /./ or /../ we can return right away. */
1790 if (p
[0] == '/' && p
[1] == '/'
1792 /* // at start of filename is meaningful on Apollo system. */
1797 if (p
[0] == '/' && p
[1] == '~')
1798 nm
= p
+ 1, lose
= 1;
1799 if (p
[0] == '/' && p
[1] == '.'
1800 && (p
[2] == '/' || p
[2] == 0
1801 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1807 /* if dev:[dir]/, move nm to / */
1808 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1809 nm
= (brack
? brack
+ 1 : colon
+ 1);
1810 lbrack
= rbrack
= 0;
1818 /* VMS pre V4.4,convert '-'s in filenames. */
1819 if (lbrack
== rbrack
)
1821 if (dots
< 2) /* this is to allow negative version numbers */
1826 if (lbrack
> rbrack
&&
1827 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1828 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1834 /* count open brackets, reset close bracket pointer */
1835 if (p
[0] == '[' || p
[0] == '<')
1836 lbrack
++, brack
= 0;
1837 /* count close brackets, set close bracket pointer */
1838 if (p
[0] == ']' || p
[0] == '>')
1839 rbrack
++, brack
= p
;
1840 /* detect ][ or >< */
1841 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1843 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1844 nm
= p
+ 1, lose
= 1;
1845 if (p
[0] == ':' && (colon
|| slash
))
1846 /* if dev1:[dir]dev2:, move nm to dev2: */
1852 /* If /name/dev:, move nm to dev: */
1855 /* If node::dev:, move colon following dev */
1856 else if (colon
&& colon
[-1] == ':')
1858 /* If dev1:dev2:, move nm to dev2: */
1859 else if (colon
&& colon
[-1] != ':')
1864 if (p
[0] == ':' && !colon
)
1870 if (lbrack
== rbrack
)
1873 else if (p
[0] == '.')
1881 if (index (nm
, '/'))
1882 return build_string (sys_translate_unix (nm
));
1884 if (nm
== SDATA (name
))
1886 return build_string (nm
);
1890 /* Now determine directory to start with and put it in NEWDIR */
1894 if (nm
[0] == '~') /* prefix ~ */
1899 || nm
[1] == 0)/* ~/filename */
1901 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1902 newdir
= (unsigned char *) "";
1905 nm
++; /* Don't leave the slash in nm. */
1908 else /* ~user/filename */
1910 /* Get past ~ to user */
1911 unsigned char *user
= nm
+ 1;
1912 /* Find end of name. */
1913 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1914 int len
= ptr
? ptr
- user
: strlen (user
);
1916 unsigned char *ptr1
= index (user
, ':');
1917 if (ptr1
!= 0 && ptr1
- user
< len
)
1920 /* Copy the user name into temp storage. */
1921 o
= (unsigned char *) alloca (len
+ 1);
1922 bcopy ((char *) user
, o
, len
);
1925 /* Look up the user name. */
1926 pw
= (struct passwd
*) getpwnam (o
+ 1);
1928 error ("\"%s\" isn't a registered user", o
+ 1);
1930 newdir
= (unsigned char *) pw
->pw_dir
;
1932 /* Discard the user name from NM. */
1939 #endif /* not VMS */
1943 defalt
= current_buffer
->directory
;
1944 CHECK_STRING (defalt
);
1945 newdir
= SDATA (defalt
);
1948 /* Now concatenate the directory and name to new space in the stack frame */
1950 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1951 target
= (unsigned char *) alloca (tlen
);
1957 if (nm
[0] == 0 || nm
[0] == '/')
1958 strcpy (target
, newdir
);
1961 file_name_as_directory (target
, newdir
);
1964 strcat (target
, nm
);
1966 if (index (target
, '/'))
1967 strcpy (target
, sys_translate_unix (target
));
1970 /* Now canonicalize by removing /. and /foo/.. if they appear */
1978 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1984 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1985 /* brackets are offset from each other by 2 */
1988 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1989 /* convert [foo][bar] to [bar] */
1990 while (o
[-1] != '[' && o
[-1] != '<')
1992 else if (*p
== '-' && *o
!= '.')
1995 else if (p
[0] == '-' && o
[-1] == '.' &&
1996 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1997 /* flush .foo.- ; leave - if stopped by '[' or '<' */
2001 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
2002 if (p
[1] == '.') /* foo.-.bar ==> bar. */
2004 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
2006 /* else [foo.-] ==> [-] */
2012 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
2013 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2023 else if (!strncmp (p
, "//", 2)
2025 /* // at start of filename is meaningful in Apollo system. */
2033 else if (p
[0] == '/' && p
[1] == '.' &&
2034 (p
[2] == '/' || p
[2] == 0))
2036 else if (!strncmp (p
, "/..", 3)
2037 /* `/../' is the "superroot" on certain file systems. */
2039 && (p
[3] == '/' || p
[3] == 0))
2041 while (o
!= target
&& *--o
!= '/')
2044 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2048 if (o
== target
&& *o
== '/')
2056 #endif /* not VMS */
2059 return make_string (target
, o
- target
);
2063 /* If /~ or // appears, discard everything through first slash. */
2065 file_name_absolute_p (filename
)
2066 const unsigned char *filename
;
2069 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
2071 /* ??? This criterion is probably wrong for '<'. */
2072 || index (filename
, ':') || index (filename
, '<')
2073 || (*filename
== '[' && (filename
[1] != '-'
2074 || (filename
[2] != '.' && filename
[2] != ']'))
2075 && filename
[1] != '.')
2078 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
2079 && IS_DIRECTORY_SEP (filename
[2]))
2084 static unsigned char *
2085 search_embedded_absfilename (nm
, endp
)
2086 unsigned char *nm
, *endp
;
2088 unsigned char *p
, *s
;
2090 for (p
= nm
+ 1; p
< endp
; p
++)
2094 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2096 || IS_DIRECTORY_SEP (p
[-1]))
2097 && file_name_absolute_p (p
)
2098 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2099 /* // at start of file name is meaningful in Apollo,
2100 WindowsNT and Cygwin systems. */
2101 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
2102 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2105 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2110 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2112 unsigned char *o
= alloca (s
- p
+ 1);
2114 bcopy (p
, o
, s
- p
);
2117 /* If we have ~user and `user' exists, discard
2118 everything up to ~. But if `user' does not exist, leave
2119 ~user alone, it might be a literal file name. */
2120 if ((pw
= getpwnam (o
+ 1)))
2132 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2133 Ssubstitute_in_file_name
, 1, 1, 0,
2134 doc
: /* Substitute environment variables referred to in FILENAME.
2135 `$FOO' where FOO is an environment variable name means to substitute
2136 the value of that variable. The variable name should be terminated
2137 with a character not a letter, digit or underscore; otherwise, enclose
2138 the entire variable name in braces.
2139 If `/~' appears, all of FILENAME through that `/' is discarded.
2141 On VMS, `$' substitution is not done; this function does little and only
2142 duplicates what `expand-file-name' does. */)
2144 Lisp_Object filename
;
2148 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2149 unsigned char *target
= NULL
;
2151 int substituted
= 0;
2153 Lisp_Object handler
;
2155 CHECK_STRING (filename
);
2157 /* If the file name has special constructs in it,
2158 call the corresponding file handler. */
2159 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2160 if (!NILP (handler
))
2161 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2163 nm
= SDATA (filename
);
2165 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2166 CORRECT_DIR_SEPS (nm
);
2167 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2169 endp
= nm
+ SBYTES (filename
);
2171 /* If /~ or // appears, discard everything through first slash. */
2172 p
= search_embedded_absfilename (nm
, endp
);
2174 /* Start over with the new string, so we check the file-name-handler
2175 again. Important with filenames like "/home/foo//:/hello///there"
2176 which whould substitute to "/:/hello///there" rather than "/there". */
2177 return Fsubstitute_in_file_name
2178 (make_specified_string (p
, -1, endp
- p
,
2179 STRING_MULTIBYTE (filename
)));
2185 /* See if any variables are substituted into the string
2186 and find the total length of their values in `total' */
2188 for (p
= nm
; p
!= endp
;)
2198 /* "$$" means a single "$" */
2207 while (p
!= endp
&& *p
!= '}') p
++;
2208 if (*p
!= '}') goto missingclose
;
2214 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2218 /* Copy out the variable name */
2219 target
= (unsigned char *) alloca (s
- o
+ 1);
2220 strncpy (target
, o
, s
- o
);
2223 strupr (target
); /* $home == $HOME etc. */
2226 /* Get variable value */
2227 o
= (unsigned char *) egetenv (target
);
2230 total
+= strlen (o
);
2240 /* If substitution required, recopy the string and do it */
2241 /* Make space in stack frame for the new copy */
2242 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2245 /* Copy the rest of the name through, replacing $ constructs with values */
2262 while (p
!= endp
&& *p
!= '}') p
++;
2263 if (*p
!= '}') goto missingclose
;
2269 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2273 /* Copy out the variable name */
2274 target
= (unsigned char *) alloca (s
- o
+ 1);
2275 strncpy (target
, o
, s
- o
);
2278 strupr (target
); /* $home == $HOME etc. */
2281 /* Get variable value */
2282 o
= (unsigned char *) egetenv (target
);
2286 strcpy (x
, target
); x
+= strlen (target
);
2288 else if (STRING_MULTIBYTE (filename
))
2290 /* If the original string is multibyte,
2291 convert what we substitute into multibyte. */
2295 c
= unibyte_char_to_multibyte (c
);
2296 x
+= CHAR_STRING (c
, x
);
2308 /* If /~ or // appears, discard everything through first slash. */
2309 while ((p
= search_embedded_absfilename (xnm
, x
)))
2310 /* This time we do not start over because we've already expanded envvars
2311 and replaced $$ with $. Maybe we should start over as well, but we'd
2312 need to quote some $ to $$ first. */
2315 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2318 error ("Bad format environment-variable substitution");
2320 error ("Missing \"}\" in environment-variable substitution");
2322 error ("Substituting nonexistent environment variable \"%s\"", target
);
2325 #endif /* not VMS */
2329 /* A slightly faster and more convenient way to get
2330 (directory-file-name (expand-file-name FOO)). */
2333 expand_and_dir_to_file (filename
, defdir
)
2334 Lisp_Object filename
, defdir
;
2336 register Lisp_Object absname
;
2338 absname
= Fexpand_file_name (filename
, defdir
);
2341 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2342 if (c
== ':' || c
== ']' || c
== '>')
2343 absname
= Fdirectory_file_name (absname
);
2346 /* Remove final slash, if any (unless this is the root dir).
2347 stat behaves differently depending! */
2348 if (SCHARS (absname
) > 1
2349 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2350 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2351 /* We cannot take shortcuts; they might be wrong for magic file names. */
2352 absname
= Fdirectory_file_name (absname
);
2357 /* Signal an error if the file ABSNAME already exists.
2358 If INTERACTIVE is nonzero, ask the user whether to proceed,
2359 and bypass the error if the user says to go ahead.
2360 QUERYSTRING is a name for the action that is being considered
2363 *STATPTR is used to store the stat information if the file exists.
2364 If the file does not exist, STATPTR->st_mode is set to 0.
2365 If STATPTR is null, we don't store into it.
2367 If QUICK is nonzero, we ask for y or n, not yes or no. */
2370 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2371 Lisp_Object absname
;
2372 unsigned char *querystring
;
2374 struct stat
*statptr
;
2377 register Lisp_Object tem
, encoded_filename
;
2378 struct stat statbuf
;
2379 struct gcpro gcpro1
;
2381 encoded_filename
= ENCODE_FILE (absname
);
2383 /* stat is a good way to tell whether the file exists,
2384 regardless of what access permissions it has. */
2385 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
2388 Fsignal (Qfile_already_exists
,
2389 Fcons (build_string ("File already exists"),
2390 Fcons (absname
, Qnil
)));
2392 tem
= format2 ("File %s already exists; %s anyway? ",
2393 absname
, build_string (querystring
));
2395 tem
= Fy_or_n_p (tem
);
2397 tem
= do_yes_or_no_p (tem
);
2400 Fsignal (Qfile_already_exists
,
2401 Fcons (build_string ("File already exists"),
2402 Fcons (absname
, Qnil
)));
2409 statptr
->st_mode
= 0;
2414 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 5,
2415 "fCopy file: \nGCopy %s to file: \np\nP",
2416 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2417 If NEWNAME names a directory, copy FILE there.
2418 Signals a `file-already-exists' error if file NEWNAME already exists,
2419 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
2420 A number as third arg means request confirmation if NEWNAME already exists.
2421 This is what happens in interactive use with M-x.
2422 Always sets the file modes of the output file to match the input file.
2424 Fourth arg KEEP-TIME non-nil means give the output file the same
2425 last-modified time as the old one. (This works on only some systems.)
2427 A prefix arg makes KEEP-TIME non-nil.
2429 The optional fifth arg MUSTBENEW, if non-nil, insists on a check
2430 for an existing file with the same name. If MUSTBENEW is `excl',
2431 that means to get an error if the file already exists; never overwrite.
2432 If MUSTBENEW is neither nil nor `excl', that means ask for
2433 confirmation before overwriting, but do go ahead and overwrite the file
2434 if the user confirms. */)
2435 (file
, newname
, ok_if_already_exists
, keep_time
, mustbenew
)
2436 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
, mustbenew
;
2439 char buf
[16 * 1024];
2440 struct stat st
, out_st
;
2441 Lisp_Object handler
;
2442 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2443 int count
= SPECPDL_INDEX ();
2444 int input_file_statable_p
;
2445 Lisp_Object encoded_file
, encoded_newname
;
2447 encoded_file
= encoded_newname
= Qnil
;
2448 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2449 CHECK_STRING (file
);
2450 CHECK_STRING (newname
);
2452 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
2453 barf_or_query_if_file_exists (newname
, "overwrite", 1, 0, 1);
2455 if (!NILP (Ffile_directory_p (newname
)))
2456 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2458 newname
= Fexpand_file_name (newname
, Qnil
);
2460 file
= Fexpand_file_name (file
, Qnil
);
2462 /* If the input file name has special constructs in it,
2463 call the corresponding file handler. */
2464 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2465 /* Likewise for output file name. */
2467 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2468 if (!NILP (handler
))
2469 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2470 ok_if_already_exists
, keep_time
));
2472 encoded_file
= ENCODE_FILE (file
);
2473 encoded_newname
= ENCODE_FILE (newname
);
2475 if (NILP (ok_if_already_exists
)
2476 || INTEGERP (ok_if_already_exists
))
2477 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2478 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2479 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2483 if (!CopyFile (SDATA (encoded_file
),
2484 SDATA (encoded_newname
),
2486 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2487 /* CopyFile retains the timestamp by default. */
2488 else if (NILP (keep_time
))
2494 EMACS_GET_TIME (now
);
2495 filename
= SDATA (encoded_newname
);
2497 /* Ensure file is writable while its modified time is set. */
2498 attributes
= GetFileAttributes (filename
);
2499 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2500 if (set_file_times (filename
, now
, now
))
2502 /* Restore original attributes. */
2503 SetFileAttributes (filename
, attributes
);
2504 Fsignal (Qfile_date_error
,
2505 Fcons (build_string ("Cannot set file date"),
2506 Fcons (newname
, Qnil
)));
2508 /* Restore original attributes. */
2509 SetFileAttributes (filename
, attributes
);
2511 #else /* not WINDOWSNT */
2513 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2517 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2519 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2521 /* We can only copy regular files and symbolic links. Other files are not
2523 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2525 #if !defined (DOS_NT) || __DJGPP__ > 1
2526 if (out_st
.st_mode
!= 0
2527 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2530 report_file_error ("Input and output files are the same",
2531 Fcons (file
, Fcons (newname
, Qnil
)));
2535 #if defined (S_ISREG) && defined (S_ISLNK)
2536 if (input_file_statable_p
)
2538 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2540 #if defined (EISDIR)
2541 /* Get a better looking error message. */
2544 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2547 #endif /* S_ISREG && S_ISLNK */
2550 /* Create the copy file with the same record format as the input file */
2551 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2554 /* System's default file type was set to binary by _fmode in emacs.c. */
2555 ofd
= emacs_open (SDATA (encoded_newname
),
2556 O_WRONLY
| O_TRUNC
| O_CREAT
2557 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
2558 S_IREAD
| S_IWRITE
);
2559 #else /* not MSDOS */
2560 ofd
= emacs_open (SDATA (encoded_newname
),
2561 O_WRONLY
| O_TRUNC
| O_CREAT
2562 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
2564 #endif /* not MSDOS */
2567 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2569 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2573 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2574 if (emacs_write (ofd
, buf
, n
) != n
)
2575 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2578 /* Closing the output clobbers the file times on some systems. */
2579 if (emacs_close (ofd
) < 0)
2580 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2582 if (input_file_statable_p
)
2584 if (!NILP (keep_time
))
2586 EMACS_TIME atime
, mtime
;
2587 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2588 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2589 if (set_file_times (SDATA (encoded_newname
),
2591 Fsignal (Qfile_date_error
,
2592 Fcons (build_string ("Cannot set file date"),
2593 Fcons (newname
, Qnil
)));
2596 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2598 #if defined (__DJGPP__) && __DJGPP__ > 1
2599 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2600 and if it can't, it tells so. Otherwise, under MSDOS we usually
2601 get only the READ bit, which will make the copied file read-only,
2602 so it's better not to chmod at all. */
2603 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2604 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2605 #endif /* DJGPP version 2 or newer */
2610 #endif /* WINDOWSNT */
2612 /* Discard the unwind protects. */
2613 specpdl_ptr
= specpdl
+ count
;
2619 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2620 Smake_directory_internal
, 1, 1, 0,
2621 doc
: /* Create a new directory named DIRECTORY. */)
2623 Lisp_Object directory
;
2625 const unsigned char *dir
;
2626 Lisp_Object handler
;
2627 Lisp_Object encoded_dir
;
2629 CHECK_STRING (directory
);
2630 directory
= Fexpand_file_name (directory
, Qnil
);
2632 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2633 if (!NILP (handler
))
2634 return call2 (handler
, Qmake_directory_internal
, directory
);
2636 encoded_dir
= ENCODE_FILE (directory
);
2638 dir
= SDATA (encoded_dir
);
2641 if (mkdir (dir
) != 0)
2643 if (mkdir (dir
, 0777) != 0)
2645 report_file_error ("Creating directory", Flist (1, &directory
));
2650 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2651 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2653 Lisp_Object directory
;
2655 const unsigned char *dir
;
2656 Lisp_Object handler
;
2657 Lisp_Object encoded_dir
;
2659 CHECK_STRING (directory
);
2660 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2662 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2663 if (!NILP (handler
))
2664 return call2 (handler
, Qdelete_directory
, directory
);
2666 encoded_dir
= ENCODE_FILE (directory
);
2668 dir
= SDATA (encoded_dir
);
2670 if (rmdir (dir
) != 0)
2671 report_file_error ("Removing directory", Flist (1, &directory
));
2676 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2677 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2678 If file has multiple names, it continues to exist with the other names. */)
2680 Lisp_Object filename
;
2682 Lisp_Object handler
;
2683 Lisp_Object encoded_file
;
2684 struct gcpro gcpro1
;
2687 if (!NILP (Ffile_directory_p (filename
))
2688 && NILP (Ffile_symlink_p (filename
)))
2689 Fsignal (Qfile_error
,
2690 Fcons (build_string ("Removing old name: is a directory"),
2691 Fcons (filename
, Qnil
)));
2693 filename
= Fexpand_file_name (filename
, Qnil
);
2695 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2696 if (!NILP (handler
))
2697 return call2 (handler
, Qdelete_file
, filename
);
2699 encoded_file
= ENCODE_FILE (filename
);
2701 if (0 > unlink (SDATA (encoded_file
)))
2702 report_file_error ("Removing old name", Flist (1, &filename
));
2707 internal_delete_file_1 (ignore
)
2713 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2716 internal_delete_file (filename
)
2717 Lisp_Object filename
;
2719 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2720 Qt
, internal_delete_file_1
));
2723 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2724 "fRename file: \nGRename %s to file: \np",
2725 doc
: /* Rename FILE as NEWNAME. Both args must be strings.
2726 If file has names other than FILE, it continues to have those names.
2727 Signals a `file-already-exists' error if a file NEWNAME already exists
2728 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2729 A number as third arg means request confirmation if NEWNAME already exists.
2730 This is what happens in interactive use with M-x. */)
2731 (file
, newname
, ok_if_already_exists
)
2732 Lisp_Object file
, newname
, ok_if_already_exists
;
2735 Lisp_Object args
[2];
2737 Lisp_Object handler
;
2738 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2739 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2741 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2742 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2743 CHECK_STRING (file
);
2744 CHECK_STRING (newname
);
2745 file
= Fexpand_file_name (file
, Qnil
);
2747 if (!NILP (Ffile_directory_p (newname
)))
2748 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2750 newname
= Fexpand_file_name (newname
, Qnil
);
2752 /* If the file name has special constructs in it,
2753 call the corresponding file handler. */
2754 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2756 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2757 if (!NILP (handler
))
2758 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2759 file
, newname
, ok_if_already_exists
));
2761 encoded_file
= ENCODE_FILE (file
);
2762 encoded_newname
= ENCODE_FILE (newname
);
2765 /* If the file names are identical but for the case, don't ask for
2766 confirmation: they simply want to change the letter-case of the
2768 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2770 if (NILP (ok_if_already_exists
)
2771 || INTEGERP (ok_if_already_exists
))
2772 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2773 INTEGERP (ok_if_already_exists
), 0, 0);
2775 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2777 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2778 || 0 > unlink (SDATA (encoded_file
)))
2785 symlink_target
= Ffile_symlink_p (file
);
2786 if (! NILP (symlink_target
))
2787 Fmake_symbolic_link (symlink_target
, newname
,
2788 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2791 Fcopy_file (file
, newname
,
2792 /* We have already prompted if it was an integer,
2793 so don't have copy-file prompt again. */
2794 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2797 /* Preserve owner and group, if possible (if we are root). */
2798 if (stat (SDATA (encoded_file
), &data
) >= 0)
2799 chown (SDATA (encoded_file
), data
.st_uid
, data
.st_gid
);
2801 Fdelete_file (file
);
2808 report_file_error ("Renaming", Flist (2, args
));
2811 report_file_error ("Renaming", Flist (2, &file
));
2818 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2819 "fAdd name to file: \nGName to add to %s: \np",
2820 doc
: /* Give FILE additional name NEWNAME. Both args must be strings.
2821 Signals a `file-already-exists' error if a file NEWNAME already exists
2822 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2823 A number as third arg means request confirmation if NEWNAME already exists.
2824 This is what happens in interactive use with M-x. */)
2825 (file
, newname
, ok_if_already_exists
)
2826 Lisp_Object file
, newname
, ok_if_already_exists
;
2829 Lisp_Object args
[2];
2831 Lisp_Object handler
;
2832 Lisp_Object encoded_file
, encoded_newname
;
2833 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2835 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2836 encoded_file
= encoded_newname
= Qnil
;
2837 CHECK_STRING (file
);
2838 CHECK_STRING (newname
);
2839 file
= Fexpand_file_name (file
, Qnil
);
2841 if (!NILP (Ffile_directory_p (newname
)))
2842 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2844 newname
= Fexpand_file_name (newname
, Qnil
);
2846 /* If the file name has special constructs in it,
2847 call the corresponding file handler. */
2848 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2849 if (!NILP (handler
))
2850 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2851 newname
, ok_if_already_exists
));
2853 /* If the new name has special constructs in it,
2854 call the corresponding file handler. */
2855 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2856 if (!NILP (handler
))
2857 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2858 newname
, ok_if_already_exists
));
2860 encoded_file
= ENCODE_FILE (file
);
2861 encoded_newname
= ENCODE_FILE (newname
);
2863 if (NILP (ok_if_already_exists
)
2864 || INTEGERP (ok_if_already_exists
))
2865 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2866 INTEGERP (ok_if_already_exists
), 0, 0);
2868 unlink (SDATA (newname
));
2869 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2874 report_file_error ("Adding new name", Flist (2, args
));
2876 report_file_error ("Adding new name", Flist (2, &file
));
2885 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2886 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2887 doc
: /* Make a symbolic link to FILENAME, named LINKNAME.
2888 Both args must be strings.
2889 Signals a `file-already-exists' error if a file LINKNAME already exists
2890 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2891 A number as third arg means request confirmation if LINKNAME already exists.
2892 This happens for interactive use with M-x. */)
2893 (filename
, linkname
, ok_if_already_exists
)
2894 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2897 Lisp_Object args
[2];
2899 Lisp_Object handler
;
2900 Lisp_Object encoded_filename
, encoded_linkname
;
2901 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2903 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2904 encoded_filename
= encoded_linkname
= Qnil
;
2905 CHECK_STRING (filename
);
2906 CHECK_STRING (linkname
);
2907 /* If the link target has a ~, we must expand it to get
2908 a truly valid file name. Otherwise, do not expand;
2909 we want to permit links to relative file names. */
2910 if (SREF (filename
, 0) == '~')
2911 filename
= Fexpand_file_name (filename
, Qnil
);
2913 if (!NILP (Ffile_directory_p (linkname
)))
2914 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2916 linkname
= Fexpand_file_name (linkname
, Qnil
);
2918 /* If the file name has special constructs in it,
2919 call the corresponding file handler. */
2920 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2921 if (!NILP (handler
))
2922 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2923 linkname
, ok_if_already_exists
));
2925 /* If the new link name has special constructs in it,
2926 call the corresponding file handler. */
2927 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2928 if (!NILP (handler
))
2929 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2930 linkname
, ok_if_already_exists
));
2932 encoded_filename
= ENCODE_FILE (filename
);
2933 encoded_linkname
= ENCODE_FILE (linkname
);
2935 if (NILP (ok_if_already_exists
)
2936 || INTEGERP (ok_if_already_exists
))
2937 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2938 INTEGERP (ok_if_already_exists
), 0, 0);
2939 if (0 > symlink (SDATA (encoded_filename
),
2940 SDATA (encoded_linkname
)))
2942 /* If we didn't complain already, silently delete existing file. */
2943 if (errno
== EEXIST
)
2945 unlink (SDATA (encoded_linkname
));
2946 if (0 <= symlink (SDATA (encoded_filename
),
2947 SDATA (encoded_linkname
)))
2957 report_file_error ("Making symbolic link", Flist (2, args
));
2959 report_file_error ("Making symbolic link", Flist (2, &filename
));
2965 #endif /* S_IFLNK */
2969 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2970 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2971 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2972 If STRING is nil or a null string, the logical name NAME is deleted. */)
2977 CHECK_STRING (name
);
2979 delete_logical_name (SDATA (name
));
2982 CHECK_STRING (string
);
2984 if (SCHARS (string
) == 0)
2985 delete_logical_name (SDATA (name
));
2987 define_logical_name (SDATA (name
), SDATA (string
));
2996 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2997 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2999 Lisp_Object path
, login
;
3003 CHECK_STRING (path
);
3004 CHECK_STRING (login
);
3006 netresult
= netunam (SDATA (path
), SDATA (login
));
3008 if (netresult
== -1)
3013 #endif /* HPUX_NET */
3015 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
3017 doc
: /* Return t if file FILENAME specifies an absolute file name.
3018 On Unix, this is a name starting with a `/' or a `~'. */)
3020 Lisp_Object filename
;
3022 CHECK_STRING (filename
);
3023 return file_name_absolute_p (SDATA (filename
)) ? Qt
: Qnil
;
3026 /* Return nonzero if file FILENAME exists and can be executed. */
3029 check_executable (filename
)
3033 int len
= strlen (filename
);
3036 if (stat (filename
, &st
) < 0)
3038 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
3039 return ((st
.st_mode
& S_IEXEC
) != 0);
3041 return (S_ISREG (st
.st_mode
)
3043 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
3044 || stricmp (suffix
, ".exe") == 0
3045 || stricmp (suffix
, ".bat") == 0)
3046 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3047 #endif /* not WINDOWSNT */
3048 #else /* not DOS_NT */
3049 #ifdef HAVE_EUIDACCESS
3050 return (euidaccess (filename
, 1) >= 0);
3052 /* Access isn't quite right because it uses the real uid
3053 and we really want to test with the effective uid.
3054 But Unix doesn't give us a right way to do it. */
3055 return (access (filename
, 1) >= 0);
3057 #endif /* not DOS_NT */
3060 /* Return nonzero if file FILENAME exists and can be written. */
3063 check_writable (filename
)
3068 if (stat (filename
, &st
) < 0)
3070 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3071 #else /* not MSDOS */
3072 #ifdef HAVE_EUIDACCESS
3073 return (euidaccess (filename
, 2) >= 0);
3075 /* Access isn't quite right because it uses the real uid
3076 and we really want to test with the effective uid.
3077 But Unix doesn't give us a right way to do it.
3078 Opening with O_WRONLY could work for an ordinary file,
3079 but would lose for directories. */
3080 return (access (filename
, 2) >= 0);
3082 #endif /* not MSDOS */
3085 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3086 doc
: /* Return t if file FILENAME exists (whether or not you can read it.)
3087 See also `file-readable-p' and `file-attributes'.
3088 This returns nil for a symlink to a nonexistent file.
3089 Use `file-symlink-p' to test for such links. */)
3091 Lisp_Object filename
;
3093 Lisp_Object absname
;
3094 Lisp_Object handler
;
3095 struct stat statbuf
;
3097 CHECK_STRING (filename
);
3098 absname
= Fexpand_file_name (filename
, Qnil
);
3100 /* If the file name has special constructs in it,
3101 call the corresponding file handler. */
3102 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3103 if (!NILP (handler
))
3104 return call2 (handler
, Qfile_exists_p
, absname
);
3106 absname
= ENCODE_FILE (absname
);
3108 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3111 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3112 doc
: /* Return t if FILENAME can be executed by you.
3113 For a directory, this means you can access files in that directory. */)
3115 Lisp_Object filename
;
3117 Lisp_Object absname
;
3118 Lisp_Object handler
;
3120 CHECK_STRING (filename
);
3121 absname
= Fexpand_file_name (filename
, Qnil
);
3123 /* If the file name has special constructs in it,
3124 call the corresponding file handler. */
3125 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3126 if (!NILP (handler
))
3127 return call2 (handler
, Qfile_executable_p
, absname
);
3129 absname
= ENCODE_FILE (absname
);
3131 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3134 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3135 doc
: /* Return t if file FILENAME exists and you can read it.
3136 See also `file-exists-p' and `file-attributes'. */)
3138 Lisp_Object filename
;
3140 Lisp_Object absname
;
3141 Lisp_Object handler
;
3144 struct stat statbuf
;
3146 CHECK_STRING (filename
);
3147 absname
= Fexpand_file_name (filename
, Qnil
);
3149 /* If the file name has special constructs in it,
3150 call the corresponding file handler. */
3151 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3152 if (!NILP (handler
))
3153 return call2 (handler
, Qfile_readable_p
, absname
);
3155 absname
= ENCODE_FILE (absname
);
3157 #if defined(DOS_NT) || defined(macintosh)
3158 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3160 if (access (SDATA (absname
), 0) == 0)
3163 #else /* not DOS_NT and not macintosh */
3165 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3166 /* Opening a fifo without O_NONBLOCK can wait.
3167 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3168 except in the case of a fifo, on a system which handles it. */
3169 desc
= stat (SDATA (absname
), &statbuf
);
3172 if (S_ISFIFO (statbuf
.st_mode
))
3173 flags
|= O_NONBLOCK
;
3175 desc
= emacs_open (SDATA (absname
), flags
, 0);
3180 #endif /* not DOS_NT and not macintosh */
3183 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3185 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3186 doc
: /* Return t if file FILENAME can be written or created by you. */)
3188 Lisp_Object filename
;
3190 Lisp_Object absname
, dir
, encoded
;
3191 Lisp_Object handler
;
3192 struct stat statbuf
;
3194 CHECK_STRING (filename
);
3195 absname
= Fexpand_file_name (filename
, Qnil
);
3197 /* If the file name has special constructs in it,
3198 call the corresponding file handler. */
3199 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3200 if (!NILP (handler
))
3201 return call2 (handler
, Qfile_writable_p
, absname
);
3203 encoded
= ENCODE_FILE (absname
);
3204 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3205 return (check_writable (SDATA (encoded
))
3208 dir
= Ffile_name_directory (absname
);
3211 dir
= Fdirectory_file_name (dir
);
3215 dir
= Fdirectory_file_name (dir
);
3218 dir
= ENCODE_FILE (dir
);
3220 /* The read-only attribute of the parent directory doesn't affect
3221 whether a file or directory can be created within it. Some day we
3222 should check ACLs though, which do affect this. */
3223 if (stat (SDATA (dir
), &statbuf
) < 0)
3225 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3227 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3232 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3233 doc
: /* Access file FILENAME, and get an error if that does not work.
3234 The second argument STRING is used in the error message.
3235 If there is no error, returns nil. */)
3237 Lisp_Object filename
, string
;
3239 Lisp_Object handler
, encoded_filename
, absname
;
3242 CHECK_STRING (filename
);
3243 absname
= Fexpand_file_name (filename
, Qnil
);
3245 CHECK_STRING (string
);
3247 /* If the file name has special constructs in it,
3248 call the corresponding file handler. */
3249 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3250 if (!NILP (handler
))
3251 return call3 (handler
, Qaccess_file
, absname
, string
);
3253 encoded_filename
= ENCODE_FILE (absname
);
3255 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3257 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3263 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3264 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3265 The value is the link target, as a string.
3266 Otherwise it returns nil.
3268 This function returns t when given the name of a symlink that
3269 points to a nonexistent file. */)
3271 Lisp_Object filename
;
3273 Lisp_Object handler
;
3275 CHECK_STRING (filename
);
3276 filename
= Fexpand_file_name (filename
, Qnil
);
3278 /* If the file name has special constructs in it,
3279 call the corresponding file handler. */
3280 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3281 if (!NILP (handler
))
3282 return call2 (handler
, Qfile_symlink_p
, filename
);
3291 filename
= ENCODE_FILE (filename
);
3298 buf
= (char *) xrealloc (buf
, bufsize
);
3299 bzero (buf
, bufsize
);
3302 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3306 /* HP-UX reports ERANGE if buffer is too small. */
3307 if (errno
== ERANGE
)
3317 while (valsize
>= bufsize
);
3319 val
= make_string (buf
, valsize
);
3320 if (buf
[0] == '/' && index (buf
, ':'))
3321 val
= concat2 (build_string ("/:"), val
);
3323 val
= DECODE_FILE (val
);
3326 #else /* not S_IFLNK */
3328 #endif /* not S_IFLNK */
3331 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3332 doc
: /* Return t if FILENAME names an existing directory.
3333 Symbolic links to directories count as directories.
3334 See `file-symlink-p' to distinguish symlinks. */)
3336 Lisp_Object filename
;
3338 register Lisp_Object absname
;
3340 Lisp_Object handler
;
3342 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3344 /* If the file name has special constructs in it,
3345 call the corresponding file handler. */
3346 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3347 if (!NILP (handler
))
3348 return call2 (handler
, Qfile_directory_p
, absname
);
3350 absname
= ENCODE_FILE (absname
);
3352 if (stat (SDATA (absname
), &st
) < 0)
3354 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3357 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3358 doc
: /* Return t if file FILENAME names a directory you can open.
3359 For the value to be t, FILENAME must specify the name of a directory as a file,
3360 and the directory must allow you to open files in it. In order to use a
3361 directory as a buffer's current directory, this predicate must return true.
3362 A directory name spec may be given instead; then the value is t
3363 if the directory so specified exists and really is a readable and
3364 searchable directory. */)
3366 Lisp_Object filename
;
3368 Lisp_Object handler
;
3370 struct gcpro gcpro1
;
3372 /* If the file name has special constructs in it,
3373 call the corresponding file handler. */
3374 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3375 if (!NILP (handler
))
3376 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3379 tem
= (NILP (Ffile_directory_p (filename
))
3380 || NILP (Ffile_executable_p (filename
)));
3382 return tem
? Qnil
: Qt
;
3385 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3386 doc
: /* Return t if file FILENAME is the name of a regular file.
3387 This is the sort of file that holds an ordinary stream of data bytes. */)
3389 Lisp_Object filename
;
3391 register Lisp_Object absname
;
3393 Lisp_Object handler
;
3395 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3397 /* If the file name has special constructs in it,
3398 call the corresponding file handler. */
3399 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3400 if (!NILP (handler
))
3401 return call2 (handler
, Qfile_regular_p
, absname
);
3403 absname
= ENCODE_FILE (absname
);
3408 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3410 /* Tell stat to use expensive method to get accurate info. */
3411 Vw32_get_true_file_attributes
= Qt
;
3412 result
= stat (SDATA (absname
), &st
);
3413 Vw32_get_true_file_attributes
= tem
;
3417 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3420 if (stat (SDATA (absname
), &st
) < 0)
3422 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3426 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3427 doc
: /* Return mode bits of file named FILENAME, as an integer.
3428 Return nil, if file does not exist or is not accessible. */)
3430 Lisp_Object filename
;
3432 Lisp_Object absname
;
3434 Lisp_Object handler
;
3436 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3438 /* If the file name has special constructs in it,
3439 call the corresponding file handler. */
3440 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3441 if (!NILP (handler
))
3442 return call2 (handler
, Qfile_modes
, absname
);
3444 absname
= ENCODE_FILE (absname
);
3446 if (stat (SDATA (absname
), &st
) < 0)
3448 #if defined (MSDOS) && __DJGPP__ < 2
3449 if (check_executable (SDATA (absname
)))
3450 st
.st_mode
|= S_IEXEC
;
3451 #endif /* MSDOS && __DJGPP__ < 2 */
3453 return make_number (st
.st_mode
& 07777);
3456 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3457 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3458 Only the 12 low bits of MODE are used. */)
3460 Lisp_Object filename
, mode
;
3462 Lisp_Object absname
, encoded_absname
;
3463 Lisp_Object handler
;
3465 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3466 CHECK_NUMBER (mode
);
3468 /* If the file name has special constructs in it,
3469 call the corresponding file handler. */
3470 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3471 if (!NILP (handler
))
3472 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3474 encoded_absname
= ENCODE_FILE (absname
);
3476 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3477 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3482 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3483 doc
: /* Set the file permission bits for newly created files.
3484 The argument MODE should be an integer; only the low 9 bits are used.
3485 This setting is inherited by subprocesses. */)
3489 CHECK_NUMBER (mode
);
3491 umask ((~ XINT (mode
)) & 0777);
3496 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3497 doc
: /* Return the default file protection for created files.
3498 The value is an integer. */)
3504 realmask
= umask (0);
3507 XSETINT (value
, (~ realmask
) & 0777);
3511 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3513 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3514 doc
: /* Set times of file FILENAME to TIME.
3515 Set both access and modification times.
3516 Return t on success, else nil.
3517 Use the current time if TIME is nil. TIME is in the format of
3520 Lisp_Object filename
, time
;
3522 Lisp_Object absname
, encoded_absname
;
3523 Lisp_Object handler
;
3527 if (! lisp_time_argument (time
, &sec
, &usec
))
3528 error ("Invalid time specification");
3530 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3532 /* If the file name has special constructs in it,
3533 call the corresponding file handler. */
3534 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3535 if (!NILP (handler
))
3536 return call3 (handler
, Qset_file_times
, absname
, time
);
3538 encoded_absname
= ENCODE_FILE (absname
);
3543 EMACS_SET_SECS (t
, sec
);
3544 EMACS_SET_USECS (t
, usec
);
3546 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3551 /* Setting times on a directory always fails. */
3552 if (stat (SDATA (encoded_absname
), &st
) == 0
3553 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3556 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3569 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3570 doc
: /* Tell Unix to finish all pending disk updates. */)
3579 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3580 doc
: /* Return t if file FILE1 is newer than file FILE2.
3581 If FILE1 does not exist, the answer is nil;
3582 otherwise, if FILE2 does not exist, the answer is t. */)
3584 Lisp_Object file1
, file2
;
3586 Lisp_Object absname1
, absname2
;
3589 Lisp_Object handler
;
3590 struct gcpro gcpro1
, gcpro2
;
3592 CHECK_STRING (file1
);
3593 CHECK_STRING (file2
);
3596 GCPRO2 (absname1
, file2
);
3597 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3598 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3601 /* If the file name has special constructs in it,
3602 call the corresponding file handler. */
3603 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3605 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3606 if (!NILP (handler
))
3607 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3609 GCPRO2 (absname1
, absname2
);
3610 absname1
= ENCODE_FILE (absname1
);
3611 absname2
= ENCODE_FILE (absname2
);
3614 if (stat (SDATA (absname1
), &st
) < 0)
3617 mtime1
= st
.st_mtime
;
3619 if (stat (SDATA (absname2
), &st
) < 0)
3622 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3626 Lisp_Object Qfind_buffer_file_type
;
3629 #ifndef READ_BUF_SIZE
3630 #define READ_BUF_SIZE (64 << 10)
3633 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3635 /* This function is called after Lisp functions to decide a coding
3636 system are called, or when they cause an error. Before they are
3637 called, the current buffer is set unibyte and it contains only a
3638 newly inserted text (thus the buffer was empty before the
3641 The functions may set markers, overlays, text properties, or even
3642 alter the buffer contents, change the current buffer.
3644 Here, we reset all those changes by:
3645 o set back the current buffer.
3646 o move all markers and overlays to BEG.
3647 o remove all text properties.
3648 o set back the buffer multibyteness. */
3651 decide_coding_unwind (unwind_data
)
3652 Lisp_Object unwind_data
;
3654 Lisp_Object multibyte
, undo_list
, buffer
;
3656 multibyte
= XCAR (unwind_data
);
3657 unwind_data
= XCDR (unwind_data
);
3658 undo_list
= XCAR (unwind_data
);
3659 buffer
= XCDR (unwind_data
);
3661 if (current_buffer
!= XBUFFER (buffer
))
3662 set_buffer_internal (XBUFFER (buffer
));
3663 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3664 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3665 BUF_INTERVALS (current_buffer
) = 0;
3666 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3668 /* Now we are safe to change the buffer's multibyteness directly. */
3669 current_buffer
->enable_multibyte_characters
= multibyte
;
3670 current_buffer
->undo_list
= undo_list
;
3676 /* Used to pass values from insert-file-contents to read_non_regular. */
3678 static int non_regular_fd
;
3679 static int non_regular_inserted
;
3680 static int non_regular_nbytes
;
3683 /* Read from a non-regular file.
3684 Read non_regular_trytry bytes max from non_regular_fd.
3685 Non_regular_inserted specifies where to put the read bytes.
3686 Value is the number of bytes read. */
3695 nbytes
= emacs_read (non_regular_fd
,
3696 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3697 non_regular_nbytes
);
3699 return make_number (nbytes
);
3703 /* Condition-case handler used when reading from non-regular files
3704 in insert-file-contents. */
3707 read_non_regular_quit ()
3713 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3715 doc
: /* Insert contents of file FILENAME after point.
3716 Returns list of absolute file name and number of characters inserted.
3717 If second argument VISIT is non-nil, the buffer's visited filename
3718 and last save file modtime are set, and it is marked unmodified.
3719 If visiting and the file does not exist, visiting is completed
3720 before the error is signaled.
3721 The optional third and fourth arguments BEG and END
3722 specify what portion of the file to insert.
3723 These arguments count bytes in the file, not characters in the buffer.
3724 If VISIT is non-nil, BEG and END must be nil.
3726 If optional fifth argument REPLACE is non-nil,
3727 it means replace the current buffer contents (in the accessible portion)
3728 with the file contents. This is better than simply deleting and inserting
3729 the whole thing because (1) it preserves some marker positions
3730 and (2) it puts less data in the undo list.
3731 When REPLACE is non-nil, the value is the number of characters actually read,
3732 which is often less than the number of characters to be read.
3734 This does code conversion according to the value of
3735 `coding-system-for-read' or `file-coding-system-alist',
3736 and sets the variable `last-coding-system-used' to the coding system
3738 (filename
, visit
, beg
, end
, replace
)
3739 Lisp_Object filename
, visit
, beg
, end
, replace
;
3744 register int how_much
;
3745 register int unprocessed
;
3746 int count
= SPECPDL_INDEX ();
3747 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3748 Lisp_Object handler
, val
, insval
, orig_filename
;
3751 int not_regular
= 0;
3752 unsigned char read_buf
[READ_BUF_SIZE
];
3753 struct coding_system coding
;
3754 unsigned char buffer
[1 << 14];
3755 int replace_handled
= 0;
3756 int set_coding_system
= 0;
3757 Lisp_Object coding_system
;
3759 Lisp_Object old_Vdeactivate_mark
= Vdeactivate_mark
;
3760 int we_locked_file
= 0;
3762 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3763 error ("Cannot do file visiting in an indirect buffer");
3765 if (!NILP (current_buffer
->read_only
))
3766 Fbarf_if_buffer_read_only ();
3770 orig_filename
= Qnil
;
3772 GCPRO4 (filename
, val
, p
, orig_filename
);
3774 CHECK_STRING (filename
);
3775 filename
= Fexpand_file_name (filename
, Qnil
);
3777 /* The value Qnil means that the coding system is not yet
3779 coding_system
= Qnil
;
3781 /* If the file name has special constructs in it,
3782 call the corresponding file handler. */
3783 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3784 if (!NILP (handler
))
3786 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3787 visit
, beg
, end
, replace
);
3788 if (CONSP (val
) && CONSP (XCDR (val
)))
3789 inserted
= XINT (XCAR (XCDR (val
)));
3793 orig_filename
= filename
;
3794 filename
= ENCODE_FILE (filename
);
3800 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3802 /* Tell stat to use expensive method to get accurate info. */
3803 Vw32_get_true_file_attributes
= Qt
;
3804 total
= stat (SDATA (filename
), &st
);
3805 Vw32_get_true_file_attributes
= tem
;
3810 if (stat (SDATA (filename
), &st
) < 0)
3812 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3813 || fstat (fd
, &st
) < 0)
3814 #endif /* not APOLLO */
3815 #endif /* WINDOWSNT */
3817 if (fd
>= 0) emacs_close (fd
);
3820 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3823 if (!NILP (Vcoding_system_for_read
))
3824 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3829 /* This code will need to be changed in order to work on named
3830 pipes, and it's probably just not worth it. So we should at
3831 least signal an error. */
3832 if (!S_ISREG (st
.st_mode
))
3839 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3840 Fsignal (Qfile_error
,
3841 Fcons (build_string ("not a regular file"),
3842 Fcons (orig_filename
, Qnil
)));
3847 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3850 /* Replacement should preserve point as it preserves markers. */
3851 if (!NILP (replace
))
3852 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3854 record_unwind_protect (close_file_unwind
, make_number (fd
));
3856 /* Supposedly happens on VMS. */
3857 /* Can happen on any platform that uses long as type of off_t, but allows
3858 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3859 give a message suitable for the latter case. */
3860 if (! not_regular
&& st
.st_size
< 0)
3861 error ("Maximum buffer size exceeded");
3863 /* Prevent redisplay optimizations. */
3864 current_buffer
->clip_changed
= 1;
3868 if (!NILP (beg
) || !NILP (end
))
3869 error ("Attempt to visit less than an entire file");
3870 if (BEG
< Z
&& NILP (replace
))
3871 error ("Cannot do file visiting in a non-empty buffer");
3877 XSETFASTINT (beg
, 0);
3885 XSETINT (end
, st
.st_size
);
3887 /* Arithmetic overflow can occur if an Emacs integer cannot
3888 represent the file size, or if the calculations below
3889 overflow. The calculations below double the file size
3890 twice, so check that it can be multiplied by 4 safely. */
3891 if (XINT (end
) != st
.st_size
3892 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3893 error ("Maximum buffer size exceeded");
3895 /* The file size returned from stat may be zero, but data
3896 may be readable nonetheless, for example when this is a
3897 file in the /proc filesystem. */
3898 if (st
.st_size
== 0)
3899 XSETINT (end
, READ_BUF_SIZE
);
3903 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3905 coding_system
= Qutf_8_emacs
;
3906 setup_coding_system (coding_system
, &coding
);
3907 /* Ensure we set Vlast_coding_system_used. */
3908 set_coding_system
= 1;
3912 /* Decide the coding system to use for reading the file now
3913 because we can't use an optimized method for handling
3914 `coding:' tag if the current buffer is not empty. */
3915 if (!NILP (Vcoding_system_for_read
))
3916 coding_system
= Vcoding_system_for_read
;
3919 /* Don't try looking inside a file for a coding system
3920 specification if it is not seekable. */
3921 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3923 /* Find a coding system specified in the heading two
3924 lines or in the tailing several lines of the file.
3925 We assume that the 1K-byte and 3K-byte for heading
3926 and tailing respectively are sufficient for this
3930 if (st
.st_size
<= (1024 * 4))
3931 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3934 nread
= emacs_read (fd
, read_buf
, 1024);
3937 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3938 report_file_error ("Setting file position",
3939 Fcons (orig_filename
, Qnil
));
3940 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3945 error ("IO error reading %s: %s",
3946 SDATA (orig_filename
), emacs_strerror (errno
));
3949 struct buffer
*prev
= current_buffer
;
3953 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3955 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3956 buf
= XBUFFER (buffer
);
3958 delete_all_overlays (buf
);
3959 buf
->directory
= current_buffer
->directory
;
3960 buf
->read_only
= Qnil
;
3961 buf
->filename
= Qnil
;
3962 buf
->undo_list
= Qt
;
3963 eassert (buf
->overlays_before
== NULL
);
3964 eassert (buf
->overlays_after
== NULL
);
3966 set_buffer_internal (buf
);
3968 buf
->enable_multibyte_characters
= Qnil
;
3970 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3971 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3972 coding_system
= call2 (Vset_auto_coding_function
,
3973 filename
, make_number (nread
));
3974 set_buffer_internal (prev
);
3976 /* Discard the unwind protect for recovering the
3980 /* Rewind the file for the actual read done later. */
3981 if (lseek (fd
, 0, 0) < 0)
3982 report_file_error ("Setting file position",
3983 Fcons (orig_filename
, Qnil
));
3987 if (NILP (coding_system
))
3989 /* If we have not yet decided a coding system, check
3990 file-coding-system-alist. */
3991 Lisp_Object args
[6];
3993 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3994 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3995 coding_system
= Ffind_operation_coding_system (6, args
);
3996 if (CONSP (coding_system
))
3997 coding_system
= XCAR (coding_system
);
4001 if (NILP (coding_system
))
4002 coding_system
= Qundecided
;
4004 CHECK_CODING_SYSTEM (coding_system
);
4006 if (NILP (current_buffer
->enable_multibyte_characters
))
4007 /* We must suppress all character code conversion except for
4008 end-of-line conversion. */
4009 coding_system
= raw_text_coding_system (coding_system
);
4011 setup_coding_system (coding_system
, &coding
);
4012 /* Ensure we set Vlast_coding_system_used. */
4013 set_coding_system
= 1;
4016 /* If requested, replace the accessible part of the buffer
4017 with the file contents. Avoid replacing text at the
4018 beginning or end of the buffer that matches the file contents;
4019 that preserves markers pointing to the unchanged parts.
4021 Here we implement this feature in an optimized way
4022 for the case where code conversion is NOT needed.
4023 The following if-statement handles the case of conversion
4024 in a less optimal way.
4026 If the code conversion is "automatic" then we try using this
4027 method and hope for the best.
4028 But if we discover the need for conversion, we give up on this method
4029 and let the following if-statement handle the replace job. */
4032 && (NILP (coding_system
)
4033 || ! CODING_REQUIRE_DECODING (&coding
)))
4035 /* same_at_start and same_at_end count bytes,
4036 because file access counts bytes
4037 and BEG and END count bytes. */
4038 int same_at_start
= BEGV_BYTE
;
4039 int same_at_end
= ZV_BYTE
;
4041 /* There is still a possibility we will find the need to do code
4042 conversion. If that happens, we set this variable to 1 to
4043 give up on handling REPLACE in the optimized way. */
4044 int giveup_match_end
= 0;
4046 if (XINT (beg
) != 0)
4048 if (lseek (fd
, XINT (beg
), 0) < 0)
4049 report_file_error ("Setting file position",
4050 Fcons (orig_filename
, Qnil
));
4055 /* Count how many chars at the start of the file
4056 match the text at the beginning of the buffer. */
4061 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4063 error ("IO error reading %s: %s",
4064 SDATA (orig_filename
), emacs_strerror (errno
));
4065 else if (nread
== 0)
4068 if (CODING_REQUIRE_DETECTION (&coding
))
4070 coding_system
= detect_coding_system (buffer
, nread
, nread
, 1, 0,
4072 setup_coding_system (coding_system
, &coding
);
4075 if (CODING_REQUIRE_DECODING (&coding
))
4076 /* We found that the file should be decoded somehow.
4077 Let's give up here. */
4079 giveup_match_end
= 1;
4084 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4085 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4086 same_at_start
++, bufpos
++;
4087 /* If we found a discrepancy, stop the scan.
4088 Otherwise loop around and scan the next bufferful. */
4089 if (bufpos
!= nread
)
4093 /* If the file matches the buffer completely,
4094 there's no need to replace anything. */
4095 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4099 /* Truncate the buffer to the size of the file. */
4100 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4105 /* Count how many chars at the end of the file
4106 match the text at the end of the buffer. But, if we have
4107 already found that decoding is necessary, don't waste time. */
4108 while (!giveup_match_end
)
4110 int total_read
, nread
, bufpos
, curpos
, trial
;
4112 /* At what file position are we now scanning? */
4113 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4114 /* If the entire file matches the buffer tail, stop the scan. */
4117 /* How much can we scan in the next step? */
4118 trial
= min (curpos
, sizeof buffer
);
4119 if (lseek (fd
, curpos
- trial
, 0) < 0)
4120 report_file_error ("Setting file position",
4121 Fcons (orig_filename
, Qnil
));
4123 total_read
= nread
= 0;
4124 while (total_read
< trial
)
4126 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4128 error ("IO error reading %s: %s",
4129 SDATA (orig_filename
), emacs_strerror (errno
));
4130 else if (nread
== 0)
4132 total_read
+= nread
;
4135 /* Scan this bufferful from the end, comparing with
4136 the Emacs buffer. */
4137 bufpos
= total_read
;
4139 /* Compare with same_at_start to avoid counting some buffer text
4140 as matching both at the file's beginning and at the end. */
4141 while (bufpos
> 0 && same_at_end
> same_at_start
4142 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4143 same_at_end
--, bufpos
--;
4145 /* If we found a discrepancy, stop the scan.
4146 Otherwise loop around and scan the preceding bufferful. */
4149 /* If this discrepancy is because of code conversion,
4150 we cannot use this method; giveup and try the other. */
4151 if (same_at_end
> same_at_start
4152 && FETCH_BYTE (same_at_end
- 1) >= 0200
4153 && ! NILP (current_buffer
->enable_multibyte_characters
)
4154 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4155 giveup_match_end
= 1;
4164 if (! giveup_match_end
)
4168 /* We win! We can handle REPLACE the optimized way. */
4170 /* Extend the start of non-matching text area to multibyte
4171 character boundary. */
4172 if (! NILP (current_buffer
->enable_multibyte_characters
))
4173 while (same_at_start
> BEGV_BYTE
4174 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4177 /* Extend the end of non-matching text area to multibyte
4178 character boundary. */
4179 if (! NILP (current_buffer
->enable_multibyte_characters
))
4180 while (same_at_end
< ZV_BYTE
4181 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4184 /* Don't try to reuse the same piece of text twice. */
4185 overlap
= (same_at_start
- BEGV_BYTE
4186 - (same_at_end
+ st
.st_size
- ZV
));
4188 same_at_end
+= overlap
;
4190 /* Arrange to read only the nonmatching middle part of the file. */
4191 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4192 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4194 del_range_byte (same_at_start
, same_at_end
, 0);
4195 /* Insert from the file at the proper position. */
4196 temp
= BYTE_TO_CHAR (same_at_start
);
4197 SET_PT_BOTH (temp
, same_at_start
);
4199 /* If display currently starts at beginning of line,
4200 keep it that way. */
4201 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4202 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4204 replace_handled
= 1;
4208 /* If requested, replace the accessible part of the buffer
4209 with the file contents. Avoid replacing text at the
4210 beginning or end of the buffer that matches the file contents;
4211 that preserves markers pointing to the unchanged parts.
4213 Here we implement this feature for the case where code conversion
4214 is needed, in a simple way that needs a lot of memory.
4215 The preceding if-statement handles the case of no conversion
4216 in a more optimized way. */
4217 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4219 int same_at_start
= BEGV_BYTE
;
4220 int same_at_end
= ZV_BYTE
;
4221 int same_at_start_charpos
;
4225 unsigned char *decoded
;
4227 int this_count
= SPECPDL_INDEX ();
4228 int multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
4229 Lisp_Object conversion_buffer
;
4231 conversion_buffer
= code_conversion_save (1, multibyte
);
4233 /* First read the whole file, performing code conversion into
4234 CONVERSION_BUFFER. */
4236 if (lseek (fd
, XINT (beg
), 0) < 0)
4237 report_file_error ("Setting file position",
4238 Fcons (orig_filename
, Qnil
));
4240 total
= st
.st_size
; /* Total bytes in the file. */
4241 how_much
= 0; /* Bytes read from file so far. */
4242 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4243 unprocessed
= 0; /* Bytes not processed in previous loop. */
4245 GCPRO1 (conversion_buffer
);
4246 while (how_much
< total
)
4248 /* We read one bunch by one (READ_BUF_SIZE bytes) to allow
4249 quitting while reading a huge while. */
4250 /* try is reserved in some compilers (Microsoft C) */
4251 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4254 /* Allow quitting out of the actual I/O. */
4257 this = emacs_read (fd
, read_buf
+ unprocessed
, trytry
);
4269 BUF_SET_PT (XBUFFER (conversion_buffer
),
4270 BUF_Z (XBUFFER (conversion_buffer
)));
4271 decode_coding_c_string (&coding
, read_buf
, unprocessed
+ this,
4273 unprocessed
= coding
.carryover_bytes
;
4274 if (coding
.carryover_bytes
> 0)
4275 bcopy (coding
.carryover
, read_buf
, unprocessed
);
4280 /* At this point, HOW_MUCH should equal TOTAL, or should be <= 0
4281 if we couldn't read the file. */
4286 error ("IO error reading %s: %s",
4287 SDATA (orig_filename
), emacs_strerror (errno
));
4288 else if (how_much
== -2)
4289 error ("maximum buffer size exceeded");
4292 if (unprocessed
> 0)
4294 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4295 decode_coding_c_string (&coding
, read_buf
, unprocessed
,
4297 coding
.mode
&= ~CODING_MODE_LAST_BLOCK
;
4300 decoded
= BUF_BEG_ADDR (XBUFFER (conversion_buffer
));
4301 inserted
= (BUF_Z_BYTE (XBUFFER (conversion_buffer
))
4302 - BUF_BEG_BYTE (XBUFFER (conversion_buffer
)));
4304 /* Compare the beginning of the converted string with the buffer
4308 while (bufpos
< inserted
&& same_at_start
< same_at_end
4309 && FETCH_BYTE (same_at_start
) == decoded
[bufpos
])
4310 same_at_start
++, bufpos
++;
4312 /* If the file matches the head of buffer completely,
4313 there's no need to replace anything. */
4315 if (bufpos
== inserted
)
4318 /* Truncate the buffer to the size of the file. */
4319 del_range_byte (same_at_start
, same_at_end
, 0);
4322 unbind_to (this_count
, Qnil
);
4326 /* Extend the start of non-matching text area to the previous
4327 multibyte character boundary. */
4328 if (! NILP (current_buffer
->enable_multibyte_characters
))
4329 while (same_at_start
> BEGV_BYTE
4330 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4333 /* Scan this bufferful from the end, comparing with
4334 the Emacs buffer. */
4337 /* Compare with same_at_start to avoid counting some buffer text
4338 as matching both at the file's beginning and at the end. */
4339 while (bufpos
> 0 && same_at_end
> same_at_start
4340 && FETCH_BYTE (same_at_end
- 1) == decoded
[bufpos
- 1])
4341 same_at_end
--, bufpos
--;
4343 /* Extend the end of non-matching text area to the next
4344 multibyte character boundary. */
4345 if (! NILP (current_buffer
->enable_multibyte_characters
))
4346 while (same_at_end
< ZV_BYTE
4347 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4350 /* Don't try to reuse the same piece of text twice. */
4351 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4353 same_at_end
+= overlap
;
4355 /* If display currently starts at beginning of line,
4356 keep it that way. */
4357 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4358 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4360 /* Replace the chars that we need to replace,
4361 and update INSERTED to equal the number of bytes
4362 we are taking from the decoded string. */
4363 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4365 if (same_at_end
!= same_at_start
)
4367 del_range_byte (same_at_start
, same_at_end
, 0);
4369 same_at_start
= GPT_BYTE
;
4373 temp
= BYTE_TO_CHAR (same_at_start
);
4375 /* Insert from the file at the proper position. */
4376 SET_PT_BOTH (temp
, same_at_start
);
4377 same_at_start_charpos
4378 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4381 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer
),
4382 same_at_start
+ inserted
)
4383 - same_at_start_charpos
);
4384 insert_from_buffer (XBUFFER (conversion_buffer
),
4385 same_at_start_charpos
, inserted_chars
, 0);
4386 /* Set `inserted' to the number of inserted characters. */
4387 inserted
= PT
- temp
;
4389 unbind_to (this_count
, Qnil
);
4396 register Lisp_Object temp
;
4398 total
= XINT (end
) - XINT (beg
);
4400 /* Make sure point-max won't overflow after this insertion. */
4401 XSETINT (temp
, total
);
4402 if (total
!= XINT (temp
))
4403 error ("Maximum buffer size exceeded");
4406 /* For a special file, all we can do is guess. */
4407 total
= READ_BUF_SIZE
;
4409 if (NILP (visit
) && inserted
> 0)
4411 #ifdef CLASH_DETECTION
4412 if (!NILP (current_buffer
->file_truename
)
4413 /* Make binding buffer-file-name to nil effective. */
4414 && !NILP (current_buffer
->filename
)
4415 && SAVE_MODIFF
>= MODIFF
)
4417 #endif /* CLASH_DETECTION */
4418 prepare_to_modify_buffer (GPT
, GPT
, NULL
);
4422 if (GAP_SIZE
< total
)
4423 make_gap (total
- GAP_SIZE
);
4425 if (XINT (beg
) != 0 || !NILP (replace
))
4427 if (lseek (fd
, XINT (beg
), 0) < 0)
4428 report_file_error ("Setting file position",
4429 Fcons (orig_filename
, Qnil
));
4432 /* In the following loop, HOW_MUCH contains the total bytes read so
4433 far for a regular file, and not changed for a special file. But,
4434 before exiting the loop, it is set to a negative value if I/O
4438 /* Total bytes inserted. */
4441 /* Here, we don't do code conversion in the loop. It is done by
4442 decode_coding_gap after all data are read into the buffer. */
4444 int gap_size
= GAP_SIZE
;
4446 while (how_much
< total
)
4448 /* try is reserved in some compilers (Microsoft C) */
4449 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4456 /* Maybe make more room. */
4457 if (gap_size
< trytry
)
4459 make_gap (total
- gap_size
);
4460 gap_size
= GAP_SIZE
;
4463 /* Read from the file, capturing `quit'. When an
4464 error occurs, end the loop, and arrange for a quit
4465 to be signaled after decoding the text we read. */
4466 non_regular_fd
= fd
;
4467 non_regular_inserted
= inserted
;
4468 non_regular_nbytes
= trytry
;
4469 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4470 read_non_regular_quit
);
4481 /* Allow quitting out of the actual I/O. We don't make text
4482 part of the buffer until all the reading is done, so a C-g
4483 here doesn't do any harm. */
4486 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4498 /* For a regular file, where TOTAL is the real size,
4499 count HOW_MUCH to compare with it.
4500 For a special file, where TOTAL is just a buffer size,
4501 so don't bother counting in HOW_MUCH.
4502 (INSERTED is where we count the number of characters inserted.) */
4509 /* Now we have read all the file data into the gap.
4510 If it was empty, undo marking the buffer modified. */
4514 #ifdef CLASH_DETECTION
4516 unlock_file (current_buffer
->file_truename
);
4518 Vdeactivate_mark
= old_Vdeactivate_mark
;
4521 /* Make the text read part of the buffer. */
4522 GAP_SIZE
-= inserted
;
4524 GPT_BYTE
+= inserted
;
4526 ZV_BYTE
+= inserted
;
4531 /* Put an anchor to ensure multi-byte form ends at gap. */
4536 /* Discard the unwind protect for closing the file. */
4540 error ("IO error reading %s: %s",
4541 SDATA (orig_filename
), emacs_strerror (errno
));
4545 if (NILP (coding_system
))
4547 /* The coding system is not yet decided. Decide it by an
4548 optimized method for handling `coding:' tag.
4550 Note that we can get here only if the buffer was empty
4551 before the insertion. */
4553 if (!NILP (Vcoding_system_for_read
))
4554 coding_system
= Vcoding_system_for_read
;
4557 /* Since we are sure that the current buffer was empty
4558 before the insertion, we can toggle
4559 enable-multibyte-characters directly here without taking
4560 care of marker adjustment. By this way, we can run Lisp
4561 program safely before decoding the inserted text. */
4562 Lisp_Object unwind_data
;
4563 int count
= SPECPDL_INDEX ();
4565 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4566 Fcons (current_buffer
->undo_list
,
4567 Fcurrent_buffer ()));
4568 current_buffer
->enable_multibyte_characters
= Qnil
;
4569 current_buffer
->undo_list
= Qt
;
4570 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4572 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4574 coding_system
= call2 (Vset_auto_coding_function
,
4575 filename
, make_number (inserted
));
4578 if (NILP (coding_system
))
4580 /* If the coding system is not yet decided, check
4581 file-coding-system-alist. */
4582 Lisp_Object args
[6];
4584 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4585 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4586 coding_system
= Ffind_operation_coding_system (6, args
);
4587 if (CONSP (coding_system
))
4588 coding_system
= XCAR (coding_system
);
4590 unbind_to (count
, Qnil
);
4591 inserted
= Z_BYTE
- BEG_BYTE
;
4594 if (NILP (coding_system
))
4595 coding_system
= Qundecided
;
4597 CHECK_CODING_SYSTEM (coding_system
);
4599 if (NILP (current_buffer
->enable_multibyte_characters
))
4600 /* We must suppress all character code conversion except for
4601 end-of-line conversion. */
4602 coding_system
= raw_text_coding_system (coding_system
);
4603 setup_coding_system (coding_system
, &coding
);
4604 /* Ensure we set Vlast_coding_system_used. */
4605 set_coding_system
= 1;
4610 /* When we visit a file by raw-text, we change the buffer to
4612 if (CODING_FOR_UNIBYTE (&coding
)
4613 /* Can't do this if part of the buffer might be preserved. */
4615 /* Visiting a file with these coding system makes the buffer
4617 current_buffer
->enable_multibyte_characters
= Qnil
;
4620 coding
.dst_multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
4621 if (CODING_MAY_REQUIRE_DECODING (&coding
)
4622 && (inserted
> 0 || CODING_REQUIRE_FLUSHING (&coding
)))
4624 move_gap_both (PT
, PT_BYTE
);
4625 GAP_SIZE
+= inserted
;
4626 ZV_BYTE
-= inserted
;
4630 decode_coding_gap (&coding
, inserted
, inserted
);
4631 inserted
= coding
.produced_char
;
4632 coding_system
= CODING_ID_NAME (coding
.id
);
4634 else if (inserted
> 0)
4635 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4638 /* Now INSERTED is measured in characters. */
4641 /* Use the conversion type to determine buffer-file-type
4642 (find-buffer-file-type is now used to help determine the
4644 if ((VECTORP (CODING_ID_EOL_TYPE (coding
.id
))
4645 || EQ (CODING_ID_EOL_TYPE (coding
.id
), Qunix
))
4646 && ! CODING_REQUIRE_DECODING (&coding
))
4647 current_buffer
->buffer_file_type
= Qt
;
4649 current_buffer
->buffer_file_type
= Qnil
;
4656 if (!EQ (current_buffer
->undo_list
, Qt
))
4657 current_buffer
->undo_list
= Qnil
;
4659 stat (SDATA (filename
), &st
);
4664 current_buffer
->modtime
= st
.st_mtime
;
4665 current_buffer
->filename
= orig_filename
;
4668 SAVE_MODIFF
= MODIFF
;
4669 current_buffer
->auto_save_modified
= MODIFF
;
4670 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4671 #ifdef CLASH_DETECTION
4674 if (!NILP (current_buffer
->file_truename
))
4675 unlock_file (current_buffer
->file_truename
);
4676 unlock_file (filename
);
4678 #endif /* CLASH_DETECTION */
4680 Fsignal (Qfile_error
,
4681 Fcons (build_string ("not a regular file"),
4682 Fcons (orig_filename
, Qnil
)));
4685 if (set_coding_system
)
4686 Vlast_coding_system_used
= coding_system
;
4688 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4690 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4692 if (! NILP (insval
))
4694 CHECK_NUMBER (insval
);
4695 inserted
= XFASTINT (insval
);
4699 /* Decode file format */
4702 int empty_undo_list_p
= 0;
4704 /* If we're anyway going to discard undo information, don't
4705 record it in the first place. The buffer's undo list at this
4706 point is either nil or t when visiting a file. */
4709 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4710 current_buffer
->undo_list
= Qt
;
4713 insval
= call3 (Qformat_decode
,
4714 Qnil
, make_number (inserted
), visit
);
4715 CHECK_NUMBER (insval
);
4716 inserted
= XFASTINT (insval
);
4719 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4722 /* Call after-change hooks for the inserted text, aside from the case
4723 of normal visiting (not with REPLACE), which is done in a new buffer
4724 "before" the buffer is changed. */
4725 if (inserted
> 0 && total
> 0
4726 && (NILP (visit
) || !NILP (replace
)))
4728 signal_after_change (PT
, 0, inserted
);
4729 update_compositions (PT
, PT
, CHECK_BORDER
);
4732 p
= Vafter_insert_file_functions
;
4735 insval
= call1 (XCAR (p
), make_number (inserted
));
4738 CHECK_NUMBER (insval
);
4739 inserted
= XFASTINT (insval
);
4746 && current_buffer
->modtime
== -1)
4748 /* If visiting nonexistent file, return nil. */
4749 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4753 Fsignal (Qquit
, Qnil
);
4755 /* ??? Retval needs to be dealt with in all cases consistently. */
4757 val
= Fcons (orig_filename
,
4758 Fcons (make_number (inserted
),
4761 RETURN_UNGCPRO (unbind_to (count
, val
));
4764 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4766 /* If build_annotations switched buffers, switch back to BUF.
4767 Kill the temporary buffer that was selected in the meantime.
4769 Since this kill only the last temporary buffer, some buffers remain
4770 not killed if build_annotations switched buffers more than once.
4774 build_annotations_unwind (buf
)
4779 if (XBUFFER (buf
) == current_buffer
)
4781 tembuf
= Fcurrent_buffer ();
4783 Fkill_buffer (tembuf
);
4787 /* Decide the coding-system to encode the data with. */
4790 choose_write_coding_system (start
, end
, filename
,
4791 append
, visit
, lockname
, coding
)
4792 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4793 struct coding_system
*coding
;
4798 && NILP (Fstring_equal (current_buffer
->filename
,
4799 current_buffer
->auto_save_file_name
)))
4801 else if (!NILP (Vcoding_system_for_write
))
4803 val
= Vcoding_system_for_write
;
4804 if (coding_system_require_warning
4805 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4806 /* Confirm that VAL can surely encode the current region. */
4807 val
= call5 (Vselect_safe_coding_system_function
,
4808 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4813 /* If the variable `buffer-file-coding-system' is set locally,
4814 it means that the file was read with some kind of code
4815 conversion or the variable is explicitly set by users. We
4816 had better write it out with the same coding system even if
4817 `enable-multibyte-characters' is nil.
4819 If it is not set locally, we anyway have to convert EOL
4820 format if the default value of `buffer-file-coding-system'
4821 tells that it is not Unix-like (LF only) format. */
4822 int using_default_coding
= 0;
4823 int force_raw_text
= 0;
4825 val
= current_buffer
->buffer_file_coding_system
;
4827 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4830 if (NILP (current_buffer
->enable_multibyte_characters
))
4836 /* Check file-coding-system-alist. */
4837 Lisp_Object args
[7], coding_systems
;
4839 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4840 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4842 coding_systems
= Ffind_operation_coding_system (7, args
);
4843 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4844 val
= XCDR (coding_systems
);
4849 /* If we still have not decided a coding system, use the
4850 default value of buffer-file-coding-system. */
4851 val
= current_buffer
->buffer_file_coding_system
;
4852 using_default_coding
= 1;
4855 if (! NILP (val
) && ! force_raw_text
)
4857 Lisp_Object spec
, attrs
;
4859 CHECK_CODING_SYSTEM_GET_SPEC (val
, spec
);
4860 attrs
= AREF (spec
, 0);
4861 if (EQ (CODING_ATTR_TYPE (attrs
), Qraw_text
))
4866 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4867 /* Confirm that VAL can surely encode the current region. */
4868 val
= call5 (Vselect_safe_coding_system_function
,
4869 start
, end
, val
, Qnil
, filename
);
4871 /* If the decided coding-system doesn't specify end-of-line
4872 format, we use that of
4873 `default-buffer-file-coding-system'. */
4874 if (! using_default_coding
4875 && ! NILP (buffer_defaults
.buffer_file_coding_system
))
4876 val
= (coding_inherit_eol_type
4877 (val
, buffer_defaults
.buffer_file_coding_system
));
4879 /* If we decide not to encode text, use `raw-text' or one of its
4882 val
= raw_text_coding_system (val
);
4885 setup_coding_system (val
, coding
);
4887 && VECTORP (CODING_ID_EOL_TYPE (coding
->id
)))
4888 val
= AREF (CODING_ID_EOL_TYPE (coding
->id
), 0);
4890 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4891 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4895 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4896 "r\nFWrite region to file: \ni\ni\ni\np",
4897 doc
: /* Write current region into specified file.
4898 When called from a program, requires three arguments:
4899 START, END and FILENAME. START and END are normally buffer positions
4900 specifying the part of the buffer to write.
4901 If START is nil, that means to use the entire buffer contents.
4902 If START is a string, then output that string to the file
4903 instead of any buffer contents; END is ignored.
4905 Optional fourth argument APPEND if non-nil means
4906 append to existing file contents (if any). If it is an integer,
4907 seek to that offset in the file before writing.
4908 Optional fifth argument VISIT, if t or a string, means
4909 set the last-save-file-modtime of buffer to this file's modtime
4910 and mark buffer not modified.
4911 If VISIT is a string, it is a second file name;
4912 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4913 VISIT is also the file name to lock and unlock for clash detection.
4914 If VISIT is neither t nor nil nor a string,
4915 that means do not display the \"Wrote file\" message.
4916 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4917 use for locking and unlocking, overriding FILENAME and VISIT.
4918 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4919 for an existing file with the same name. If MUSTBENEW is `excl',
4920 that means to get an error if the file already exists; never overwrite.
4921 If MUSTBENEW is neither nil nor `excl', that means ask for
4922 confirmation before overwriting, but do go ahead and overwrite the file
4923 if the user confirms.
4925 This does code conversion according to the value of
4926 `coding-system-for-write', `buffer-file-coding-system', or
4927 `file-coding-system-alist', and sets the variable
4928 `last-coding-system-used' to the coding system actually used. */)
4929 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4930 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4935 const unsigned char *fn
;
4937 int count
= SPECPDL_INDEX ();
4940 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4942 Lisp_Object handler
;
4943 Lisp_Object visit_file
;
4944 Lisp_Object annotations
;
4945 Lisp_Object encoded_filename
;
4946 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4947 int quietly
= !NILP (visit
);
4948 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4949 struct buffer
*given_buffer
;
4951 int buffer_file_type
= O_BINARY
;
4953 struct coding_system coding
;
4955 if (current_buffer
->base_buffer
&& visiting
)
4956 error ("Cannot do file visiting in an indirect buffer");
4958 if (!NILP (start
) && !STRINGP (start
))
4959 validate_region (&start
, &end
);
4961 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4963 filename
= Fexpand_file_name (filename
, Qnil
);
4965 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4966 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4968 if (STRINGP (visit
))
4969 visit_file
= Fexpand_file_name (visit
, Qnil
);
4971 visit_file
= filename
;
4973 if (NILP (lockname
))
4974 lockname
= visit_file
;
4978 /* If the file name has special constructs in it,
4979 call the corresponding file handler. */
4980 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4981 /* If FILENAME has no handler, see if VISIT has one. */
4982 if (NILP (handler
) && STRINGP (visit
))
4983 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4985 if (!NILP (handler
))
4988 val
= call6 (handler
, Qwrite_region
, start
, end
,
4989 filename
, append
, visit
);
4993 SAVE_MODIFF
= MODIFF
;
4994 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4995 current_buffer
->filename
= visit_file
;
5001 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
5003 /* Special kludge to simplify auto-saving. */
5006 XSETFASTINT (start
, BEG
);
5007 XSETFASTINT (end
, Z
);
5011 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
5012 count1
= SPECPDL_INDEX ();
5014 given_buffer
= current_buffer
;
5016 if (!STRINGP (start
))
5018 annotations
= build_annotations (start
, end
);
5020 if (current_buffer
!= given_buffer
)
5022 XSETFASTINT (start
, BEGV
);
5023 XSETFASTINT (end
, ZV
);
5029 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
5031 /* Decide the coding-system to encode the data with.
5032 We used to make this choice before calling build_annotations, but that
5033 leads to problems when a write-annotate-function takes care of
5034 unsavable chars (as was the case with X-Symbol). */
5035 Vlast_coding_system_used
5036 = choose_write_coding_system (start
, end
, filename
,
5037 append
, visit
, lockname
, &coding
);
5039 #ifdef CLASH_DETECTION
5042 #if 0 /* This causes trouble for GNUS. */
5043 /* If we've locked this file for some other buffer,
5044 query before proceeding. */
5045 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5046 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5049 lock_file (lockname
);
5051 #endif /* CLASH_DETECTION */
5053 encoded_filename
= ENCODE_FILE (filename
);
5055 fn
= SDATA (encoded_filename
);
5059 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5060 #else /* not DOS_NT */
5061 desc
= emacs_open (fn
, O_WRONLY
, 0);
5062 #endif /* not DOS_NT */
5064 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5066 if (auto_saving
) /* Overwrite any previous version of autosave file */
5068 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5069 desc
= emacs_open (fn
, O_RDWR
, 0);
5071 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5072 ? SDATA (current_buffer
->filename
) : 0,
5075 else /* Write to temporary name and rename if no errors */
5077 Lisp_Object temp_name
;
5078 temp_name
= Ffile_name_directory (filename
);
5080 if (!NILP (temp_name
))
5082 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5083 build_string ("$$SAVE$$")));
5084 fname
= SDATA (filename
);
5085 fn
= SDATA (temp_name
);
5086 desc
= creat_copy_attrs (fname
, fn
);
5089 /* If we can't open the temporary file, try creating a new
5090 version of the original file. VMS "creat" creates a
5091 new version rather than truncating an existing file. */
5094 desc
= creat (fn
, 0666);
5095 #if 0 /* This can clobber an existing file and fail to replace it,
5096 if the user runs out of space. */
5099 /* We can't make a new version;
5100 try to truncate and rewrite existing version if any. */
5102 desc
= emacs_open (fn
, O_RDWR
, 0);
5108 desc
= creat (fn
, 0666);
5112 desc
= emacs_open (fn
,
5113 O_WRONLY
| O_CREAT
| buffer_file_type
5114 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5115 S_IREAD
| S_IWRITE
);
5116 #else /* not DOS_NT */
5117 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5118 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5119 auto_saving
? auto_save_mode_bits
: 0666);
5120 #endif /* not DOS_NT */
5121 #endif /* not VMS */
5125 #ifdef CLASH_DETECTION
5127 if (!auto_saving
) unlock_file (lockname
);
5129 #endif /* CLASH_DETECTION */
5131 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5134 record_unwind_protect (close_file_unwind
, make_number (desc
));
5136 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5140 if (NUMBERP (append
))
5141 ret
= lseek (desc
, XINT (append
), 1);
5143 ret
= lseek (desc
, 0, 2);
5146 #ifdef CLASH_DETECTION
5147 if (!auto_saving
) unlock_file (lockname
);
5148 #endif /* CLASH_DETECTION */
5150 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5158 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5159 * if we do writes that don't end with a carriage return. Furthermore
5160 * it cannot handle writes of more then 16K. The modified
5161 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5162 * this EXCEPT for the last record (iff it doesn't end with a carriage
5163 * return). This implies that if your buffer doesn't end with a carriage
5164 * return, you get one free... tough. However it also means that if
5165 * we make two calls to sys_write (a la the following code) you can
5166 * get one at the gap as well. The easiest way to fix this (honest)
5167 * is to move the gap to the next newline (or the end of the buffer).
5172 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5173 move_gap (find_next_newline (GPT
, 1));
5176 /* The new encoding routine doesn't require the following. */
5178 /* Whether VMS or not, we must move the gap to the next of newline
5179 when we must put designation sequences at beginning of line. */
5180 if (INTEGERP (start
)
5181 && coding
.type
== coding_type_iso2022
5182 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5183 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5185 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5186 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5187 move_gap_both (PT
, PT_BYTE
);
5188 SET_PT_BOTH (opoint
, opoint_byte
);
5196 if (STRINGP (start
))
5198 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5199 &annotations
, &coding
);
5202 else if (XINT (start
) != XINT (end
))
5204 failure
= 0 > a_write (desc
, Qnil
,
5205 XINT (start
), XINT (end
) - XINT (start
),
5206 &annotations
, &coding
);
5211 /* If file was empty, still need to write the annotations */
5212 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5213 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5217 if (CODING_REQUIRE_FLUSHING (&coding
)
5218 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5221 /* We have to flush out a data. */
5222 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5223 failure
= 0 > e_write (desc
, Qnil
, 1, 1, &coding
);
5230 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5231 Disk full in NFS may be reported here. */
5232 /* mib says that closing the file will try to write as fast as NFS can do
5233 it, and that means the fsync here is not crucial for autosave files. */
5234 if (!auto_saving
&& fsync (desc
) < 0)
5236 /* If fsync fails with EINTR, don't treat that as serious. */
5238 failure
= 1, save_errno
= errno
;
5242 /* Spurious "file has changed on disk" warnings have been
5243 observed on Suns as well.
5244 It seems that `close' can change the modtime, under nfs.
5246 (This has supposedly been fixed in Sunos 4,
5247 but who knows about all the other machines with NFS?) */
5250 /* On VMS and APOLLO, must do the stat after the close
5251 since closing changes the modtime. */
5254 /* Recall that #if defined does not work on VMS. */
5261 /* NFS can report a write failure now. */
5262 if (emacs_close (desc
) < 0)
5263 failure
= 1, save_errno
= errno
;
5266 /* If we wrote to a temporary name and had no errors, rename to real name. */
5270 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5278 /* Discard the unwind protect for close_file_unwind. */
5279 specpdl_ptr
= specpdl
+ count1
;
5280 /* Restore the original current buffer. */
5281 visit_file
= unbind_to (count
, visit_file
);
5283 #ifdef CLASH_DETECTION
5285 unlock_file (lockname
);
5286 #endif /* CLASH_DETECTION */
5288 /* Do this before reporting IO error
5289 to avoid a "file has changed on disk" warning on
5290 next attempt to save. */
5292 current_buffer
->modtime
= st
.st_mtime
;
5295 error ("IO error writing %s: %s", SDATA (filename
),
5296 emacs_strerror (save_errno
));
5300 SAVE_MODIFF
= MODIFF
;
5301 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5302 current_buffer
->filename
= visit_file
;
5303 update_mode_lines
++;
5308 && ! NILP (Fstring_equal (current_buffer
->filename
,
5309 current_buffer
->auto_save_file_name
)))
5310 SAVE_MODIFF
= MODIFF
;
5316 message_with_string ((INTEGERP (append
)
5326 Lisp_Object
merge ();
5328 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5329 doc
: /* Return t if (car A) is numerically less than (car B). */)
5333 return Flss (Fcar (a
), Fcar (b
));
5336 /* Build the complete list of annotations appropriate for writing out
5337 the text between START and END, by calling all the functions in
5338 write-region-annotate-functions and merging the lists they return.
5339 If one of these functions switches to a different buffer, we assume
5340 that buffer contains altered text. Therefore, the caller must
5341 make sure to restore the current buffer in all cases,
5342 as save-excursion would do. */
5345 build_annotations (start
, end
)
5346 Lisp_Object start
, end
;
5348 Lisp_Object annotations
;
5350 struct gcpro gcpro1
, gcpro2
;
5351 Lisp_Object original_buffer
;
5352 int i
, used_global
= 0;
5354 XSETBUFFER (original_buffer
, current_buffer
);
5357 p
= Vwrite_region_annotate_functions
;
5358 GCPRO2 (annotations
, p
);
5361 struct buffer
*given_buffer
= current_buffer
;
5362 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5363 { /* Use the global value of the hook. */
5366 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5368 p
= Fappend (2, arg
);
5371 Vwrite_region_annotations_so_far
= annotations
;
5372 res
= call2 (XCAR (p
), start
, end
);
5373 /* If the function makes a different buffer current,
5374 assume that means this buffer contains altered text to be output.
5375 Reset START and END from the buffer bounds
5376 and discard all previous annotations because they should have
5377 been dealt with by this function. */
5378 if (current_buffer
!= given_buffer
)
5380 XSETFASTINT (start
, BEGV
);
5381 XSETFASTINT (end
, ZV
);
5384 Flength (res
); /* Check basic validity of return value */
5385 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5389 /* Now do the same for annotation functions implied by the file-format */
5390 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
5391 p
= current_buffer
->auto_save_file_format
;
5393 p
= current_buffer
->file_format
;
5394 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5396 struct buffer
*given_buffer
= current_buffer
;
5398 Vwrite_region_annotations_so_far
= annotations
;
5400 /* Value is either a list of annotations or nil if the function
5401 has written annotations to a temporary buffer, which is now
5403 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5404 original_buffer
, make_number (i
));
5405 if (current_buffer
!= given_buffer
)
5407 XSETFASTINT (start
, BEGV
);
5408 XSETFASTINT (end
, ZV
);
5413 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5421 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5422 If STRING is nil, POS is the character position in the current buffer.
5423 Intersperse with them the annotations from *ANNOT
5424 which fall within the range of POS to POS + NCHARS,
5425 each at its appropriate position.
5427 We modify *ANNOT by discarding elements as we use them up.
5429 The return value is negative in case of system call failure. */
5432 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5435 register int nchars
;
5438 struct coding_system
*coding
;
5442 int lastpos
= pos
+ nchars
;
5444 while (NILP (*annot
) || CONSP (*annot
))
5446 tem
= Fcar_safe (Fcar (*annot
));
5449 nextpos
= XFASTINT (tem
);
5451 /* If there are no more annotations in this range,
5452 output the rest of the range all at once. */
5453 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5454 return e_write (desc
, string
, pos
, lastpos
, coding
);
5456 /* Output buffer text up to the next annotation's position. */
5459 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5463 /* Output the annotation. */
5464 tem
= Fcdr (Fcar (*annot
));
5467 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5470 *annot
= Fcdr (*annot
);
5476 /* Write text in the range START and END into descriptor DESC,
5477 encoding them with coding system CODING. If STRING is nil, START
5478 and END are character positions of the current buffer, else they
5479 are indexes to the string STRING. */
5482 e_write (desc
, string
, start
, end
, coding
)
5486 struct coding_system
*coding
;
5488 if (STRINGP (string
))
5491 end
= SCHARS (string
);
5494 /* We used to have a code for handling selective display here. But,
5495 now it is handled within encode_coding. */
5499 if (STRINGP (string
))
5501 coding
->src_multibyte
= SCHARS (string
) < SBYTES (string
);
5502 if (CODING_REQUIRE_ENCODING (coding
))
5504 encode_coding_object (coding
, string
,
5505 start
, string_char_to_byte (string
, start
),
5506 end
, string_char_to_byte (string
, end
), Qt
);
5510 coding
->dst_object
= string
;
5511 coding
->consumed_char
= SCHARS (string
);
5512 coding
->produced
= SBYTES (string
);
5517 int start_byte
= CHAR_TO_BYTE (start
);
5518 int end_byte
= CHAR_TO_BYTE (end
);
5520 coding
->src_multibyte
= (end
- start
) < (end_byte
- start_byte
);
5521 if (CODING_REQUIRE_ENCODING (coding
))
5523 encode_coding_object (coding
, Fcurrent_buffer (),
5524 start
, start_byte
, end
, end_byte
, Qt
);
5528 coding
->dst_object
= Qnil
;
5529 coding
->dst_pos_byte
= start_byte
;
5530 if (start
>= GPT
|| end
<= GPT
)
5532 coding
->consumed_char
= end
- start
;
5533 coding
->produced
= end_byte
- start_byte
;
5537 coding
->consumed_char
= GPT
- start
;
5538 coding
->produced
= GPT_BYTE
- start_byte
;
5543 if (coding
->produced
> 0)
5547 STRINGP (coding
->dst_object
)
5548 ? SDATA (coding
->dst_object
)
5549 : BYTE_POS_ADDR (coding
->dst_pos_byte
),
5552 if (coding
->produced
)
5555 start
+= coding
->consumed_char
;
5561 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5562 Sverify_visited_file_modtime
, 1, 1, 0,
5563 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5564 This means that the file has not been changed since it was visited or saved.
5565 See Info node `(elisp)Modification Time' for more details. */)
5571 Lisp_Object handler
;
5572 Lisp_Object filename
;
5577 if (!STRINGP (b
->filename
)) return Qt
;
5578 if (b
->modtime
== 0) return Qt
;
5580 /* If the file name has special constructs in it,
5581 call the corresponding file handler. */
5582 handler
= Ffind_file_name_handler (b
->filename
,
5583 Qverify_visited_file_modtime
);
5584 if (!NILP (handler
))
5585 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5587 filename
= ENCODE_FILE (b
->filename
);
5589 if (stat (SDATA (filename
), &st
) < 0)
5591 /* If the file doesn't exist now and didn't exist before,
5592 we say that it isn't modified, provided the error is a tame one. */
5593 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5598 if (st
.st_mtime
== b
->modtime
5599 /* If both are positive, accept them if they are off by one second. */
5600 || (st
.st_mtime
> 0 && b
->modtime
> 0
5601 && (st
.st_mtime
== b
->modtime
+ 1
5602 || st
.st_mtime
== b
->modtime
- 1)))
5607 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5608 Sclear_visited_file_modtime
, 0, 0, 0,
5609 doc
: /* Clear out records of last mod time of visited file.
5610 Next attempt to save will certainly not complain of a discrepancy. */)
5613 current_buffer
->modtime
= 0;
5617 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5618 Svisited_file_modtime
, 0, 0, 0,
5619 doc
: /* Return the current buffer's recorded visited file modification time.
5620 The value is a list of the form (HIGH LOW), like the time values
5621 that `file-attributes' returns. If the current buffer has no recorded
5622 file modification time, this function returns 0.
5623 See Info node `(elisp)Modification Time' for more details. */)
5627 tcons
= long_to_cons ((unsigned long) current_buffer
->modtime
);
5629 return list2 (XCAR (tcons
), XCDR (tcons
));
5633 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5634 Sset_visited_file_modtime
, 0, 1, 0,
5635 doc
: /* Update buffer's recorded modification time from the visited file's time.
5636 Useful if the buffer was not read from the file normally
5637 or if the file itself has been changed for some known benign reason.
5638 An argument specifies the modification time value to use
5639 \(instead of that of the visited file), in the form of a list
5640 \(HIGH . LOW) or (HIGH LOW). */)
5642 Lisp_Object time_list
;
5644 if (!NILP (time_list
))
5645 current_buffer
->modtime
= cons_to_long (time_list
);
5648 register Lisp_Object filename
;
5650 Lisp_Object handler
;
5652 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5654 /* If the file name has special constructs in it,
5655 call the corresponding file handler. */
5656 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5657 if (!NILP (handler
))
5658 /* The handler can find the file name the same way we did. */
5659 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5661 filename
= ENCODE_FILE (filename
);
5663 if (stat (SDATA (filename
), &st
) >= 0)
5664 current_buffer
->modtime
= st
.st_mtime
;
5671 auto_save_error (error
)
5674 Lisp_Object args
[3], msg
;
5676 struct gcpro gcpro1
;
5680 args
[0] = build_string ("Auto-saving %s: %s");
5681 args
[1] = current_buffer
->name
;
5682 args
[2] = Ferror_message_string (error
);
5683 msg
= Fformat (3, args
);
5685 nbytes
= SBYTES (msg
);
5687 for (i
= 0; i
< 3; ++i
)
5690 message2 (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5692 message2_nolog (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5693 Fsleep_for (make_number (1), Qnil
);
5706 auto_save_mode_bits
= 0666;
5708 /* Get visited file's mode to become the auto save file's mode. */
5709 if (! NILP (current_buffer
->filename
))
5711 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5712 /* But make sure we can overwrite it later! */
5713 auto_save_mode_bits
= st
.st_mode
| 0600;
5714 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5716 /* Remote files don't cooperate with stat. */
5717 auto_save_mode_bits
= XINT (modes
) | 0600;
5721 Fwrite_region (Qnil
, Qnil
,
5722 current_buffer
->auto_save_file_name
,
5723 Qnil
, Qlambda
, Qnil
, Qnil
);
5727 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5732 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5733 | XFASTINT (XCDR (stream
))));
5738 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5741 minibuffer_auto_raise
= XINT (value
);
5746 do_auto_save_make_dir (dir
)
5749 return call2 (Qmake_directory
, dir
, Qt
);
5753 do_auto_save_eh (ignore
)
5759 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5760 doc
: /* Auto-save all buffers that need it.
5761 This is all buffers that have auto-saving enabled
5762 and are changed since last auto-saved.
5763 Auto-saving writes the buffer into a file
5764 so that your editing is not lost if the system crashes.
5765 This file is not the file you visited; that changes only when you save.
5766 Normally we run the normal hook `auto-save-hook' before saving.
5768 A non-nil NO-MESSAGE argument means do not print any message if successful.
5769 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5770 (no_message
, current_only
)
5771 Lisp_Object no_message
, current_only
;
5773 struct buffer
*old
= current_buffer
, *b
;
5774 Lisp_Object tail
, buf
;
5776 int do_handled_files
;
5779 Lisp_Object lispstream
;
5780 int count
= SPECPDL_INDEX ();
5781 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5782 int old_message_p
= 0;
5783 struct gcpro gcpro1
, gcpro2
;
5785 if (max_specpdl_size
< specpdl_size
+ 40)
5786 max_specpdl_size
= specpdl_size
+ 40;
5791 if (NILP (no_message
))
5793 old_message_p
= push_message ();
5794 record_unwind_protect (pop_message_unwind
, Qnil
);
5797 /* Ordinarily don't quit within this function,
5798 but don't make it impossible to quit (in case we get hung in I/O). */
5802 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5803 point to non-strings reached from Vbuffer_alist. */
5805 if (!NILP (Vrun_hooks
))
5806 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5808 if (STRINGP (Vauto_save_list_file_name
))
5810 Lisp_Object listfile
;
5812 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5814 /* Don't try to create the directory when shutting down Emacs,
5815 because creating the directory might signal an error, and
5816 that would leave Emacs in a strange state. */
5817 if (!NILP (Vrun_hooks
))
5821 GCPRO2 (dir
, listfile
);
5822 dir
= Ffile_name_directory (listfile
);
5823 if (NILP (Ffile_directory_p (dir
)))
5824 internal_condition_case_1 (do_auto_save_make_dir
,
5825 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5830 stream
= fopen (SDATA (listfile
), "w");
5833 /* Arrange to close that file whether or not we get an error.
5834 Also reset auto_saving to 0. */
5835 lispstream
= Fcons (Qnil
, Qnil
);
5836 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
5837 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
5848 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5849 record_unwind_protect (do_auto_save_unwind_1
,
5850 make_number (minibuffer_auto_raise
));
5851 minibuffer_auto_raise
= 0;
5854 /* On first pass, save all files that don't have handlers.
5855 On second pass, save all files that do have handlers.
5857 If Emacs is crashing, the handlers may tweak what is causing
5858 Emacs to crash in the first place, and it would be a shame if
5859 Emacs failed to autosave perfectly ordinary files because it
5860 couldn't handle some ange-ftp'd file. */
5862 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5863 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5865 buf
= XCDR (XCAR (tail
));
5868 /* Record all the buffers that have auto save mode
5869 in the special file that lists them. For each of these buffers,
5870 Record visited name (if any) and auto save name. */
5871 if (STRINGP (b
->auto_save_file_name
)
5872 && stream
!= NULL
&& do_handled_files
== 0)
5874 if (!NILP (b
->filename
))
5876 fwrite (SDATA (b
->filename
), 1,
5877 SBYTES (b
->filename
), stream
);
5879 putc ('\n', stream
);
5880 fwrite (SDATA (b
->auto_save_file_name
), 1,
5881 SBYTES (b
->auto_save_file_name
), stream
);
5882 putc ('\n', stream
);
5885 if (!NILP (current_only
)
5886 && b
!= current_buffer
)
5889 /* Don't auto-save indirect buffers.
5890 The base buffer takes care of it. */
5894 /* Check for auto save enabled
5895 and file changed since last auto save
5896 and file changed since last real save. */
5897 if (STRINGP (b
->auto_save_file_name
)
5898 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5899 && b
->auto_save_modified
< BUF_MODIFF (b
)
5900 /* -1 means we've turned off autosaving for a while--see below. */
5901 && XINT (b
->save_length
) >= 0
5902 && (do_handled_files
5903 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5906 EMACS_TIME before_time
, after_time
;
5908 EMACS_GET_TIME (before_time
);
5910 /* If we had a failure, don't try again for 20 minutes. */
5911 if (b
->auto_save_failure_time
>= 0
5912 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5915 if ((XFASTINT (b
->save_length
) * 10
5916 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5917 /* A short file is likely to change a large fraction;
5918 spare the user annoying messages. */
5919 && XFASTINT (b
->save_length
) > 5000
5920 /* These messages are frequent and annoying for `*mail*'. */
5921 && !EQ (b
->filename
, Qnil
)
5922 && NILP (no_message
))
5924 /* It has shrunk too much; turn off auto-saving here. */
5925 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5926 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5928 minibuffer_auto_raise
= 0;
5929 /* Turn off auto-saving until there's a real save,
5930 and prevent any more warnings. */
5931 XSETINT (b
->save_length
, -1);
5932 Fsleep_for (make_number (1), Qnil
);
5935 set_buffer_internal (b
);
5936 if (!auto_saved
&& NILP (no_message
))
5937 message1 ("Auto-saving...");
5938 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5940 b
->auto_save_modified
= BUF_MODIFF (b
);
5941 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5942 set_buffer_internal (old
);
5944 EMACS_GET_TIME (after_time
);
5946 /* If auto-save took more than 60 seconds,
5947 assume it was an NFS failure that got a timeout. */
5948 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5949 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5953 /* Prevent another auto save till enough input events come in. */
5954 record_auto_save ();
5956 if (auto_saved
&& NILP (no_message
))
5960 /* If we are going to restore an old message,
5961 give time to read ours. */
5962 sit_for (1, 0, 0, 0, 0);
5966 /* If we displayed a message and then restored a state
5967 with no message, leave a "done" message on the screen. */
5968 message1 ("Auto-saving...done");
5973 /* This restores the message-stack status. */
5974 unbind_to (count
, Qnil
);
5978 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
5979 Sset_buffer_auto_saved
, 0, 0, 0,
5980 doc
: /* Mark current buffer as auto-saved with its current text.
5981 No auto-save file will be written until the buffer changes again. */)
5984 current_buffer
->auto_save_modified
= MODIFF
;
5985 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5986 current_buffer
->auto_save_failure_time
= -1;
5990 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
5991 Sclear_buffer_auto_save_failure
, 0, 0, 0,
5992 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
5995 current_buffer
->auto_save_failure_time
= -1;
5999 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6001 doc
: /* Return t if current buffer has been auto-saved recently.
6002 More precisely, if it has been auto-saved since last read from or saved
6003 in the visited file. If the buffer has no visited file,
6004 then any auto-save counts as "recent". */)
6007 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6010 /* Reading and completing file names */
6011 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
6013 /* In the string VAL, change each $ to $$ and return the result. */
6016 double_dollars (val
)
6019 register const unsigned char *old
;
6020 register unsigned char *new;
6024 osize
= SBYTES (val
);
6026 /* Count the number of $ characters. */
6027 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
6028 if (*old
++ == '$') count
++;
6032 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
6035 for (n
= osize
; n
> 0; n
--)
6049 read_file_name_cleanup (arg
)
6052 return (current_buffer
->directory
= arg
);
6055 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
6057 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
6058 (string
, dir
, action
)
6059 Lisp_Object string
, dir
, action
;
6060 /* action is nil for complete, t for return list of completions,
6061 lambda for verify final value */
6063 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
6065 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
6067 CHECK_STRING (string
);
6074 /* No need to protect ACTION--we only compare it with t and nil. */
6075 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6077 if (SCHARS (string
) == 0)
6079 if (EQ (action
, Qlambda
))
6087 orig_string
= string
;
6088 string
= Fsubstitute_in_file_name (string
);
6089 changed
= NILP (Fstring_equal (string
, orig_string
));
6090 name
= Ffile_name_nondirectory (string
);
6091 val
= Ffile_name_directory (string
);
6093 realdir
= Fexpand_file_name (val
, realdir
);
6098 specdir
= Ffile_name_directory (string
);
6099 val
= Ffile_name_completion (name
, realdir
);
6104 return double_dollars (string
);
6108 if (!NILP (specdir
))
6109 val
= concat2 (specdir
, val
);
6111 return double_dollars (val
);
6114 #endif /* not VMS */
6118 if (EQ (action
, Qt
))
6120 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6124 if (NILP (Vread_file_name_predicate
)
6125 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6129 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6131 /* Brute-force speed up for directory checking:
6132 Discard strings which don't end in a slash. */
6133 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6135 Lisp_Object tem
= XCAR (all
);
6137 if (STRINGP (tem
) &&
6138 (len
= SCHARS (tem
), len
> 0) &&
6139 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6140 comp
= Fcons (tem
, comp
);
6146 /* Must do it the hard (and slow) way. */
6147 GCPRO3 (all
, comp
, specdir
);
6148 count
= SPECPDL_INDEX ();
6149 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6150 current_buffer
->directory
= realdir
;
6151 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6152 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
6153 comp
= Fcons (XCAR (all
), comp
);
6154 unbind_to (count
, Qnil
);
6157 return Fnreverse (comp
);
6160 /* Only other case actually used is ACTION = lambda */
6162 /* Supposedly this helps commands such as `cd' that read directory names,
6163 but can someone explain how it helps them? -- RMS */
6164 if (SCHARS (name
) == 0)
6167 string
= Fexpand_file_name (string
, dir
);
6168 if (!NILP (Vread_file_name_predicate
))
6169 return call1 (Vread_file_name_predicate
, string
);
6170 return Ffile_exists_p (string
);
6173 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
6174 Snext_read_file_uses_dialog_p
, 0, 0, 0,
6175 doc
: /* Return t if a call to `read-file-name' will use a dialog.
6176 The return value is only relevant for a call to `read-file-name' that happens
6177 before any other event (mouse or keypress) is handeled. */)
6180 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6181 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6190 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6191 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6192 Value is not expanded---you must call `expand-file-name' yourself.
6193 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6194 the same non-empty string that was inserted by this function.
6195 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6196 except that if INITIAL is specified, that combined with DIR is used.)
6197 If the user exits with an empty minibuffer, this function returns
6198 an empty string. (This can only happen if the user erased the
6199 pre-inserted contents or if `insert-default-directory' is nil.)
6200 Fourth arg MUSTMATCH non-nil means require existing file's name.
6201 Non-nil and non-t means also require confirmation after completion.
6202 Fifth arg INITIAL specifies text to start with.
6203 If optional sixth arg PREDICATE is non-nil, possible completions and
6204 the resulting file name must satisfy (funcall PREDICATE NAME).
6205 DIR should be an absolute directory name. It defaults to the value of
6206 `default-directory'.
6208 If this command was invoked with the mouse, use a file dialog box if
6209 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6210 provides a file dialog box.
6212 See also `read-file-name-completion-ignore-case'
6213 and `read-file-name-function'. */)
6214 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6215 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6217 Lisp_Object val
, insdef
, tem
;
6218 struct gcpro gcpro1
, gcpro2
;
6219 register char *homedir
;
6220 Lisp_Object decoded_homedir
;
6221 int replace_in_history
= 0;
6222 int add_to_history
= 0;
6226 dir
= current_buffer
->directory
;
6227 if (NILP (Ffile_name_absolute_p (dir
)))
6228 dir
= Fexpand_file_name (dir
, Qnil
);
6229 if (NILP (default_filename
))
6232 ? Fexpand_file_name (initial
, dir
)
6233 : current_buffer
->filename
);
6235 /* If dir starts with user's homedir, change that to ~. */
6236 homedir
= (char *) egetenv ("HOME");
6238 /* homedir can be NULL in temacs, since Vprocess_environment is not
6239 yet set up. We shouldn't crash in that case. */
6242 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6243 CORRECT_DIR_SEPS (homedir
);
6248 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6251 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6252 SBYTES (decoded_homedir
))
6253 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6255 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6256 dir
= concat2 (build_string ("~"), dir
);
6258 /* Likewise for default_filename. */
6260 && STRINGP (default_filename
)
6261 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6262 SBYTES (decoded_homedir
))
6263 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6266 = Fsubstring (default_filename
,
6267 make_number (SCHARS (decoded_homedir
)), Qnil
);
6268 default_filename
= concat2 (build_string ("~"), default_filename
);
6270 if (!NILP (default_filename
))
6272 CHECK_STRING (default_filename
);
6273 default_filename
= double_dollars (default_filename
);
6276 if (insert_default_directory
&& STRINGP (dir
))
6279 if (!NILP (initial
))
6281 Lisp_Object args
[2], pos
;
6285 insdef
= Fconcat (2, args
);
6286 pos
= make_number (SCHARS (double_dollars (dir
)));
6287 insdef
= Fcons (double_dollars (insdef
), pos
);
6290 insdef
= double_dollars (insdef
);
6292 else if (STRINGP (initial
))
6293 insdef
= Fcons (double_dollars (initial
), make_number (0));
6297 if (!NILP (Vread_file_name_function
))
6299 Lisp_Object args
[7];
6301 GCPRO2 (insdef
, default_filename
);
6302 args
[0] = Vread_file_name_function
;
6305 args
[3] = default_filename
;
6306 args
[4] = mustmatch
;
6308 args
[6] = predicate
;
6309 RETURN_UNGCPRO (Ffuncall (7, args
));
6312 count
= SPECPDL_INDEX ();
6313 specbind (intern ("completion-ignore-case"),
6314 read_file_name_completion_ignore_case
? Qt
: Qnil
);
6315 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6316 specbind (intern ("read-file-name-predicate"),
6317 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6319 GCPRO2 (insdef
, default_filename
);
6321 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6322 if (! NILP (Fnext_read_file_uses_dialog_p ()))
6324 /* If DIR contains a file name, split it. */
6326 file
= Ffile_name_nondirectory (dir
);
6327 if (SCHARS (file
) && NILP (default_filename
))
6329 default_filename
= file
;
6330 dir
= Ffile_name_directory (dir
);
6332 if (!NILP(default_filename
))
6333 default_filename
= Fexpand_file_name (default_filename
, dir
);
6334 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
,
6335 EQ (predicate
, Qfile_directory_p
) ? Qt
: Qnil
);
6340 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6341 dir
, mustmatch
, insdef
,
6342 Qfile_name_history
, default_filename
, Qnil
);
6344 tem
= Fsymbol_value (Qfile_name_history
);
6345 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6346 replace_in_history
= 1;
6348 /* If Fcompleting_read returned the inserted default string itself
6349 (rather than a new string with the same contents),
6350 it has to mean that the user typed RET with the minibuffer empty.
6351 In that case, we really want to return ""
6352 so that commands such as set-visited-file-name can distinguish. */
6353 if (EQ (val
, default_filename
))
6355 /* In this case, Fcompleting_read has not added an element
6356 to the history. Maybe we should. */
6357 if (! replace_in_history
)
6363 unbind_to (count
, Qnil
);
6366 error ("No file name specified");
6368 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6370 if (!NILP (tem
) && !NILP (default_filename
))
6371 val
= default_filename
;
6372 val
= Fsubstitute_in_file_name (val
);
6374 if (replace_in_history
)
6375 /* Replace what Fcompleting_read added to the history
6376 with what we will actually return. */
6378 Lisp_Object val1
= double_dollars (val
);
6379 tem
= Fsymbol_value (Qfile_name_history
);
6380 if (history_delete_duplicates
)
6381 XSETCDR (tem
, Fdelete (val1
, XCDR(tem
)));
6382 XSETCAR (tem
, val1
);
6384 else if (add_to_history
)
6386 /* Add the value to the history--but not if it matches
6387 the last value already there. */
6388 Lisp_Object val1
= double_dollars (val
);
6389 tem
= Fsymbol_value (Qfile_name_history
);
6390 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6392 if (history_delete_duplicates
) tem
= Fdelete (val1
, tem
);
6393 Fset (Qfile_name_history
, Fcons (val1
, tem
));
6404 /* Must be set before any path manipulation is performed. */
6405 XSETFASTINT (Vdirectory_sep_char
, '/');
6412 Qoperations
= intern ("operations");
6413 Qexpand_file_name
= intern ("expand-file-name");
6414 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6415 Qdirectory_file_name
= intern ("directory-file-name");
6416 Qfile_name_directory
= intern ("file-name-directory");
6417 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6418 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6419 Qfile_name_as_directory
= intern ("file-name-as-directory");
6420 Qcopy_file
= intern ("copy-file");
6421 Qmake_directory_internal
= intern ("make-directory-internal");
6422 Qmake_directory
= intern ("make-directory");
6423 Qdelete_directory
= intern ("delete-directory");
6424 Qdelete_file
= intern ("delete-file");
6425 Qrename_file
= intern ("rename-file");
6426 Qadd_name_to_file
= intern ("add-name-to-file");
6427 Qmake_symbolic_link
= intern ("make-symbolic-link");
6428 Qfile_exists_p
= intern ("file-exists-p");
6429 Qfile_executable_p
= intern ("file-executable-p");
6430 Qfile_readable_p
= intern ("file-readable-p");
6431 Qfile_writable_p
= intern ("file-writable-p");
6432 Qfile_symlink_p
= intern ("file-symlink-p");
6433 Qaccess_file
= intern ("access-file");
6434 Qfile_directory_p
= intern ("file-directory-p");
6435 Qfile_regular_p
= intern ("file-regular-p");
6436 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6437 Qfile_modes
= intern ("file-modes");
6438 Qset_file_modes
= intern ("set-file-modes");
6439 Qset_file_times
= intern ("set-file-times");
6440 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6441 Qinsert_file_contents
= intern ("insert-file-contents");
6442 Qwrite_region
= intern ("write-region");
6443 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6444 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6445 Qauto_save_coding
= intern ("auto-save-coding");
6447 staticpro (&Qoperations
);
6448 staticpro (&Qexpand_file_name
);
6449 staticpro (&Qsubstitute_in_file_name
);
6450 staticpro (&Qdirectory_file_name
);
6451 staticpro (&Qfile_name_directory
);
6452 staticpro (&Qfile_name_nondirectory
);
6453 staticpro (&Qunhandled_file_name_directory
);
6454 staticpro (&Qfile_name_as_directory
);
6455 staticpro (&Qcopy_file
);
6456 staticpro (&Qmake_directory_internal
);
6457 staticpro (&Qmake_directory
);
6458 staticpro (&Qdelete_directory
);
6459 staticpro (&Qdelete_file
);
6460 staticpro (&Qrename_file
);
6461 staticpro (&Qadd_name_to_file
);
6462 staticpro (&Qmake_symbolic_link
);
6463 staticpro (&Qfile_exists_p
);
6464 staticpro (&Qfile_executable_p
);
6465 staticpro (&Qfile_readable_p
);
6466 staticpro (&Qfile_writable_p
);
6467 staticpro (&Qaccess_file
);
6468 staticpro (&Qfile_symlink_p
);
6469 staticpro (&Qfile_directory_p
);
6470 staticpro (&Qfile_regular_p
);
6471 staticpro (&Qfile_accessible_directory_p
);
6472 staticpro (&Qfile_modes
);
6473 staticpro (&Qset_file_modes
);
6474 staticpro (&Qset_file_times
);
6475 staticpro (&Qfile_newer_than_file_p
);
6476 staticpro (&Qinsert_file_contents
);
6477 staticpro (&Qwrite_region
);
6478 staticpro (&Qverify_visited_file_modtime
);
6479 staticpro (&Qset_visited_file_modtime
);
6480 staticpro (&Qauto_save_coding
);
6482 Qfile_name_history
= intern ("file-name-history");
6483 Fset (Qfile_name_history
, Qnil
);
6484 staticpro (&Qfile_name_history
);
6486 Qfile_error
= intern ("file-error");
6487 staticpro (&Qfile_error
);
6488 Qfile_already_exists
= intern ("file-already-exists");
6489 staticpro (&Qfile_already_exists
);
6490 Qfile_date_error
= intern ("file-date-error");
6491 staticpro (&Qfile_date_error
);
6492 Qexcl
= intern ("excl");
6496 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6497 staticpro (&Qfind_buffer_file_type
);
6500 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6501 doc
: /* *Coding system for encoding file names.
6502 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6503 Vfile_name_coding_system
= Qnil
;
6505 DEFVAR_LISP ("default-file-name-coding-system",
6506 &Vdefault_file_name_coding_system
,
6507 doc
: /* Default coding system for encoding file names.
6508 This variable is used only when `file-name-coding-system' is nil.
6510 This variable is set/changed by the command `set-language-environment'.
6511 User should not set this variable manually,
6512 instead use `file-name-coding-system' to get a constant encoding
6513 of file names regardless of the current language environment. */);
6514 Vdefault_file_name_coding_system
= Qnil
;
6516 Qformat_decode
= intern ("format-decode");
6517 staticpro (&Qformat_decode
);
6518 Qformat_annotate_function
= intern ("format-annotate-function");
6519 staticpro (&Qformat_annotate_function
);
6520 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6521 staticpro (&Qafter_insert_file_set_coding
);
6523 Qcar_less_than_car
= intern ("car-less-than-car");
6524 staticpro (&Qcar_less_than_car
);
6526 Fput (Qfile_error
, Qerror_conditions
,
6527 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6528 Fput (Qfile_error
, Qerror_message
,
6529 build_string ("File error"));
6531 Fput (Qfile_already_exists
, Qerror_conditions
,
6532 Fcons (Qfile_already_exists
,
6533 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6534 Fput (Qfile_already_exists
, Qerror_message
,
6535 build_string ("File already exists"));
6537 Fput (Qfile_date_error
, Qerror_conditions
,
6538 Fcons (Qfile_date_error
,
6539 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6540 Fput (Qfile_date_error
, Qerror_message
,
6541 build_string ("Cannot set file date"));
6543 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6544 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6545 Vread_file_name_function
= Qnil
;
6547 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6548 doc
: /* Current predicate used by `read-file-name-internal'. */);
6549 Vread_file_name_predicate
= Qnil
;
6551 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case
,
6552 doc
: /* *Non-nil means when reading a file name completion ignores case. */);
6553 #if defined VMS || defined DOS_NT || defined MAC_OS
6554 read_file_name_completion_ignore_case
= 1;
6556 read_file_name_completion_ignore_case
= 0;
6559 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6560 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6561 If the initial minibuffer contents are non-empty, you can usually
6562 request a default filename by typing RETURN without editing. For some
6563 commands, exiting with an empty minibuffer has a special meaning,
6564 such as making the current buffer visit no file in the case of
6565 `set-visited-file-name'.
6566 If this variable is non-nil, the minibuffer contents are always
6567 initially non-empty and typing RETURN without editing will fetch the
6568 default name, if one is provided. Note however that this default name
6569 is not necessarily the name originally inserted in the minibuffer, if
6570 that is just the default directory.
6571 If this variable is nil, the minibuffer often starts out empty. In
6572 that case you may have to explicitly fetch the next history element to
6573 request the default name. */);
6574 insert_default_directory
= 1;
6576 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6577 doc
: /* *Non-nil means write new files with record format `stmlf'.
6578 nil means use format `var'. This variable is meaningful only on VMS. */);
6579 vms_stmlf_recfm
= 0;
6581 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6582 doc
: /* Directory separator character for built-in functions that return file names.
6583 The value is always ?/. Don't use this variable, just use `/'. */);
6585 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6586 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6587 If a file name matches REGEXP, then all I/O on that file is done by calling
6590 The first argument given to HANDLER is the name of the I/O primitive
6591 to be handled; the remaining arguments are the arguments that were
6592 passed to that primitive. For example, if you do
6593 (file-exists-p FILENAME)
6594 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6595 (funcall HANDLER 'file-exists-p FILENAME)
6596 The function `find-file-name-handler' checks this list for a handler
6597 for its argument. */);
6598 Vfile_name_handler_alist
= Qnil
;
6600 DEFVAR_LISP ("set-auto-coding-function",
6601 &Vset_auto_coding_function
,
6602 doc
: /* If non-nil, a function to call to decide a coding system of file.
6603 Two arguments are passed to this function: the file name
6604 and the length of a file contents following the point.
6605 This function should return a coding system to decode the file contents.
6606 It should check the file name against `auto-coding-alist'.
6607 If no coding system is decided, it should check a coding system
6608 specified in the heading lines with the format:
6609 -*- ... coding: CODING-SYSTEM; ... -*-
6610 or local variable spec of the tailing lines with `coding:' tag. */);
6611 Vset_auto_coding_function
= Qnil
;
6613 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6614 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6615 Each is passed one argument, the number of characters inserted.
6616 It should return the new character count, and leave point the same.
6617 If `insert-file-contents' is intercepted by a handler from
6618 `file-name-handler-alist', that handler is responsible for calling the
6619 functions in `after-insert-file-functions' if appropriate. */);
6620 Vafter_insert_file_functions
= Qnil
;
6622 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6623 doc
: /* A list of functions to be called at the start of `write-region'.
6624 Each is passed two arguments, START and END as for `write-region'.
6625 These are usually two numbers but not always; see the documentation
6626 for `write-region'. The function should return a list of pairs
6627 of the form (POSITION . STRING), consisting of strings to be effectively
6628 inserted at the specified positions of the file being written (1 means to
6629 insert before the first byte written). The POSITIONs must be sorted into
6630 increasing order. If there are several functions in the list, the several
6631 lists are merged destructively. Alternatively, the function can return
6632 with a different buffer current; in that case it should pay attention
6633 to the annotations returned by previous functions and listed in
6634 `write-region-annotations-so-far'.*/);
6635 Vwrite_region_annotate_functions
= Qnil
;
6636 staticpro (&Qwrite_region_annotate_functions
);
6637 Qwrite_region_annotate_functions
6638 = intern ("write-region-annotate-functions");
6640 DEFVAR_LISP ("write-region-annotations-so-far",
6641 &Vwrite_region_annotations_so_far
,
6642 doc
: /* When an annotation function is called, this holds the previous annotations.
6643 These are the annotations made by other annotation functions
6644 that were already called. See also `write-region-annotate-functions'. */);
6645 Vwrite_region_annotations_so_far
= Qnil
;
6647 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6648 doc
: /* A list of file name handlers that temporarily should not be used.
6649 This applies only to the operation `inhibit-file-name-operation'. */);
6650 Vinhibit_file_name_handlers
= Qnil
;
6652 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6653 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6654 Vinhibit_file_name_operation
= Qnil
;
6656 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6657 doc
: /* File name in which we write a list of all auto save file names.
6658 This variable is initialized automatically from `auto-save-list-file-prefix'
6659 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6660 a non-nil value. */);
6661 Vauto_save_list_file_name
= Qnil
;
6663 defsubr (&Sfind_file_name_handler
);
6664 defsubr (&Sfile_name_directory
);
6665 defsubr (&Sfile_name_nondirectory
);
6666 defsubr (&Sunhandled_file_name_directory
);
6667 defsubr (&Sfile_name_as_directory
);
6668 defsubr (&Sdirectory_file_name
);
6669 defsubr (&Smake_temp_name
);
6670 defsubr (&Sexpand_file_name
);
6671 defsubr (&Ssubstitute_in_file_name
);
6672 defsubr (&Scopy_file
);
6673 defsubr (&Smake_directory_internal
);
6674 defsubr (&Sdelete_directory
);
6675 defsubr (&Sdelete_file
);
6676 defsubr (&Srename_file
);
6677 defsubr (&Sadd_name_to_file
);
6679 defsubr (&Smake_symbolic_link
);
6680 #endif /* S_IFLNK */
6682 defsubr (&Sdefine_logical_name
);
6685 defsubr (&Ssysnetunam
);
6686 #endif /* HPUX_NET */
6687 defsubr (&Sfile_name_absolute_p
);
6688 defsubr (&Sfile_exists_p
);
6689 defsubr (&Sfile_executable_p
);
6690 defsubr (&Sfile_readable_p
);
6691 defsubr (&Sfile_writable_p
);
6692 defsubr (&Saccess_file
);
6693 defsubr (&Sfile_symlink_p
);
6694 defsubr (&Sfile_directory_p
);
6695 defsubr (&Sfile_accessible_directory_p
);
6696 defsubr (&Sfile_regular_p
);
6697 defsubr (&Sfile_modes
);
6698 defsubr (&Sset_file_modes
);
6699 defsubr (&Sset_file_times
);
6700 defsubr (&Sset_default_file_modes
);
6701 defsubr (&Sdefault_file_modes
);
6702 defsubr (&Sfile_newer_than_file_p
);
6703 defsubr (&Sinsert_file_contents
);
6704 defsubr (&Swrite_region
);
6705 defsubr (&Scar_less_than_car
);
6706 defsubr (&Sverify_visited_file_modtime
);
6707 defsubr (&Sclear_visited_file_modtime
);
6708 defsubr (&Svisited_file_modtime
);
6709 defsubr (&Sset_visited_file_modtime
);
6710 defsubr (&Sdo_auto_save
);
6711 defsubr (&Sset_buffer_auto_saved
);
6712 defsubr (&Sclear_buffer_auto_save_failure
);
6713 defsubr (&Srecent_auto_save_p
);
6715 defsubr (&Sread_file_name_internal
);
6716 defsubr (&Sread_file_name
);
6717 defsubr (&Snext_read_file_uses_dialog_p
);
6720 defsubr (&Sunix_sync
);
6724 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6725 (do not change this comment) */