1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996, 1997, 1998,
3 1999, 2000, 2001, 2003, 2004, 2005 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
29 #include <sys/types.h>
36 #if !defined (S_ISLNK) && defined (S_IFLNK)
37 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
40 #if !defined (S_ISFIFO) && defined (S_IFIFO)
41 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
44 #if !defined (S_ISREG) && defined (S_IFREG)
45 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
74 #include "intervals.h"
85 #endif /* not WINDOWSNT */
89 #include <sys/param.h>
97 #define CORRECT_DIR_SEPS(s) \
98 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
99 else unixtodos_filename (s); \
101 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
102 redirector allows the six letters between 'Z' and 'a' as well. */
104 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
107 #define IS_DRIVE(x) isalpha (x)
109 /* Need to lower-case the drive letter, or else expanded
110 filenames will sometimes compare inequal, because
111 `expand-file-name' doesn't always down-case the drive letter. */
112 #define DRIVE_LETTER(x) (tolower (x))
133 #include "commands.h"
134 extern int use_dialog_box
;
135 extern int use_file_dialog
;
149 #ifndef FILE_SYSTEM_CASE
150 #define FILE_SYSTEM_CASE(filename) (filename)
153 /* Nonzero during writing of auto-save files */
156 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
157 a new file with the same mode as the original */
158 int auto_save_mode_bits
;
160 /* The symbol bound to coding-system-for-read when
161 insert-file-contents is called for recovering a file. This is not
162 an actual coding system name, but just an indicator to tell
163 insert-file-contents to use `emacs-mule' with a special flag for
164 auto saving and recovering a file. */
165 Lisp_Object Qauto_save_coding
;
167 /* Coding system for file names, or nil if none. */
168 Lisp_Object Vfile_name_coding_system
;
170 /* Coding system for file names used only when
171 Vfile_name_coding_system is nil. */
172 Lisp_Object Vdefault_file_name_coding_system
;
174 /* Alist of elements (REGEXP . HANDLER) for file names
175 whose I/O is done with a special handler. */
176 Lisp_Object Vfile_name_handler_alist
;
178 /* Lisp functions for translating file formats */
179 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
181 /* Function to be called to decide a coding system of a reading file. */
182 Lisp_Object Vset_auto_coding_function
;
184 /* Functions to be called to process text properties in inserted file. */
185 Lisp_Object Vafter_insert_file_functions
;
187 /* Lisp function for setting buffer-file-coding-system and the
188 multibyteness of the current buffer after inserting a file. */
189 Lisp_Object Qafter_insert_file_set_coding
;
191 /* Functions to be called to create text property annotations for file. */
192 Lisp_Object Vwrite_region_annotate_functions
;
193 Lisp_Object Qwrite_region_annotate_functions
;
195 /* During build_annotations, each time an annotation function is called,
196 this holds the annotations made by the previous functions. */
197 Lisp_Object Vwrite_region_annotations_so_far
;
199 /* File name in which we write a list of all our auto save files. */
200 Lisp_Object Vauto_save_list_file_name
;
202 /* Function to call to read a file name. */
203 Lisp_Object Vread_file_name_function
;
205 /* Current predicate used by read_file_name_internal. */
206 Lisp_Object Vread_file_name_predicate
;
208 /* Nonzero means completion ignores case when reading file name. */
209 int read_file_name_completion_ignore_case
;
211 /* Nonzero means, when reading a filename in the minibuffer,
212 start out by inserting the default directory into the minibuffer. */
213 int insert_default_directory
;
215 /* On VMS, nonzero means write new files with record format stmlf.
216 Zero means use var format. */
219 /* On NT, specifies the directory separator character, used (eg.) when
220 expanding file names. This can be bound to / or \. */
221 Lisp_Object Vdirectory_sep_char
;
223 extern Lisp_Object Vuser_login_name
;
226 extern Lisp_Object Vw32_get_true_file_attributes
;
229 extern int minibuf_level
;
231 extern int minibuffer_auto_raise
;
233 extern int history_delete_duplicates
;
235 /* These variables describe handlers that have "already" had a chance
236 to handle the current operation.
238 Vinhibit_file_name_handlers is a list of file name handlers.
239 Vinhibit_file_name_operation is the operation being handled.
240 If we try to handle that operation, we ignore those handlers. */
242 static Lisp_Object Vinhibit_file_name_handlers
;
243 static Lisp_Object Vinhibit_file_name_operation
;
245 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
247 Lisp_Object Qfile_name_history
;
249 Lisp_Object Qcar_less_than_car
;
251 static int a_write
P_ ((int, Lisp_Object
, int, int,
252 Lisp_Object
*, struct coding_system
*));
253 static int e_write
P_ ((int, Lisp_Object
, int, int, struct coding_system
*));
257 report_file_error (string
, data
)
261 Lisp_Object errstring
;
264 synchronize_system_messages_locale ();
265 errstring
= code_convert_string_norecord (build_string (strerror (errorno
)),
266 Vlocale_coding_system
, 0);
272 Fsignal (Qfile_already_exists
, Fcons (errstring
, data
));
275 /* System error messages are capitalized. Downcase the initial
276 unless it is followed by a slash. */
277 if (SREF (errstring
, 1) != '/')
278 SSET (errstring
, 0, DOWNCASE (SREF (errstring
, 0)));
280 Fsignal (Qfile_error
,
281 Fcons (build_string (string
), Fcons (errstring
, data
)));
286 close_file_unwind (fd
)
289 emacs_close (XFASTINT (fd
));
293 /* Restore point, having saved it as a marker. */
296 restore_point_unwind (location
)
297 Lisp_Object location
;
299 Fgoto_char (location
);
300 Fset_marker (location
, Qnil
, Qnil
);
304 Lisp_Object Qexpand_file_name
;
305 Lisp_Object Qsubstitute_in_file_name
;
306 Lisp_Object Qdirectory_file_name
;
307 Lisp_Object Qfile_name_directory
;
308 Lisp_Object Qfile_name_nondirectory
;
309 Lisp_Object Qunhandled_file_name_directory
;
310 Lisp_Object Qfile_name_as_directory
;
311 Lisp_Object Qcopy_file
;
312 Lisp_Object Qmake_directory_internal
;
313 Lisp_Object Qmake_directory
;
314 Lisp_Object Qdelete_directory
;
315 Lisp_Object Qdelete_file
;
316 Lisp_Object Qrename_file
;
317 Lisp_Object Qadd_name_to_file
;
318 Lisp_Object Qmake_symbolic_link
;
319 Lisp_Object Qfile_exists_p
;
320 Lisp_Object Qfile_executable_p
;
321 Lisp_Object Qfile_readable_p
;
322 Lisp_Object Qfile_writable_p
;
323 Lisp_Object Qfile_symlink_p
;
324 Lisp_Object Qaccess_file
;
325 Lisp_Object Qfile_directory_p
;
326 Lisp_Object Qfile_regular_p
;
327 Lisp_Object Qfile_accessible_directory_p
;
328 Lisp_Object Qfile_modes
;
329 Lisp_Object Qset_file_modes
;
330 Lisp_Object Qset_file_times
;
331 Lisp_Object Qfile_newer_than_file_p
;
332 Lisp_Object Qinsert_file_contents
;
333 Lisp_Object Qwrite_region
;
334 Lisp_Object Qverify_visited_file_modtime
;
335 Lisp_Object Qset_visited_file_modtime
;
337 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
338 doc
: /* Return FILENAME's handler function for OPERATION, if it has one.
339 Otherwise, return nil.
340 A file name is handled if one of the regular expressions in
341 `file-name-handler-alist' matches it.
343 If OPERATION equals `inhibit-file-name-operation', then we ignore
344 any handlers that are members of `inhibit-file-name-handlers',
345 but we still do run any other handlers. This lets handlers
346 use the standard functions without calling themselves recursively. */)
347 (filename
, operation
)
348 Lisp_Object filename
, operation
;
350 /* This function must not munge the match data. */
351 Lisp_Object chain
, inhibited_handlers
, result
;
355 CHECK_STRING (filename
);
357 if (EQ (operation
, Vinhibit_file_name_operation
))
358 inhibited_handlers
= Vinhibit_file_name_handlers
;
360 inhibited_handlers
= Qnil
;
362 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
363 chain
= XCDR (chain
))
373 && (match_pos
= fast_string_match (string
, filename
)) > pos
)
375 Lisp_Object handler
, tem
;
377 handler
= XCDR (elt
);
378 tem
= Fmemq (handler
, inhibited_handlers
);
392 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
394 doc
: /* Return the directory component in file name FILENAME.
395 Return nil if FILENAME does not include a directory.
396 Otherwise return a directory spec.
397 Given a Unix syntax file name, returns a string ending in slash;
398 on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
400 Lisp_Object filename
;
403 register const unsigned char *beg
;
405 register unsigned char *beg
;
407 register const unsigned char *p
;
410 CHECK_STRING (filename
);
412 /* If the file name has special constructs in it,
413 call the corresponding file handler. */
414 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
416 return call2 (handler
, Qfile_name_directory
, filename
);
418 filename
= FILE_SYSTEM_CASE (filename
);
419 beg
= SDATA (filename
);
421 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
423 p
= beg
+ SBYTES (filename
);
425 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
427 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
430 /* only recognise drive specifier at the beginning */
432 /* handle the "/:d:foo" and "/:foo" cases correctly */
433 && ((p
== beg
+ 2 && !IS_DIRECTORY_SEP (*beg
))
434 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
441 /* Expansion of "c:" to drive and default directory. */
444 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
445 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
446 unsigned char *r
= res
;
448 if (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
) && beg
[1] == ':')
450 strncpy (res
, beg
, 2);
455 if (getdefdir (toupper (*beg
) - 'A' + 1, r
))
457 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
460 p
= beg
+ strlen (beg
);
463 CORRECT_DIR_SEPS (beg
);
466 return make_specified_string (beg
, -1, p
- beg
, STRING_MULTIBYTE (filename
));
469 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
470 Sfile_name_nondirectory
, 1, 1, 0,
471 doc
: /* Return file name FILENAME sans its directory.
472 For example, in a Unix-syntax file name,
473 this is everything after the last slash,
474 or the entire name if it contains no slash. */)
476 Lisp_Object filename
;
478 register const unsigned char *beg
, *p
, *end
;
481 CHECK_STRING (filename
);
483 /* If the file name has special constructs in it,
484 call the corresponding file handler. */
485 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
487 return call2 (handler
, Qfile_name_nondirectory
, filename
);
489 beg
= SDATA (filename
);
490 end
= p
= beg
+ SBYTES (filename
);
492 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
494 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
497 /* only recognise drive specifier at beginning */
499 /* handle the "/:d:foo" case correctly */
500 && (p
== beg
+ 2 || (p
== beg
+ 4 && IS_DIRECTORY_SEP (*beg
))))
505 return make_specified_string (p
, -1, end
- p
, STRING_MULTIBYTE (filename
));
508 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
509 Sunhandled_file_name_directory
, 1, 1, 0,
510 doc
: /* Return a directly usable directory name somehow associated with FILENAME.
511 A `directly usable' directory name is one that may be used without the
512 intervention of any file handler.
513 If FILENAME is a directly usable file itself, return
514 \(file-name-directory FILENAME).
515 The `call-process' and `start-process' functions use this function to
516 get a current directory to run processes in. */)
518 Lisp_Object filename
;
522 /* If the file name has special constructs in it,
523 call the corresponding file handler. */
524 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
526 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
528 return Ffile_name_directory (filename
);
533 file_name_as_directory (out
, in
)
536 int size
= strlen (in
) - 1;
549 /* Is it already a directory string? */
550 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
552 /* Is it a VMS directory file name? If so, hack VMS syntax. */
553 else if (! index (in
, '/')
554 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
555 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
556 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
557 || ! strncmp (&in
[size
- 5], ".dir", 4))
558 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
559 && in
[size
] == '1')))
561 register char *p
, *dot
;
565 dir:x.dir --> dir:[x]
566 dir:[x]y.dir --> dir:[x.y] */
568 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
571 strncpy (out
, in
, p
- in
);
590 dot
= index (p
, '.');
593 /* blindly remove any extension */
594 size
= strlen (out
) + (dot
- p
);
595 strncat (out
, p
, dot
- p
);
606 /* For Unix syntax, Append a slash if necessary */
607 if (!IS_DIRECTORY_SEP (out
[size
]))
609 /* Cannot use DIRECTORY_SEP, which could have any value */
611 out
[size
+ 2] = '\0';
614 CORRECT_DIR_SEPS (out
);
620 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
621 Sfile_name_as_directory
, 1, 1, 0,
622 doc
: /* Return a string representing the file name FILE interpreted as a directory.
623 This operation exists because a directory is also a file, but its name as
624 a directory is different from its name as a file.
625 The result can be used as the value of `default-directory'
626 or passed as second argument to `expand-file-name'.
627 For a Unix-syntax file name, just appends a slash.
628 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc. */)
639 /* If the file name has special constructs in it,
640 call the corresponding file handler. */
641 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
643 return call2 (handler
, Qfile_name_as_directory
, file
);
645 buf
= (char *) alloca (SBYTES (file
) + 10);
646 file_name_as_directory (buf
, SDATA (file
));
647 return make_specified_string (buf
, -1, strlen (buf
),
648 STRING_MULTIBYTE (file
));
652 * Convert from directory name to filename.
654 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
655 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
656 * On UNIX, it's simple: just make sure there isn't a terminating /
658 * Value is nonzero if the string output is different from the input.
662 directory_file_name (src
, dst
)
670 struct FAB fab
= cc$rms_fab
;
671 struct NAM nam
= cc$rms_nam
;
672 char esa
[NAM$C_MAXRSS
];
677 if (! index (src
, '/')
678 && (src
[slen
- 1] == ']'
679 || src
[slen
- 1] == ':'
680 || src
[slen
- 1] == '>'))
682 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
684 fab
.fab$b_fns
= slen
;
685 fab
.fab$l_nam
= &nam
;
686 fab
.fab$l_fop
= FAB$M_NAM
;
689 nam
.nam$b_ess
= sizeof esa
;
690 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
692 /* We call SYS$PARSE to handle such things as [--] for us. */
693 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
695 slen
= nam
.nam$b_esl
;
696 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
701 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
703 /* what about when we have logical_name:???? */
704 if (src
[slen
- 1] == ':')
705 { /* Xlate logical name and see what we get */
706 ptr
= strcpy (dst
, src
); /* upper case for getenv */
709 if ('a' <= *ptr
&& *ptr
<= 'z')
713 dst
[slen
- 1] = 0; /* remove colon */
714 if (!(src
= egetenv (dst
)))
716 /* should we jump to the beginning of this procedure?
717 Good points: allows us to use logical names that xlate
719 Bad points: can be a problem if we just translated to a device
721 For now, I'll punt and always expect VMS names, and hope for
724 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
725 { /* no recursion here! */
731 { /* not a directory spec */
736 bracket
= src
[slen
- 1];
738 /* If bracket is ']' or '>', bracket - 2 is the corresponding
740 ptr
= index (src
, bracket
- 2);
742 { /* no opening bracket */
746 if (!(rptr
= rindex (src
, '.')))
749 strncpy (dst
, src
, slen
);
753 dst
[slen
++] = bracket
;
758 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
759 then translate the device and recurse. */
760 if (dst
[slen
- 1] == ':'
761 && dst
[slen
- 2] != ':' /* skip decnet nodes */
762 && strcmp (src
+ slen
, "[000000]") == 0)
764 dst
[slen
- 1] = '\0';
765 if ((ptr
= egetenv (dst
))
766 && (rlen
= strlen (ptr
) - 1) > 0
767 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
768 && ptr
[rlen
- 1] == '.')
770 char * buf
= (char *) alloca (strlen (ptr
) + 1);
774 return directory_file_name (buf
, dst
);
779 strcat (dst
, "[000000]");
783 rlen
= strlen (rptr
) - 1;
784 strncat (dst
, rptr
, rlen
);
785 dst
[slen
+ rlen
] = '\0';
786 strcat (dst
, ".DIR.1");
790 /* Process as Unix format: just remove any final slash.
791 But leave "/" unchanged; do not change it to "". */
794 /* Handle // as root for apollo's. */
795 if ((slen
> 2 && dst
[slen
- 1] == '/')
796 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
800 && IS_DIRECTORY_SEP (dst
[slen
- 1])
802 && !IS_ANY_SEP (dst
[slen
- 2])
808 CORRECT_DIR_SEPS (dst
);
813 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
815 doc
: /* Returns the file name of the directory named DIRECTORY.
816 This is the name of the file that holds the data for the directory DIRECTORY.
817 This operation exists because a directory is also a file, but its name as
818 a directory is different from its name as a file.
819 In Unix-syntax, this function just removes the final slash.
820 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",
821 it returns a file name such as \"[X]Y.DIR.1\". */)
823 Lisp_Object directory
;
828 CHECK_STRING (directory
);
830 if (NILP (directory
))
833 /* If the file name has special constructs in it,
834 call the corresponding file handler. */
835 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
837 return call2 (handler
, Qdirectory_file_name
, directory
);
840 /* 20 extra chars is insufficient for VMS, since we might perform a
841 logical name translation. an equivalence string can be up to 255
842 chars long, so grab that much extra space... - sss */
843 buf
= (char *) alloca (SBYTES (directory
) + 20 + 255);
845 buf
= (char *) alloca (SBYTES (directory
) + 20);
847 directory_file_name (SDATA (directory
), buf
);
848 return make_specified_string (buf
, -1, strlen (buf
),
849 STRING_MULTIBYTE (directory
));
852 static char make_temp_name_tbl
[64] =
854 'A','B','C','D','E','F','G','H',
855 'I','J','K','L','M','N','O','P',
856 'Q','R','S','T','U','V','W','X',
857 'Y','Z','a','b','c','d','e','f',
858 'g','h','i','j','k','l','m','n',
859 'o','p','q','r','s','t','u','v',
860 'w','x','y','z','0','1','2','3',
861 '4','5','6','7','8','9','-','_'
864 static unsigned make_temp_name_count
, make_temp_name_count_initialized_p
;
866 /* Value is a temporary file name starting with PREFIX, a string.
868 The Emacs process number forms part of the result, so there is
869 no danger of generating a name being used by another process.
870 In addition, this function makes an attempt to choose a name
871 which has no existing file. To make this work, PREFIX should be
872 an absolute file name.
874 BASE64_P non-zero means add the pid as 3 characters in base64
875 encoding. In this case, 6 characters will be added to PREFIX to
876 form the file name. Otherwise, if Emacs is running on a system
877 with long file names, add the pid as a decimal number.
879 This function signals an error if no unique file name could be
883 make_temp_name (prefix
, base64_p
)
890 unsigned char *p
, *data
;
894 CHECK_STRING (prefix
);
896 /* VAL is created by adding 6 characters to PREFIX. The first
897 three are the PID of this process, in base 64, and the second
898 three are incremented if the file already exists. This ensures
899 262144 unique file names per PID per PREFIX. */
901 pid
= (int) getpid ();
905 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
906 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
907 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
912 #ifdef HAVE_LONG_FILE_NAMES
913 sprintf (pidbuf
, "%d", pid
);
914 pidlen
= strlen (pidbuf
);
916 pidbuf
[0] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
917 pidbuf
[1] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
918 pidbuf
[2] = make_temp_name_tbl
[pid
& 63], pid
>>= 6;
923 len
= SBYTES (prefix
); clen
= SCHARS (prefix
);
924 val
= make_uninit_multibyte_string (clen
+ 3 + pidlen
, len
+ 3 + pidlen
);
925 if (!STRING_MULTIBYTE (prefix
))
926 STRING_SET_UNIBYTE (val
);
928 bcopy(SDATA (prefix
), data
, len
);
931 bcopy (pidbuf
, p
, pidlen
);
934 /* Here we try to minimize useless stat'ing when this function is
935 invoked many times successively with the same PREFIX. We achieve
936 this by initializing count to a random value, and incrementing it
939 We don't want make-temp-name to be called while dumping,
940 because then make_temp_name_count_initialized_p would get set
941 and then make_temp_name_count would not be set when Emacs starts. */
943 if (!make_temp_name_count_initialized_p
)
945 make_temp_name_count
= (unsigned) time (NULL
);
946 make_temp_name_count_initialized_p
= 1;
952 unsigned num
= make_temp_name_count
;
954 p
[0] = make_temp_name_tbl
[num
& 63], num
>>= 6;
955 p
[1] = make_temp_name_tbl
[num
& 63], num
>>= 6;
956 p
[2] = make_temp_name_tbl
[num
& 63], num
>>= 6;
958 /* Poor man's congruential RN generator. Replace with
959 ++make_temp_name_count for debugging. */
960 make_temp_name_count
+= 25229;
961 make_temp_name_count
%= 225307;
963 if (stat (data
, &ignored
) < 0)
965 /* We want to return only if errno is ENOENT. */
969 /* The error here is dubious, but there is little else we
970 can do. The alternatives are to return nil, which is
971 as bad as (and in many cases worse than) throwing the
972 error, or to ignore the error, which will likely result
973 in looping through 225307 stat's, which is not only
974 dog-slow, but also useless since it will fallback to
975 the errow below, anyway. */
976 report_file_error ("Cannot create temporary name for prefix",
977 Fcons (prefix
, Qnil
));
982 error ("Cannot create temporary name for prefix `%s'",
988 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
989 doc
: /* Generate temporary file name (string) starting with PREFIX (a string).
990 The Emacs process number forms part of the result,
991 so there is no danger of generating a name being used by another process.
993 In addition, this function makes an attempt to choose a name
994 which has no existing file. To make this work,
995 PREFIX should be an absolute file name.
997 There is a race condition between calling `make-temp-name' and creating the
998 file which opens all kinds of security holes. For that reason, you should
999 probably use `make-temp-file' instead, except in three circumstances:
1001 * If you are creating the file in the user's home directory.
1002 * If you are creating a directory rather than an ordinary file.
1003 * If you are taking special precautions as `make-temp-file' does. */)
1007 return make_temp_name (prefix
, 0);
1012 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1013 doc
: /* Convert filename NAME to absolute, and canonicalize it.
1014 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
1015 \(does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
1016 the current buffer's value of default-directory is used.
1017 File name components that are `.' are removed, and
1018 so are file name components followed by `..', along with the `..' itself;
1019 note that these simplifications are done without checking the resulting
1020 file names in the file system.
1021 An initial `~/' expands to your home directory.
1022 An initial `~USER/' expands to USER's home directory.
1023 See also the function `substitute-in-file-name'. */)
1024 (name
, default_directory
)
1025 Lisp_Object name
, default_directory
;
1029 register unsigned char *newdir
, *p
, *o
;
1031 unsigned char *target
;
1034 unsigned char * colon
= 0;
1035 unsigned char * close
= 0;
1036 unsigned char * slash
= 0;
1037 unsigned char * brack
= 0;
1038 int lbrack
= 0, rbrack
= 0;
1043 int collapse_newdir
= 1;
1047 Lisp_Object handler
, result
;
1049 CHECK_STRING (name
);
1051 /* If the file name has special constructs in it,
1052 call the corresponding file handler. */
1053 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
1054 if (!NILP (handler
))
1055 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1057 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
1058 if (NILP (default_directory
))
1059 default_directory
= current_buffer
->directory
;
1060 if (! STRINGP (default_directory
))
1063 /* "/" is not considered a root directory on DOS_NT, so using "/"
1064 here causes an infinite recursion in, e.g., the following:
1066 (let (default-directory)
1067 (expand-file-name "a"))
1069 To avoid this, we set default_directory to the root of the
1071 extern char *emacs_root_dir (void);
1073 default_directory
= build_string (emacs_root_dir ());
1075 default_directory
= build_string ("/");
1079 if (!NILP (default_directory
))
1081 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
1082 if (!NILP (handler
))
1083 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
1086 o
= SDATA (default_directory
);
1088 /* Make sure DEFAULT_DIRECTORY is properly expanded.
1089 It would be better to do this down below where we actually use
1090 default_directory. Unfortunately, calling Fexpand_file_name recursively
1091 could invoke GC, and the strings might be relocated. This would
1092 be annoying because we have pointers into strings lying around
1093 that would need adjusting, and people would add new pointers to
1094 the code and forget to adjust them, resulting in intermittent bugs.
1095 Putting this call here avoids all that crud.
1097 The EQ test avoids infinite recursion. */
1098 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
1099 /* Save time in some common cases - as long as default_directory
1100 is not relative, it can be canonicalized with name below (if it
1101 is needed at all) without requiring it to be expanded now. */
1103 /* Detect MSDOS file names with drive specifiers. */
1104 && ! (IS_DRIVE (o
[0]) && IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2]))
1106 /* Detect Windows file names in UNC format. */
1107 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
1109 #else /* not DOS_NT */
1110 /* Detect Unix absolute file names (/... alone is not absolute on
1112 && ! (IS_DIRECTORY_SEP (o
[0]))
1113 #endif /* not DOS_NT */
1116 struct gcpro gcpro1
;
1119 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
1123 name
= FILE_SYSTEM_CASE (name
);
1127 /* We will force directory separators to be either all \ or /, so make
1128 a local copy to modify, even if there ends up being no change. */
1129 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1131 /* Note if special escape prefix is present, but remove for now. */
1132 if (nm
[0] == '/' && nm
[1] == ':')
1138 /* Find and remove drive specifier if present; this makes nm absolute
1139 even if the rest of the name appears to be relative. Only look for
1140 drive specifier at the beginning. */
1141 if (IS_DRIVE (nm
[0]) && IS_DEVICE_SEP (nm
[1]))
1148 /* If we see "c://somedir", we want to strip the first slash after the
1149 colon when stripping the drive letter. Otherwise, this expands to
1151 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1153 #endif /* WINDOWSNT */
1157 /* Discard any previous drive specifier if nm is now in UNC format. */
1158 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1164 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1165 none are found, we can probably return right away. We will avoid
1166 allocating a new string if name is already fully expanded. */
1168 IS_DIRECTORY_SEP (nm
[0])
1170 && drive
&& !is_escaped
1173 && (drive
|| IS_DIRECTORY_SEP (nm
[1])) && !is_escaped
1180 /* If it turns out that the filename we want to return is just a
1181 suffix of FILENAME, we don't need to go through and edit
1182 things; we just need to construct a new string using data
1183 starting at the middle of FILENAME. If we set lose to a
1184 non-zero value, that means we've discovered that we can't do
1191 /* Since we know the name is absolute, we can assume that each
1192 element starts with a "/". */
1194 /* "." and ".." are hairy. */
1195 if (IS_DIRECTORY_SEP (p
[0])
1197 && (IS_DIRECTORY_SEP (p
[2])
1199 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1202 /* We want to replace multiple `/' in a row with a single
1205 && IS_DIRECTORY_SEP (p
[0])
1206 && IS_DIRECTORY_SEP (p
[1]))
1213 /* if dev:[dir]/, move nm to / */
1214 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1215 nm
= (brack
? brack
+ 1 : colon
+ 1);
1216 lbrack
= rbrack
= 0;
1223 #ifdef NO_HYPHENS_IN_FILENAMES
1224 if (lbrack
== rbrack
)
1226 /* Avoid clobbering negative version numbers. */
1231 #endif /* NO_HYPHENS_IN_FILENAMES */
1232 if (lbrack
> rbrack
&&
1233 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1234 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1236 #ifdef NO_HYPHENS_IN_FILENAMES
1239 #endif /* NO_HYPHENS_IN_FILENAMES */
1240 /* count open brackets, reset close bracket pointer */
1241 if (p
[0] == '[' || p
[0] == '<')
1242 lbrack
++, brack
= 0;
1243 /* count close brackets, set close bracket pointer */
1244 if (p
[0] == ']' || p
[0] == '>')
1245 rbrack
++, brack
= p
;
1246 /* detect ][ or >< */
1247 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1249 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1250 nm
= p
+ 1, lose
= 1;
1251 if (p
[0] == ':' && (colon
|| slash
))
1252 /* if dev1:[dir]dev2:, move nm to dev2: */
1258 /* if /name/dev:, move nm to dev: */
1261 /* if node::dev:, move colon following dev */
1262 else if (colon
&& colon
[-1] == ':')
1264 /* if dev1:dev2:, move nm to dev2: */
1265 else if (colon
&& colon
[-1] != ':')
1270 if (p
[0] == ':' && !colon
)
1276 if (lbrack
== rbrack
)
1279 else if (p
[0] == '.')
1287 if (index (nm
, '/'))
1289 nm
= sys_translate_unix (nm
);
1290 return make_specified_string (nm
, -1, strlen (nm
),
1291 STRING_MULTIBYTE (name
));
1295 /* Make sure directories are all separated with / or \ as
1296 desired, but avoid allocation of a new string when not
1298 CORRECT_DIR_SEPS (nm
);
1300 if (IS_DIRECTORY_SEP (nm
[1]))
1302 if (strcmp (nm
, SDATA (name
)) != 0)
1303 name
= make_specified_string (nm
, -1, strlen (nm
),
1304 STRING_MULTIBYTE (name
));
1308 /* drive must be set, so this is okay */
1309 if (strcmp (nm
- 2, SDATA (name
)) != 0)
1313 name
= make_specified_string (nm
, -1, p
- nm
,
1314 STRING_MULTIBYTE (name
));
1315 temp
[0] = DRIVE_LETTER (drive
);
1316 name
= concat2 (build_string (temp
), name
);
1319 #else /* not DOS_NT */
1320 if (nm
== SDATA (name
))
1322 return make_specified_string (nm
, -1, strlen (nm
),
1323 STRING_MULTIBYTE (name
));
1324 #endif /* not DOS_NT */
1328 /* At this point, nm might or might not be an absolute file name. We
1329 need to expand ~ or ~user if present, otherwise prefix nm with
1330 default_directory if nm is not absolute, and finally collapse /./
1331 and /foo/../ sequences.
1333 We set newdir to be the appropriate prefix if one is needed:
1334 - the relevant user directory if nm starts with ~ or ~user
1335 - the specified drive's working dir (DOS/NT only) if nm does not
1337 - the value of default_directory.
1339 Note that these prefixes are not guaranteed to be absolute (except
1340 for the working dir of a drive). Therefore, to ensure we always
1341 return an absolute name, if the final prefix is not absolute we
1342 append it to the current working directory. */
1346 if (nm
[0] == '~') /* prefix ~ */
1348 if (IS_DIRECTORY_SEP (nm
[1])
1352 || nm
[1] == 0) /* ~ by itself */
1354 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1355 newdir
= (unsigned char *) "";
1358 collapse_newdir
= 0;
1361 nm
++; /* Don't leave the slash in nm. */
1364 else /* ~user/filename */
1366 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1371 o
= (unsigned char *) alloca (p
- nm
+ 1);
1372 bcopy ((char *) nm
, o
, p
- nm
);
1375 pw
= (struct passwd
*) getpwnam (o
+ 1);
1378 newdir
= (unsigned char *) pw
-> pw_dir
;
1380 nm
= p
+ 1; /* skip the terminator */
1384 collapse_newdir
= 0;
1389 /* If we don't find a user of that name, leave the name
1390 unchanged; don't move nm forward to p. */
1395 /* On DOS and Windows, nm is absolute if a drive name was specified;
1396 use the drive's current directory as the prefix if needed. */
1397 if (!newdir
&& drive
)
1399 /* Get default directory if needed to make nm absolute. */
1400 if (!IS_DIRECTORY_SEP (nm
[0]))
1402 newdir
= alloca (MAXPATHLEN
+ 1);
1403 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1408 /* Either nm starts with /, or drive isn't mounted. */
1409 newdir
= alloca (4);
1410 newdir
[0] = DRIVE_LETTER (drive
);
1418 /* Finally, if no prefix has been specified and nm is not absolute,
1419 then it must be expanded relative to default_directory. */
1423 /* /... alone is not absolute on DOS and Windows. */
1424 && !IS_DIRECTORY_SEP (nm
[0])
1427 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1434 newdir
= SDATA (default_directory
);
1436 /* Note if special escape prefix is present, but remove for now. */
1437 if (newdir
[0] == '/' && newdir
[1] == ':')
1448 /* First ensure newdir is an absolute name. */
1450 /* Detect MSDOS file names with drive specifiers. */
1451 ! (IS_DRIVE (newdir
[0])
1452 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1454 /* Detect Windows file names in UNC format. */
1455 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1459 /* Effectively, let newdir be (expand-file-name newdir cwd).
1460 Because of the admonition against calling expand-file-name
1461 when we have pointers into lisp strings, we accomplish this
1462 indirectly by prepending newdir to nm if necessary, and using
1463 cwd (or the wd of newdir's drive) as the new newdir. */
1465 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1470 if (!IS_DIRECTORY_SEP (nm
[0]))
1472 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1473 file_name_as_directory (tmp
, newdir
);
1477 newdir
= alloca (MAXPATHLEN
+ 1);
1480 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1487 /* Strip off drive name from prefix, if present. */
1488 if (IS_DRIVE (newdir
[0]) && IS_DEVICE_SEP (newdir
[1]))
1494 /* Keep only a prefix from newdir if nm starts with slash
1495 (//server/share for UNC, nothing otherwise). */
1496 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1499 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1501 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1503 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1505 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1517 /* Get rid of any slash at the end of newdir, unless newdir is
1518 just / or // (an incomplete UNC name). */
1519 length
= strlen (newdir
);
1520 if (length
> 1 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1522 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1526 unsigned char *temp
= (unsigned char *) alloca (length
);
1527 bcopy (newdir
, temp
, length
- 1);
1528 temp
[length
- 1] = 0;
1536 /* Now concatenate the directory and name to new space in the stack frame */
1537 tlen
+= strlen (nm
) + 1;
1539 /* Reserve space for drive specifier and escape prefix, since either
1540 or both may need to be inserted. (The Microsoft x86 compiler
1541 produces incorrect code if the following two lines are combined.) */
1542 target
= (unsigned char *) alloca (tlen
+ 4);
1544 #else /* not DOS_NT */
1545 target
= (unsigned char *) alloca (tlen
);
1546 #endif /* not DOS_NT */
1552 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1555 /* If newdir is effectively "C:/", then the drive letter will have
1556 been stripped and newdir will be "/". Concatenating with an
1557 absolute directory in nm produces "//", which will then be
1558 incorrectly treated as a network share. Ignore newdir in
1559 this case (keeping the drive letter). */
1560 if (!(drive
&& nm
[0] && IS_DIRECTORY_SEP (newdir
[0])
1561 && newdir
[1] == '\0'))
1563 strcpy (target
, newdir
);
1567 file_name_as_directory (target
, newdir
);
1570 strcat (target
, nm
);
1572 if (index (target
, '/'))
1573 strcpy (target
, sys_translate_unix (target
));
1576 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1578 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1587 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1593 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1594 /* brackets are offset from each other by 2 */
1597 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1598 /* convert [foo][bar] to [bar] */
1599 while (o
[-1] != '[' && o
[-1] != '<')
1601 else if (*p
== '-' && *o
!= '.')
1604 else if (p
[0] == '-' && o
[-1] == '.' &&
1605 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1606 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1610 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1611 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1613 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1615 /* else [foo.-] ==> [-] */
1619 #ifdef NO_HYPHENS_IN_FILENAMES
1621 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1622 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1624 #endif /* NO_HYPHENS_IN_FILENAMES */
1628 if (!IS_DIRECTORY_SEP (*p
))
1632 else if (IS_DIRECTORY_SEP (p
[0])
1634 && (IS_DIRECTORY_SEP (p
[2])
1637 /* If "/." is the entire filename, keep the "/". Otherwise,
1638 just delete the whole "/.". */
1639 if (o
== target
&& p
[2] == '\0')
1643 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1644 /* `/../' is the "superroot" on certain file systems. */
1646 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1648 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1650 /* Keep initial / only if this is the whole name. */
1651 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1656 && IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1]))
1658 /* Collapse multiple `/' in a row. */
1660 while (IS_DIRECTORY_SEP (*p
))
1667 #endif /* not VMS */
1671 /* At last, set drive name. */
1673 /* Except for network file name. */
1674 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1675 #endif /* WINDOWSNT */
1677 if (!drive
) abort ();
1679 target
[0] = DRIVE_LETTER (drive
);
1682 /* Reinsert the escape prefix if required. */
1689 CORRECT_DIR_SEPS (target
);
1692 result
= make_specified_string (target
, -1, o
- target
,
1693 STRING_MULTIBYTE (name
));
1695 /* Again look to see if the file name has special constructs in it
1696 and perhaps call the corresponding file handler. This is needed
1697 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1698 the ".." component gives us "/user@host:/bar/../baz" which needs
1699 to be expanded again. */
1700 handler
= Ffind_file_name_handler (result
, Qexpand_file_name
);
1701 if (!NILP (handler
))
1702 return call3 (handler
, Qexpand_file_name
, result
, default_directory
);
1708 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1709 This is the old version of expand-file-name, before it was thoroughly
1710 rewritten for Emacs 10.31. We leave this version here commented-out,
1711 because the code is very complex and likely to have subtle bugs. If
1712 bugs _are_ found, it might be of interest to look at the old code and
1713 see what did it do in the relevant situation.
1715 Don't remove this code: it's true that it will be accessible via CVS,
1716 but a few years from deletion, people will forget it is there. */
1718 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1719 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1720 "Convert FILENAME to absolute, and canonicalize it.\n\
1721 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1722 \(does not start with slash); if DEFAULT is nil or missing,\n\
1723 the current buffer's value of default-directory is used.\n\
1724 Filenames containing `.' or `..' as components are simplified;\n\
1725 initial `~/' expands to your home directory.\n\
1726 See also the function `substitute-in-file-name'.")
1728 Lisp_Object name
, defalt
;
1732 register unsigned char *newdir
, *p
, *o
;
1734 unsigned char *target
;
1738 unsigned char * colon
= 0;
1739 unsigned char * close
= 0;
1740 unsigned char * slash
= 0;
1741 unsigned char * brack
= 0;
1742 int lbrack
= 0, rbrack
= 0;
1746 CHECK_STRING (name
);
1749 /* Filenames on VMS are always upper case. */
1750 name
= Fupcase (name
);
1755 /* If nm is absolute, flush ...// and detect /./ and /../.
1756 If no /./ or /../ we can return right away. */
1768 if (p
[0] == '/' && p
[1] == '/'
1770 /* // at start of filename is meaningful on Apollo system. */
1775 if (p
[0] == '/' && p
[1] == '~')
1776 nm
= p
+ 1, lose
= 1;
1777 if (p
[0] == '/' && p
[1] == '.'
1778 && (p
[2] == '/' || p
[2] == 0
1779 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1785 /* if dev:[dir]/, move nm to / */
1786 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1787 nm
= (brack
? brack
+ 1 : colon
+ 1);
1788 lbrack
= rbrack
= 0;
1796 /* VMS pre V4.4,convert '-'s in filenames. */
1797 if (lbrack
== rbrack
)
1799 if (dots
< 2) /* this is to allow negative version numbers */
1804 if (lbrack
> rbrack
&&
1805 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1806 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1812 /* count open brackets, reset close bracket pointer */
1813 if (p
[0] == '[' || p
[0] == '<')
1814 lbrack
++, brack
= 0;
1815 /* count close brackets, set close bracket pointer */
1816 if (p
[0] == ']' || p
[0] == '>')
1817 rbrack
++, brack
= p
;
1818 /* detect ][ or >< */
1819 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1821 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1822 nm
= p
+ 1, lose
= 1;
1823 if (p
[0] == ':' && (colon
|| slash
))
1824 /* if dev1:[dir]dev2:, move nm to dev2: */
1830 /* If /name/dev:, move nm to dev: */
1833 /* If node::dev:, move colon following dev */
1834 else if (colon
&& colon
[-1] == ':')
1836 /* If dev1:dev2:, move nm to dev2: */
1837 else if (colon
&& colon
[-1] != ':')
1842 if (p
[0] == ':' && !colon
)
1848 if (lbrack
== rbrack
)
1851 else if (p
[0] == '.')
1859 if (index (nm
, '/'))
1860 return build_string (sys_translate_unix (nm
));
1862 if (nm
== SDATA (name
))
1864 return build_string (nm
);
1868 /* Now determine directory to start with and put it in NEWDIR */
1872 if (nm
[0] == '~') /* prefix ~ */
1877 || nm
[1] == 0)/* ~/filename */
1879 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1880 newdir
= (unsigned char *) "";
1883 nm
++; /* Don't leave the slash in nm. */
1886 else /* ~user/filename */
1888 /* Get past ~ to user */
1889 unsigned char *user
= nm
+ 1;
1890 /* Find end of name. */
1891 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1892 int len
= ptr
? ptr
- user
: strlen (user
);
1894 unsigned char *ptr1
= index (user
, ':');
1895 if (ptr1
!= 0 && ptr1
- user
< len
)
1898 /* Copy the user name into temp storage. */
1899 o
= (unsigned char *) alloca (len
+ 1);
1900 bcopy ((char *) user
, o
, len
);
1903 /* Look up the user name. */
1904 pw
= (struct passwd
*) getpwnam (o
+ 1);
1906 error ("\"%s\" isn't a registered user", o
+ 1);
1908 newdir
= (unsigned char *) pw
->pw_dir
;
1910 /* Discard the user name from NM. */
1917 #endif /* not VMS */
1921 defalt
= current_buffer
->directory
;
1922 CHECK_STRING (defalt
);
1923 newdir
= SDATA (defalt
);
1926 /* Now concatenate the directory and name to new space in the stack frame */
1928 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1929 target
= (unsigned char *) alloca (tlen
);
1935 if (nm
[0] == 0 || nm
[0] == '/')
1936 strcpy (target
, newdir
);
1939 file_name_as_directory (target
, newdir
);
1942 strcat (target
, nm
);
1944 if (index (target
, '/'))
1945 strcpy (target
, sys_translate_unix (target
));
1948 /* Now canonicalize by removing /. and /foo/.. if they appear */
1956 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1962 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1963 /* brackets are offset from each other by 2 */
1966 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1967 /* convert [foo][bar] to [bar] */
1968 while (o
[-1] != '[' && o
[-1] != '<')
1970 else if (*p
== '-' && *o
!= '.')
1973 else if (p
[0] == '-' && o
[-1] == '.' &&
1974 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1975 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1979 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1980 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1982 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1984 /* else [foo.-] ==> [-] */
1990 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1991 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
2001 else if (!strncmp (p
, "//", 2)
2003 /* // at start of filename is meaningful in Apollo system. */
2011 else if (p
[0] == '/' && p
[1] == '.' &&
2012 (p
[2] == '/' || p
[2] == 0))
2014 else if (!strncmp (p
, "/..", 3)
2015 /* `/../' is the "superroot" on certain file systems. */
2017 && (p
[3] == '/' || p
[3] == 0))
2019 while (o
!= target
&& *--o
!= '/')
2022 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
2026 if (o
== target
&& *o
== '/')
2034 #endif /* not VMS */
2037 return make_string (target
, o
- target
);
2041 /* If /~ or // appears, discard everything through first slash. */
2043 file_name_absolute_p (filename
)
2044 const unsigned char *filename
;
2047 (IS_DIRECTORY_SEP (*filename
) || *filename
== '~'
2049 /* ??? This criterion is probably wrong for '<'. */
2050 || index (filename
, ':') || index (filename
, '<')
2051 || (*filename
== '[' && (filename
[1] != '-'
2052 || (filename
[2] != '.' && filename
[2] != ']'))
2053 && filename
[1] != '.')
2056 || (IS_DRIVE (*filename
) && IS_DEVICE_SEP (filename
[1])
2057 && IS_DIRECTORY_SEP (filename
[2]))
2062 static unsigned char *
2063 search_embedded_absfilename (nm
, endp
)
2064 unsigned char *nm
, *endp
;
2066 unsigned char *p
, *s
;
2068 for (p
= nm
+ 1; p
< endp
; p
++)
2072 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
2074 || IS_DIRECTORY_SEP (p
[-1]))
2075 && file_name_absolute_p (p
)
2076 #if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
2077 /* // at start of file name is meaningful in Apollo,
2078 WindowsNT and Cygwin systems. */
2079 && !(IS_DIRECTORY_SEP (p
[0]) && p
- 1 == nm
)
2080 #endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
2083 for (s
= p
; *s
&& (!IS_DIRECTORY_SEP (*s
)
2088 if (p
[0] == '~' && s
> p
+ 1) /* we've got "/~something/" */
2090 unsigned char *o
= alloca (s
- p
+ 1);
2092 bcopy (p
, o
, s
- p
);
2095 /* If we have ~user and `user' exists, discard
2096 everything up to ~. But if `user' does not exist, leave
2097 ~user alone, it might be a literal file name. */
2098 if ((pw
= getpwnam (o
+ 1)))
2110 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
2111 Ssubstitute_in_file_name
, 1, 1, 0,
2112 doc
: /* Substitute environment variables referred to in FILENAME.
2113 `$FOO' where FOO is an environment variable name means to substitute
2114 the value of that variable. The variable name should be terminated
2115 with a character not a letter, digit or underscore; otherwise, enclose
2116 the entire variable name in braces.
2117 If `/~' appears, all of FILENAME through that `/' is discarded.
2119 On VMS, `$' substitution is not done; this function does little and only
2120 duplicates what `expand-file-name' does. */)
2122 Lisp_Object filename
;
2126 register unsigned char *s
, *p
, *o
, *x
, *endp
;
2127 unsigned char *target
= NULL
;
2129 int substituted
= 0;
2131 Lisp_Object handler
;
2133 CHECK_STRING (filename
);
2135 /* If the file name has special constructs in it,
2136 call the corresponding file handler. */
2137 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
2138 if (!NILP (handler
))
2139 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
2141 nm
= SDATA (filename
);
2143 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
2144 CORRECT_DIR_SEPS (nm
);
2145 substituted
= (strcmp (nm
, SDATA (filename
)) != 0);
2147 endp
= nm
+ SBYTES (filename
);
2149 /* If /~ or // appears, discard everything through first slash. */
2150 p
= search_embedded_absfilename (nm
, endp
);
2152 /* Start over with the new string, so we check the file-name-handler
2153 again. Important with filenames like "/home/foo//:/hello///there"
2154 which whould substitute to "/:/hello///there" rather than "/there". */
2155 return Fsubstitute_in_file_name
2156 (make_specified_string (p
, -1, endp
- p
,
2157 STRING_MULTIBYTE (filename
)));
2163 /* See if any variables are substituted into the string
2164 and find the total length of their values in `total' */
2166 for (p
= nm
; p
!= endp
;)
2176 /* "$$" means a single "$" */
2185 while (p
!= endp
&& *p
!= '}') p
++;
2186 if (*p
!= '}') goto missingclose
;
2192 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2196 /* Copy out the variable name */
2197 target
= (unsigned char *) alloca (s
- o
+ 1);
2198 strncpy (target
, o
, s
- o
);
2201 strupr (target
); /* $home == $HOME etc. */
2204 /* Get variable value */
2205 o
= (unsigned char *) egetenv (target
);
2208 total
+= strlen (o
);
2218 /* If substitution required, recopy the string and do it */
2219 /* Make space in stack frame for the new copy */
2220 xnm
= (unsigned char *) alloca (SBYTES (filename
) + total
+ 1);
2223 /* Copy the rest of the name through, replacing $ constructs with values */
2240 while (p
!= endp
&& *p
!= '}') p
++;
2241 if (*p
!= '}') goto missingclose
;
2247 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
2251 /* Copy out the variable name */
2252 target
= (unsigned char *) alloca (s
- o
+ 1);
2253 strncpy (target
, o
, s
- o
);
2256 strupr (target
); /* $home == $HOME etc. */
2259 /* Get variable value */
2260 o
= (unsigned char *) egetenv (target
);
2264 strcpy (x
, target
); x
+= strlen (target
);
2266 else if (STRING_MULTIBYTE (filename
))
2268 /* If the original string is multibyte,
2269 convert what we substitute into multibyte. */
2272 int c
= unibyte_char_to_multibyte (*o
++);
2273 x
+= CHAR_STRING (c
, x
);
2285 /* If /~ or // appears, discard everything through first slash. */
2286 while ((p
= search_embedded_absfilename (xnm
, x
)))
2287 /* This time we do not start over because we've already expanded envvars
2288 and replaced $$ with $. Maybe we should start over as well, but we'd
2289 need to quote some $ to $$ first. */
2292 return make_specified_string (xnm
, -1, x
- xnm
, STRING_MULTIBYTE (filename
));
2295 error ("Bad format environment-variable substitution");
2297 error ("Missing \"}\" in environment-variable substitution");
2299 error ("Substituting nonexistent environment variable \"%s\"", target
);
2302 #endif /* not VMS */
2306 /* A slightly faster and more convenient way to get
2307 (directory-file-name (expand-file-name FOO)). */
2310 expand_and_dir_to_file (filename
, defdir
)
2311 Lisp_Object filename
, defdir
;
2313 register Lisp_Object absname
;
2315 absname
= Fexpand_file_name (filename
, defdir
);
2318 register int c
= SREF (absname
, SBYTES (absname
) - 1);
2319 if (c
== ':' || c
== ']' || c
== '>')
2320 absname
= Fdirectory_file_name (absname
);
2323 /* Remove final slash, if any (unless this is the root dir).
2324 stat behaves differently depending! */
2325 if (SCHARS (absname
) > 1
2326 && IS_DIRECTORY_SEP (SREF (absname
, SBYTES (absname
) - 1))
2327 && !IS_DEVICE_SEP (SREF (absname
, SBYTES (absname
)-2)))
2328 /* We cannot take shortcuts; they might be wrong for magic file names. */
2329 absname
= Fdirectory_file_name (absname
);
2334 /* Signal an error if the file ABSNAME already exists.
2335 If INTERACTIVE is nonzero, ask the user whether to proceed,
2336 and bypass the error if the user says to go ahead.
2337 QUERYSTRING is a name for the action that is being considered
2340 *STATPTR is used to store the stat information if the file exists.
2341 If the file does not exist, STATPTR->st_mode is set to 0.
2342 If STATPTR is null, we don't store into it.
2344 If QUICK is nonzero, we ask for y or n, not yes or no. */
2347 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2348 Lisp_Object absname
;
2349 unsigned char *querystring
;
2351 struct stat
*statptr
;
2354 register Lisp_Object tem
, encoded_filename
;
2355 struct stat statbuf
;
2356 struct gcpro gcpro1
;
2358 encoded_filename
= ENCODE_FILE (absname
);
2360 /* stat is a good way to tell whether the file exists,
2361 regardless of what access permissions it has. */
2362 if (lstat (SDATA (encoded_filename
), &statbuf
) >= 0)
2365 Fsignal (Qfile_already_exists
,
2366 Fcons (build_string ("File already exists"),
2367 Fcons (absname
, Qnil
)));
2369 tem
= format2 ("File %s already exists; %s anyway? ",
2370 absname
, build_string (querystring
));
2372 tem
= Fy_or_n_p (tem
);
2374 tem
= do_yes_or_no_p (tem
);
2377 Fsignal (Qfile_already_exists
,
2378 Fcons (build_string ("File already exists"),
2379 Fcons (absname
, Qnil
)));
2386 statptr
->st_mode
= 0;
2391 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 5,
2392 "fCopy file: \nGCopy %s to file: \np\nP",
2393 doc
: /* Copy FILE to NEWNAME. Both args must be strings.
2394 If NEWNAME names a directory, copy FILE there.
2395 Signals a `file-already-exists' error if file NEWNAME already exists,
2396 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
2397 A number as third arg means request confirmation if NEWNAME already exists.
2398 This is what happens in interactive use with M-x.
2399 Always sets the file modes of the output file to match the input file.
2401 Fourth arg KEEP-TIME non-nil means give the output file the same
2402 last-modified time as the old one. (This works on only some systems.)
2403 The optional fifth arg MUSTBENEW, if non-nil, insists on a check
2404 for an existing file with the same name. If MUSTBENEW is `excl',
2405 that means to get an error if the file already exists; never overwrite.
2406 If MUSTBENEW is neither nil nor `excl', that means ask for
2407 confirmation before overwriting, but do go ahead and overwrite the file
2408 if the user confirms.
2410 A prefix arg makes KEEP-TIME non-nil. */)
2411 (file
, newname
, ok_if_already_exists
, keep_time
, mustbenew
)
2412 Lisp_Object file
, newname
, ok_if_already_exists
, keep_time
, mustbenew
;
2415 char buf
[16 * 1024];
2416 struct stat st
, out_st
;
2417 Lisp_Object handler
;
2418 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2419 int count
= SPECPDL_INDEX ();
2420 int input_file_statable_p
;
2421 Lisp_Object encoded_file
, encoded_newname
;
2423 encoded_file
= encoded_newname
= Qnil
;
2424 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2425 CHECK_STRING (file
);
2426 CHECK_STRING (newname
);
2428 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
2429 barf_or_query_if_file_exists (newname
, "overwrite", 1, 0, 1);
2431 if (!NILP (Ffile_directory_p (newname
)))
2432 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2434 newname
= Fexpand_file_name (newname
, Qnil
);
2436 file
= Fexpand_file_name (file
, Qnil
);
2438 /* If the input file name has special constructs in it,
2439 call the corresponding file handler. */
2440 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2441 /* Likewise for output file name. */
2443 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2444 if (!NILP (handler
))
2445 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2446 ok_if_already_exists
, keep_time
));
2448 encoded_file
= ENCODE_FILE (file
);
2449 encoded_newname
= ENCODE_FILE (newname
);
2451 if (NILP (ok_if_already_exists
)
2452 || INTEGERP (ok_if_already_exists
))
2453 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2454 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2455 else if (stat (SDATA (encoded_newname
), &out_st
) < 0)
2459 if (!CopyFile (SDATA (encoded_file
),
2460 SDATA (encoded_newname
),
2462 report_file_error ("Copying file", Fcons (file
, Fcons (newname
, Qnil
)));
2463 /* CopyFile retains the timestamp by default. */
2464 else if (NILP (keep_time
))
2470 EMACS_GET_TIME (now
);
2471 filename
= SDATA (encoded_newname
);
2473 /* Ensure file is writable while its modified time is set. */
2474 attributes
= GetFileAttributes (filename
);
2475 SetFileAttributes (filename
, attributes
& ~FILE_ATTRIBUTE_READONLY
);
2476 if (set_file_times (filename
, now
, now
))
2478 /* Restore original attributes. */
2479 SetFileAttributes (filename
, attributes
);
2480 Fsignal (Qfile_date_error
,
2481 Fcons (build_string ("Cannot set file date"),
2482 Fcons (newname
, Qnil
)));
2484 /* Restore original attributes. */
2485 SetFileAttributes (filename
, attributes
);
2487 #else /* not WINDOWSNT */
2489 ifd
= emacs_open (SDATA (encoded_file
), O_RDONLY
, 0);
2493 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2495 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2497 /* We can only copy regular files and symbolic links. Other files are not
2499 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2501 #if !defined (DOS_NT) || __DJGPP__ > 1
2502 if (out_st
.st_mode
!= 0
2503 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2506 report_file_error ("Input and output files are the same",
2507 Fcons (file
, Fcons (newname
, Qnil
)));
2511 #if defined (S_ISREG) && defined (S_ISLNK)
2512 if (input_file_statable_p
)
2514 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2516 #if defined (EISDIR)
2517 /* Get a better looking error message. */
2520 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2523 #endif /* S_ISREG && S_ISLNK */
2526 /* Create the copy file with the same record format as the input file */
2527 ofd
= sys_creat (SDATA (encoded_newname
), 0666, ifd
);
2530 /* System's default file type was set to binary by _fmode in emacs.c. */
2531 ofd
= emacs_open (SDATA (encoded_newname
),
2532 O_WRONLY
| O_CREAT
| buffer_file_type
2533 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
2534 S_IREAD
| S_IWRITE
);
2535 #else /* not MSDOS */
2536 ofd
= emacs_open (SDATA (encoded_newname
),
2537 O_WRONLY
| O_TRUNC
| O_CREAT
2538 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
2540 #endif /* not MSDOS */
2543 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2545 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2549 while ((n
= emacs_read (ifd
, buf
, sizeof buf
)) > 0)
2550 if (emacs_write (ofd
, buf
, n
) != n
)
2551 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2554 /* Closing the output clobbers the file times on some systems. */
2555 if (emacs_close (ofd
) < 0)
2556 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2558 if (input_file_statable_p
)
2560 if (!NILP (keep_time
))
2562 EMACS_TIME atime
, mtime
;
2563 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2564 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2565 if (set_file_times (SDATA (encoded_newname
),
2567 Fsignal (Qfile_date_error
,
2568 Fcons (build_string ("Cannot set file date"),
2569 Fcons (newname
, Qnil
)));
2572 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2574 #if defined (__DJGPP__) && __DJGPP__ > 1
2575 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2576 and if it can't, it tells so. Otherwise, under MSDOS we usually
2577 get only the READ bit, which will make the copied file read-only,
2578 so it's better not to chmod at all. */
2579 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2580 chmod (SDATA (encoded_newname
), st
.st_mode
& 07777);
2581 #endif /* DJGPP version 2 or newer */
2586 #endif /* WINDOWSNT */
2588 /* Discard the unwind protects. */
2589 specpdl_ptr
= specpdl
+ count
;
2595 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2596 Smake_directory_internal
, 1, 1, 0,
2597 doc
: /* Create a new directory named DIRECTORY. */)
2599 Lisp_Object directory
;
2601 const unsigned char *dir
;
2602 Lisp_Object handler
;
2603 Lisp_Object encoded_dir
;
2605 CHECK_STRING (directory
);
2606 directory
= Fexpand_file_name (directory
, Qnil
);
2608 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2609 if (!NILP (handler
))
2610 return call2 (handler
, Qmake_directory_internal
, directory
);
2612 encoded_dir
= ENCODE_FILE (directory
);
2614 dir
= SDATA (encoded_dir
);
2617 if (mkdir (dir
) != 0)
2619 if (mkdir (dir
, 0777) != 0)
2621 report_file_error ("Creating directory", Flist (1, &directory
));
2626 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2627 doc
: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2629 Lisp_Object directory
;
2631 const unsigned char *dir
;
2632 Lisp_Object handler
;
2633 Lisp_Object encoded_dir
;
2635 CHECK_STRING (directory
);
2636 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2638 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2639 if (!NILP (handler
))
2640 return call2 (handler
, Qdelete_directory
, directory
);
2642 encoded_dir
= ENCODE_FILE (directory
);
2644 dir
= SDATA (encoded_dir
);
2646 if (rmdir (dir
) != 0)
2647 report_file_error ("Removing directory", Flist (1, &directory
));
2652 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2653 doc
: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2654 If file has multiple names, it continues to exist with the other names. */)
2656 Lisp_Object filename
;
2658 Lisp_Object handler
;
2659 Lisp_Object encoded_file
;
2660 struct gcpro gcpro1
;
2663 if (!NILP (Ffile_directory_p (filename
))
2664 && NILP (Ffile_symlink_p (filename
)))
2665 Fsignal (Qfile_error
,
2666 Fcons (build_string ("Removing old name: is a directory"),
2667 Fcons (filename
, Qnil
)));
2669 filename
= Fexpand_file_name (filename
, Qnil
);
2671 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2672 if (!NILP (handler
))
2673 return call2 (handler
, Qdelete_file
, filename
);
2675 encoded_file
= ENCODE_FILE (filename
);
2677 if (0 > unlink (SDATA (encoded_file
)))
2678 report_file_error ("Removing old name", Flist (1, &filename
));
2683 internal_delete_file_1 (ignore
)
2689 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2692 internal_delete_file (filename
)
2693 Lisp_Object filename
;
2695 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2696 Qt
, internal_delete_file_1
));
2699 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2700 "fRename file: \nGRename %s to file: \np",
2701 doc
: /* Rename FILE as NEWNAME. Both args strings.
2702 If file has names other than FILE, it continues to have those names.
2703 Signals a `file-already-exists' error if a file NEWNAME already exists
2704 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2705 A number as third arg means request confirmation if NEWNAME already exists.
2706 This is what happens in interactive use with M-x. */)
2707 (file
, newname
, ok_if_already_exists
)
2708 Lisp_Object file
, newname
, ok_if_already_exists
;
2711 Lisp_Object args
[2];
2713 Lisp_Object handler
;
2714 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2715 Lisp_Object encoded_file
, encoded_newname
, symlink_target
;
2717 symlink_target
= encoded_file
= encoded_newname
= Qnil
;
2718 GCPRO5 (file
, newname
, encoded_file
, encoded_newname
, symlink_target
);
2719 CHECK_STRING (file
);
2720 CHECK_STRING (newname
);
2721 file
= Fexpand_file_name (file
, Qnil
);
2723 if (!NILP (Ffile_directory_p (newname
)))
2724 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2726 newname
= Fexpand_file_name (newname
, Qnil
);
2728 /* If the file name has special constructs in it,
2729 call the corresponding file handler. */
2730 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2732 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2733 if (!NILP (handler
))
2734 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2735 file
, newname
, ok_if_already_exists
));
2737 encoded_file
= ENCODE_FILE (file
);
2738 encoded_newname
= ENCODE_FILE (newname
);
2741 /* If the file names are identical but for the case, don't ask for
2742 confirmation: they simply want to change the letter-case of the
2744 if (NILP (Fstring_equal (Fdowncase (file
), Fdowncase (newname
))))
2746 if (NILP (ok_if_already_exists
)
2747 || INTEGERP (ok_if_already_exists
))
2748 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2749 INTEGERP (ok_if_already_exists
), 0, 0);
2751 if (0 > rename (SDATA (encoded_file
), SDATA (encoded_newname
)))
2753 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
))
2754 || 0 > unlink (SDATA (encoded_file
)))
2760 symlink_target
= Ffile_symlink_p (file
);
2761 if (! NILP (symlink_target
))
2762 Fmake_symbolic_link (symlink_target
, newname
,
2763 NILP (ok_if_already_exists
) ? Qnil
: Qt
);
2766 Fcopy_file (file
, newname
,
2767 /* We have already prompted if it was an integer,
2768 so don't have copy-file prompt again. */
2769 NILP (ok_if_already_exists
) ? Qnil
: Qt
,
2771 Fdelete_file (file
);
2778 report_file_error ("Renaming", Flist (2, args
));
2781 report_file_error ("Renaming", Flist (2, &file
));
2788 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2789 "fAdd name to file: \nGName to add to %s: \np",
2790 doc
: /* Give FILE additional name NEWNAME. Both args strings.
2791 Signals a `file-already-exists' error if a file NEWNAME already exists
2792 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2793 A number as third arg means request confirmation if NEWNAME already exists.
2794 This is what happens in interactive use with M-x. */)
2795 (file
, newname
, ok_if_already_exists
)
2796 Lisp_Object file
, newname
, ok_if_already_exists
;
2799 Lisp_Object args
[2];
2801 Lisp_Object handler
;
2802 Lisp_Object encoded_file
, encoded_newname
;
2803 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2805 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2806 encoded_file
= encoded_newname
= Qnil
;
2807 CHECK_STRING (file
);
2808 CHECK_STRING (newname
);
2809 file
= Fexpand_file_name (file
, Qnil
);
2811 if (!NILP (Ffile_directory_p (newname
)))
2812 newname
= Fexpand_file_name (Ffile_name_nondirectory (file
), newname
);
2814 newname
= Fexpand_file_name (newname
, Qnil
);
2816 /* If the file name has special constructs in it,
2817 call the corresponding file handler. */
2818 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2819 if (!NILP (handler
))
2820 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2821 newname
, ok_if_already_exists
));
2823 /* If the new name has special constructs in it,
2824 call the corresponding file handler. */
2825 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2826 if (!NILP (handler
))
2827 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2828 newname
, ok_if_already_exists
));
2830 encoded_file
= ENCODE_FILE (file
);
2831 encoded_newname
= ENCODE_FILE (newname
);
2833 if (NILP (ok_if_already_exists
)
2834 || INTEGERP (ok_if_already_exists
))
2835 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2836 INTEGERP (ok_if_already_exists
), 0, 0);
2838 unlink (SDATA (newname
));
2839 if (0 > link (SDATA (encoded_file
), SDATA (encoded_newname
)))
2844 report_file_error ("Adding new name", Flist (2, args
));
2846 report_file_error ("Adding new name", Flist (2, &file
));
2855 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2856 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2857 doc
: /* Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2858 Signals a `file-already-exists' error if a file LINKNAME already exists
2859 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2860 A number as third arg means request confirmation if LINKNAME already exists.
2861 This happens for interactive use with M-x. */)
2862 (filename
, linkname
, ok_if_already_exists
)
2863 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2866 Lisp_Object args
[2];
2868 Lisp_Object handler
;
2869 Lisp_Object encoded_filename
, encoded_linkname
;
2870 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2872 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2873 encoded_filename
= encoded_linkname
= Qnil
;
2874 CHECK_STRING (filename
);
2875 CHECK_STRING (linkname
);
2876 /* If the link target has a ~, we must expand it to get
2877 a truly valid file name. Otherwise, do not expand;
2878 we want to permit links to relative file names. */
2879 if (SREF (filename
, 0) == '~')
2880 filename
= Fexpand_file_name (filename
, Qnil
);
2882 if (!NILP (Ffile_directory_p (linkname
)))
2883 linkname
= Fexpand_file_name (Ffile_name_nondirectory (filename
), linkname
);
2885 linkname
= Fexpand_file_name (linkname
, Qnil
);
2887 /* If the file name has special constructs in it,
2888 call the corresponding file handler. */
2889 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2890 if (!NILP (handler
))
2891 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2892 linkname
, ok_if_already_exists
));
2894 /* If the new link name has special constructs in it,
2895 call the corresponding file handler. */
2896 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2897 if (!NILP (handler
))
2898 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2899 linkname
, ok_if_already_exists
));
2901 encoded_filename
= ENCODE_FILE (filename
);
2902 encoded_linkname
= ENCODE_FILE (linkname
);
2904 if (NILP (ok_if_already_exists
)
2905 || INTEGERP (ok_if_already_exists
))
2906 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2907 INTEGERP (ok_if_already_exists
), 0, 0);
2908 if (0 > symlink (SDATA (encoded_filename
),
2909 SDATA (encoded_linkname
)))
2911 /* If we didn't complain already, silently delete existing file. */
2912 if (errno
== EEXIST
)
2914 unlink (SDATA (encoded_linkname
));
2915 if (0 <= symlink (SDATA (encoded_filename
),
2916 SDATA (encoded_linkname
)))
2926 report_file_error ("Making symbolic link", Flist (2, args
));
2928 report_file_error ("Making symbolic link", Flist (2, &filename
));
2934 #endif /* S_IFLNK */
2938 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2939 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2940 doc
: /* Define the job-wide logical name NAME to have the value STRING.
2941 If STRING is nil or a null string, the logical name NAME is deleted. */)
2946 CHECK_STRING (name
);
2948 delete_logical_name (SDATA (name
));
2951 CHECK_STRING (string
);
2953 if (SCHARS (string
) == 0)
2954 delete_logical_name (SDATA (name
));
2956 define_logical_name (SDATA (name
), SDATA (string
));
2965 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2966 doc
: /* Open a network connection to PATH using LOGIN as the login string. */)
2968 Lisp_Object path
, login
;
2972 CHECK_STRING (path
);
2973 CHECK_STRING (login
);
2975 netresult
= netunam (SDATA (path
), SDATA (login
));
2977 if (netresult
== -1)
2982 #endif /* HPUX_NET */
2984 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2986 doc
: /* Return t if file FILENAME specifies an absolute file name.
2987 On Unix, this is a name starting with a `/' or a `~'. */)
2989 Lisp_Object filename
;
2991 CHECK_STRING (filename
);
2992 return file_name_absolute_p (SDATA (filename
)) ? Qt
: Qnil
;
2995 /* Return nonzero if file FILENAME exists and can be executed. */
2998 check_executable (filename
)
3002 int len
= strlen (filename
);
3005 if (stat (filename
, &st
) < 0)
3007 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
3008 return ((st
.st_mode
& S_IEXEC
) != 0);
3010 return (S_ISREG (st
.st_mode
)
3012 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
3013 || stricmp (suffix
, ".exe") == 0
3014 || stricmp (suffix
, ".bat") == 0)
3015 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3016 #endif /* not WINDOWSNT */
3017 #else /* not DOS_NT */
3018 #ifdef HAVE_EUIDACCESS
3019 return (euidaccess (filename
, 1) >= 0);
3021 /* Access isn't quite right because it uses the real uid
3022 and we really want to test with the effective uid.
3023 But Unix doesn't give us a right way to do it. */
3024 return (access (filename
, 1) >= 0);
3026 #endif /* not DOS_NT */
3029 /* Return nonzero if file FILENAME exists and can be written. */
3032 check_writable (filename
)
3037 if (stat (filename
, &st
) < 0)
3039 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
3040 #else /* not MSDOS */
3041 #ifdef HAVE_EUIDACCESS
3042 return (euidaccess (filename
, 2) >= 0);
3044 /* Access isn't quite right because it uses the real uid
3045 and we really want to test with the effective uid.
3046 But Unix doesn't give us a right way to do it.
3047 Opening with O_WRONLY could work for an ordinary file,
3048 but would lose for directories. */
3049 return (access (filename
, 2) >= 0);
3051 #endif /* not MSDOS */
3054 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
3055 doc
: /* Return t if file FILENAME exists. (This does not mean you can read it.)
3056 See also `file-readable-p' and `file-attributes'. */)
3058 Lisp_Object filename
;
3060 Lisp_Object absname
;
3061 Lisp_Object handler
;
3062 struct stat statbuf
;
3064 CHECK_STRING (filename
);
3065 absname
= Fexpand_file_name (filename
, Qnil
);
3067 /* If the file name has special constructs in it,
3068 call the corresponding file handler. */
3069 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
3070 if (!NILP (handler
))
3071 return call2 (handler
, Qfile_exists_p
, absname
);
3073 absname
= ENCODE_FILE (absname
);
3075 return (stat (SDATA (absname
), &statbuf
) >= 0) ? Qt
: Qnil
;
3078 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
3079 doc
: /* Return t if FILENAME can be executed by you.
3080 For a directory, this means you can access files in that directory. */)
3082 Lisp_Object filename
;
3084 Lisp_Object absname
;
3085 Lisp_Object handler
;
3087 CHECK_STRING (filename
);
3088 absname
= Fexpand_file_name (filename
, Qnil
);
3090 /* If the file name has special constructs in it,
3091 call the corresponding file handler. */
3092 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
3093 if (!NILP (handler
))
3094 return call2 (handler
, Qfile_executable_p
, absname
);
3096 absname
= ENCODE_FILE (absname
);
3098 return (check_executable (SDATA (absname
)) ? Qt
: Qnil
);
3101 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
3102 doc
: /* Return t if file FILENAME exists and you can read it.
3103 See also `file-exists-p' and `file-attributes'. */)
3105 Lisp_Object filename
;
3107 Lisp_Object absname
;
3108 Lisp_Object handler
;
3111 struct stat statbuf
;
3113 CHECK_STRING (filename
);
3114 absname
= Fexpand_file_name (filename
, Qnil
);
3116 /* If the file name has special constructs in it,
3117 call the corresponding file handler. */
3118 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
3119 if (!NILP (handler
))
3120 return call2 (handler
, Qfile_readable_p
, absname
);
3122 absname
= ENCODE_FILE (absname
);
3124 #if defined(DOS_NT) || defined(macintosh)
3125 /* Under MS-DOS, Windows, and Macintosh, open does not work for
3127 if (access (SDATA (absname
), 0) == 0)
3130 #else /* not DOS_NT and not macintosh */
3132 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
3133 /* Opening a fifo without O_NONBLOCK can wait.
3134 We don't want to wait. But we don't want to mess wth O_NONBLOCK
3135 except in the case of a fifo, on a system which handles it. */
3136 desc
= stat (SDATA (absname
), &statbuf
);
3139 if (S_ISFIFO (statbuf
.st_mode
))
3140 flags
|= O_NONBLOCK
;
3142 desc
= emacs_open (SDATA (absname
), flags
, 0);
3147 #endif /* not DOS_NT and not macintosh */
3150 /* Having this before file-symlink-p mysteriously caused it to be forgotten
3152 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
3153 doc
: /* Return t if file FILENAME can be written or created by you. */)
3155 Lisp_Object filename
;
3157 Lisp_Object absname
, dir
, encoded
;
3158 Lisp_Object handler
;
3159 struct stat statbuf
;
3161 CHECK_STRING (filename
);
3162 absname
= Fexpand_file_name (filename
, Qnil
);
3164 /* If the file name has special constructs in it,
3165 call the corresponding file handler. */
3166 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
3167 if (!NILP (handler
))
3168 return call2 (handler
, Qfile_writable_p
, absname
);
3170 encoded
= ENCODE_FILE (absname
);
3171 if (stat (SDATA (encoded
), &statbuf
) >= 0)
3172 return (check_writable (SDATA (encoded
))
3175 dir
= Ffile_name_directory (absname
);
3178 dir
= Fdirectory_file_name (dir
);
3182 dir
= Fdirectory_file_name (dir
);
3185 dir
= ENCODE_FILE (dir
);
3187 /* The read-only attribute of the parent directory doesn't affect
3188 whether a file or directory can be created within it. Some day we
3189 should check ACLs though, which do affect this. */
3190 if (stat (SDATA (dir
), &statbuf
) < 0)
3192 return (statbuf
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3194 return (check_writable (!NILP (dir
) ? (char *) SDATA (dir
) : "")
3199 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
3200 doc
: /* Access file FILENAME, and get an error if that does not work.
3201 The second argument STRING is used in the error message.
3202 If there is no error, we return nil. */)
3204 Lisp_Object filename
, string
;
3206 Lisp_Object handler
, encoded_filename
, absname
;
3209 CHECK_STRING (filename
);
3210 absname
= Fexpand_file_name (filename
, Qnil
);
3212 CHECK_STRING (string
);
3214 /* If the file name has special constructs in it,
3215 call the corresponding file handler. */
3216 handler
= Ffind_file_name_handler (absname
, Qaccess_file
);
3217 if (!NILP (handler
))
3218 return call3 (handler
, Qaccess_file
, absname
, string
);
3220 encoded_filename
= ENCODE_FILE (absname
);
3222 fd
= emacs_open (SDATA (encoded_filename
), O_RDONLY
, 0);
3224 report_file_error (SDATA (string
), Fcons (filename
, Qnil
));
3230 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
3231 doc
: /* Return non-nil if file FILENAME is the name of a symbolic link.
3232 The value is the link target, as a string.
3233 Otherwise returns nil. */)
3235 Lisp_Object filename
;
3237 Lisp_Object handler
;
3239 CHECK_STRING (filename
);
3240 filename
= Fexpand_file_name (filename
, Qnil
);
3242 /* If the file name has special constructs in it,
3243 call the corresponding file handler. */
3244 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
3245 if (!NILP (handler
))
3246 return call2 (handler
, Qfile_symlink_p
, filename
);
3255 filename
= ENCODE_FILE (filename
);
3262 buf
= (char *) xrealloc (buf
, bufsize
);
3263 bzero (buf
, bufsize
);
3266 valsize
= readlink (SDATA (filename
), buf
, bufsize
);
3270 /* HP-UX reports ERANGE if buffer is too small. */
3271 if (errno
== ERANGE
)
3281 while (valsize
>= bufsize
);
3283 val
= make_string (buf
, valsize
);
3284 if (buf
[0] == '/' && index (buf
, ':'))
3285 val
= concat2 (build_string ("/:"), val
);
3287 val
= DECODE_FILE (val
);
3290 #else /* not S_IFLNK */
3292 #endif /* not S_IFLNK */
3295 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
3296 doc
: /* Return t if FILENAME names an existing directory.
3297 Symbolic links to directories count as directories.
3298 See `file-symlink-p' to distinguish symlinks. */)
3300 Lisp_Object filename
;
3302 register Lisp_Object absname
;
3304 Lisp_Object handler
;
3306 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3308 /* If the file name has special constructs in it,
3309 call the corresponding file handler. */
3310 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
3311 if (!NILP (handler
))
3312 return call2 (handler
, Qfile_directory_p
, absname
);
3314 absname
= ENCODE_FILE (absname
);
3316 if (stat (SDATA (absname
), &st
) < 0)
3318 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
3321 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
3322 doc
: /* Return t if file FILENAME names a directory you can open.
3323 For the value to be t, FILENAME must specify the name of a directory as a file,
3324 and the directory must allow you to open files in it. In order to use a
3325 directory as a buffer's current directory, this predicate must return true.
3326 A directory name spec may be given instead; then the value is t
3327 if the directory so specified exists and really is a readable and
3328 searchable directory. */)
3330 Lisp_Object filename
;
3332 Lisp_Object handler
;
3334 struct gcpro gcpro1
;
3336 /* If the file name has special constructs in it,
3337 call the corresponding file handler. */
3338 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
3339 if (!NILP (handler
))
3340 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
3343 tem
= (NILP (Ffile_directory_p (filename
))
3344 || NILP (Ffile_executable_p (filename
)));
3346 return tem
? Qnil
: Qt
;
3349 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
3350 doc
: /* Return t if file FILENAME is the name of a regular file.
3351 This is the sort of file that holds an ordinary stream of data bytes. */)
3353 Lisp_Object filename
;
3355 register Lisp_Object absname
;
3357 Lisp_Object handler
;
3359 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3361 /* If the file name has special constructs in it,
3362 call the corresponding file handler. */
3363 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
3364 if (!NILP (handler
))
3365 return call2 (handler
, Qfile_regular_p
, absname
);
3367 absname
= ENCODE_FILE (absname
);
3372 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3374 /* Tell stat to use expensive method to get accurate info. */
3375 Vw32_get_true_file_attributes
= Qt
;
3376 result
= stat (SDATA (absname
), &st
);
3377 Vw32_get_true_file_attributes
= tem
;
3381 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3384 if (stat (SDATA (absname
), &st
) < 0)
3386 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
3390 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
3391 doc
: /* Return mode bits of file named FILENAME, as an integer.
3392 Return nil, if file does not exist or is not accessible. */)
3394 Lisp_Object filename
;
3396 Lisp_Object absname
;
3398 Lisp_Object handler
;
3400 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
3402 /* If the file name has special constructs in it,
3403 call the corresponding file handler. */
3404 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
3405 if (!NILP (handler
))
3406 return call2 (handler
, Qfile_modes
, absname
);
3408 absname
= ENCODE_FILE (absname
);
3410 if (stat (SDATA (absname
), &st
) < 0)
3412 #if defined (MSDOS) && __DJGPP__ < 2
3413 if (check_executable (SDATA (absname
)))
3414 st
.st_mode
|= S_IEXEC
;
3415 #endif /* MSDOS && __DJGPP__ < 2 */
3417 return make_number (st
.st_mode
& 07777);
3420 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3421 doc
: /* Set mode bits of file named FILENAME to MODE (an integer).
3422 Only the 12 low bits of MODE are used. */)
3424 Lisp_Object filename
, mode
;
3426 Lisp_Object absname
, encoded_absname
;
3427 Lisp_Object handler
;
3429 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3430 CHECK_NUMBER (mode
);
3432 /* If the file name has special constructs in it,
3433 call the corresponding file handler. */
3434 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3435 if (!NILP (handler
))
3436 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3438 encoded_absname
= ENCODE_FILE (absname
);
3440 if (chmod (SDATA (encoded_absname
), XINT (mode
)) < 0)
3441 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3446 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3447 doc
: /* Set the file permission bits for newly created files.
3448 The argument MODE should be an integer; only the low 9 bits are used.
3449 This setting is inherited by subprocesses. */)
3453 CHECK_NUMBER (mode
);
3455 umask ((~ XINT (mode
)) & 0777);
3460 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3461 doc
: /* Return the default file protection for created files.
3462 The value is an integer. */)
3468 realmask
= umask (0);
3471 XSETINT (value
, (~ realmask
) & 0777);
3475 extern int lisp_time_argument
P_ ((Lisp_Object
, time_t *, int *));
3477 DEFUN ("set-file-times", Fset_file_times
, Sset_file_times
, 1, 2, 0,
3478 doc
: /* Set times of file FILENAME to TIME.
3479 Set both access and modification times.
3480 Return t on success, else nil.
3481 Use the current time if TIME is nil. TIME is in the format of
3484 Lisp_Object filename
, time
;
3486 Lisp_Object absname
, encoded_absname
;
3487 Lisp_Object handler
;
3491 if (! lisp_time_argument (time
, &sec
, &usec
))
3492 error ("Invalid time specification");
3494 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3496 /* If the file name has special constructs in it,
3497 call the corresponding file handler. */
3498 handler
= Ffind_file_name_handler (absname
, Qset_file_times
);
3499 if (!NILP (handler
))
3500 return call3 (handler
, Qset_file_times
, absname
, time
);
3502 encoded_absname
= ENCODE_FILE (absname
);
3507 EMACS_SET_SECS (t
, sec
);
3508 EMACS_SET_USECS (t
, usec
);
3510 if (set_file_times (SDATA (encoded_absname
), t
, t
))
3515 /* Setting times on a directory always fails. */
3516 if (stat (SDATA (encoded_absname
), &st
) == 0
3517 && (st
.st_mode
& S_IFMT
) == S_IFDIR
)
3520 report_file_error ("Setting file times", Fcons (absname
, Qnil
));
3533 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3534 doc
: /* Tell Unix to finish all pending disk updates. */)
3543 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3544 doc
: /* Return t if file FILE1 is newer than file FILE2.
3545 If FILE1 does not exist, the answer is nil;
3546 otherwise, if FILE2 does not exist, the answer is t. */)
3548 Lisp_Object file1
, file2
;
3550 Lisp_Object absname1
, absname2
;
3553 Lisp_Object handler
;
3554 struct gcpro gcpro1
, gcpro2
;
3556 CHECK_STRING (file1
);
3557 CHECK_STRING (file2
);
3560 GCPRO2 (absname1
, file2
);
3561 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3562 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3565 /* If the file name has special constructs in it,
3566 call the corresponding file handler. */
3567 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3569 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3570 if (!NILP (handler
))
3571 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3573 GCPRO2 (absname1
, absname2
);
3574 absname1
= ENCODE_FILE (absname1
);
3575 absname2
= ENCODE_FILE (absname2
);
3578 if (stat (SDATA (absname1
), &st
) < 0)
3581 mtime1
= st
.st_mtime
;
3583 if (stat (SDATA (absname2
), &st
) < 0)
3586 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3590 Lisp_Object Qfind_buffer_file_type
;
3593 #ifndef READ_BUF_SIZE
3594 #define READ_BUF_SIZE (64 << 10)
3597 extern void adjust_markers_for_delete
P_ ((int, int, int, int));
3599 /* This function is called after Lisp functions to decide a coding
3600 system are called, or when they cause an error. Before they are
3601 called, the current buffer is set unibyte and it contains only a
3602 newly inserted text (thus the buffer was empty before the
3605 The functions may set markers, overlays, text properties, or even
3606 alter the buffer contents, change the current buffer.
3608 Here, we reset all those changes by:
3609 o set back the current buffer.
3610 o move all markers and overlays to BEG.
3611 o remove all text properties.
3612 o set back the buffer multibyteness. */
3615 decide_coding_unwind (unwind_data
)
3616 Lisp_Object unwind_data
;
3618 Lisp_Object multibyte
, undo_list
, buffer
;
3620 multibyte
= XCAR (unwind_data
);
3621 unwind_data
= XCDR (unwind_data
);
3622 undo_list
= XCAR (unwind_data
);
3623 buffer
= XCDR (unwind_data
);
3625 if (current_buffer
!= XBUFFER (buffer
))
3626 set_buffer_internal (XBUFFER (buffer
));
3627 adjust_markers_for_delete (BEG
, BEG_BYTE
, Z
, Z_BYTE
);
3628 adjust_overlays_for_delete (BEG
, Z
- BEG
);
3629 BUF_INTERVALS (current_buffer
) = 0;
3630 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3632 /* Now we are safe to change the buffer's multibyteness directly. */
3633 current_buffer
->enable_multibyte_characters
= multibyte
;
3634 current_buffer
->undo_list
= undo_list
;
3640 /* Used to pass values from insert-file-contents to read_non_regular. */
3642 static int non_regular_fd
;
3643 static int non_regular_inserted
;
3644 static int non_regular_nbytes
;
3647 /* Read from a non-regular file.
3648 Read non_regular_trytry bytes max from non_regular_fd.
3649 Non_regular_inserted specifies where to put the read bytes.
3650 Value is the number of bytes read. */
3659 nbytes
= emacs_read (non_regular_fd
,
3660 BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ non_regular_inserted
,
3661 non_regular_nbytes
);
3663 return make_number (nbytes
);
3667 /* Condition-case handler used when reading from non-regular files
3668 in insert-file-contents. */
3671 read_non_regular_quit ()
3677 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3679 doc
: /* Insert contents of file FILENAME after point.
3680 Returns list of absolute file name and number of characters inserted.
3681 If second argument VISIT is non-nil, the buffer's visited filename
3682 and last save file modtime are set, and it is marked unmodified.
3683 If visiting and the file does not exist, visiting is completed
3684 before the error is signaled.
3685 The optional third and fourth arguments BEG and END
3686 specify what portion of the file to insert.
3687 These arguments count bytes in the file, not characters in the buffer.
3688 If VISIT is non-nil, BEG and END must be nil.
3690 If optional fifth argument REPLACE is non-nil,
3691 it means replace the current buffer contents (in the accessible portion)
3692 with the file contents. This is better than simply deleting and inserting
3693 the whole thing because (1) it preserves some marker positions
3694 and (2) it puts less data in the undo list.
3695 When REPLACE is non-nil, the value is the number of characters actually read,
3696 which is often less than the number of characters to be read.
3698 This does code conversion according to the value of
3699 `coding-system-for-read' or `file-coding-system-alist',
3700 and sets the variable `last-coding-system-used' to the coding system
3702 (filename
, visit
, beg
, end
, replace
)
3703 Lisp_Object filename
, visit
, beg
, end
, replace
;
3708 register int how_much
;
3709 register int unprocessed
;
3710 int count
= SPECPDL_INDEX ();
3711 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3712 Lisp_Object handler
, val
, insval
, orig_filename
;
3715 int not_regular
= 0;
3716 unsigned char read_buf
[READ_BUF_SIZE
];
3717 struct coding_system coding
;
3718 unsigned char buffer
[1 << 14];
3719 int replace_handled
= 0;
3720 int set_coding_system
= 0;
3721 int coding_system_decided
= 0;
3724 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3725 error ("Cannot do file visiting in an indirect buffer");
3727 if (!NILP (current_buffer
->read_only
))
3728 Fbarf_if_buffer_read_only ();
3732 orig_filename
= Qnil
;
3734 GCPRO4 (filename
, val
, p
, orig_filename
);
3736 CHECK_STRING (filename
);
3737 filename
= Fexpand_file_name (filename
, Qnil
);
3739 /* If the file name has special constructs in it,
3740 call the corresponding file handler. */
3741 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3742 if (!NILP (handler
))
3744 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3745 visit
, beg
, end
, replace
);
3746 if (CONSP (val
) && CONSP (XCDR (val
)))
3747 inserted
= XINT (XCAR (XCDR (val
)));
3751 orig_filename
= filename
;
3752 filename
= ENCODE_FILE (filename
);
3758 Lisp_Object tem
= Vw32_get_true_file_attributes
;
3760 /* Tell stat to use expensive method to get accurate info. */
3761 Vw32_get_true_file_attributes
= Qt
;
3762 total
= stat (SDATA (filename
), &st
);
3763 Vw32_get_true_file_attributes
= tem
;
3768 if (stat (SDATA (filename
), &st
) < 0)
3770 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0
3771 || fstat (fd
, &st
) < 0)
3772 #endif /* not APOLLO */
3773 #endif /* WINDOWSNT */
3775 if (fd
>= 0) emacs_close (fd
);
3778 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3781 if (!NILP (Vcoding_system_for_read
))
3782 Fset (Qbuffer_file_coding_system
, Vcoding_system_for_read
);
3787 /* This code will need to be changed in order to work on named
3788 pipes, and it's probably just not worth it. So we should at
3789 least signal an error. */
3790 if (!S_ISREG (st
.st_mode
))
3797 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3798 Fsignal (Qfile_error
,
3799 Fcons (build_string ("not a regular file"),
3800 Fcons (orig_filename
, Qnil
)));
3805 if ((fd
= emacs_open (SDATA (filename
), O_RDONLY
, 0)) < 0)
3808 /* Replacement should preserve point as it preserves markers. */
3809 if (!NILP (replace
))
3810 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3812 record_unwind_protect (close_file_unwind
, make_number (fd
));
3814 /* Supposedly happens on VMS. */
3815 /* Can happen on any platform that uses long as type of off_t, but allows
3816 file sizes to exceed 2Gb. VMS is no longer officially supported, so
3817 give a message suitable for the latter case. */
3818 if (! not_regular
&& st
.st_size
< 0)
3819 error ("Maximum buffer size exceeded");
3821 /* Prevent redisplay optimizations. */
3822 current_buffer
->clip_changed
= 1;
3826 if (!NILP (beg
) || !NILP (end
))
3827 error ("Attempt to visit less than an entire file");
3828 if (BEG
< Z
&& NILP (replace
))
3829 error ("Cannot do file visiting in a non-empty buffer");
3835 XSETFASTINT (beg
, 0);
3843 XSETINT (end
, st
.st_size
);
3845 /* Arithmetic overflow can occur if an Emacs integer cannot
3846 represent the file size, or if the calculations below
3847 overflow. The calculations below double the file size
3848 twice, so check that it can be multiplied by 4 safely. */
3849 if (XINT (end
) != st
.st_size
3850 || ((int) st
.st_size
* 4) / 4 != st
.st_size
)
3851 error ("Maximum buffer size exceeded");
3853 /* The file size returned from stat may be zero, but data
3854 may be readable nonetheless, for example when this is a
3855 file in the /proc filesystem. */
3856 if (st
.st_size
== 0)
3857 XSETINT (end
, READ_BUF_SIZE
);
3861 if (EQ (Vcoding_system_for_read
, Qauto_save_coding
))
3863 /* We use emacs-mule for auto saving... */
3864 setup_coding_system (Qemacs_mule
, &coding
);
3865 /* ... but with the special flag to indicate to read in a
3866 multibyte sequence for eight-bit-control char as is. */
3868 coding
.src_multibyte
= 0;
3869 coding
.dst_multibyte
3870 = !NILP (current_buffer
->enable_multibyte_characters
);
3871 coding
.eol_type
= CODING_EOL_LF
;
3872 coding_system_decided
= 1;
3876 /* Decide the coding system to use for reading the file now
3877 because we can't use an optimized method for handling
3878 `coding:' tag if the current buffer is not empty. */
3882 if (!NILP (Vcoding_system_for_read
))
3883 val
= Vcoding_system_for_read
;
3886 /* Don't try looking inside a file for a coding system
3887 specification if it is not seekable. */
3888 if (! not_regular
&& ! NILP (Vset_auto_coding_function
))
3890 /* Find a coding system specified in the heading two
3891 lines or in the tailing several lines of the file.
3892 We assume that the 1K-byte and 3K-byte for heading
3893 and tailing respectively are sufficient for this
3897 if (st
.st_size
<= (1024 * 4))
3898 nread
= emacs_read (fd
, read_buf
, 1024 * 4);
3901 nread
= emacs_read (fd
, read_buf
, 1024);
3904 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3905 report_file_error ("Setting file position",
3906 Fcons (orig_filename
, Qnil
));
3907 nread
+= emacs_read (fd
, read_buf
+ nread
, 1024 * 3);
3912 error ("IO error reading %s: %s",
3913 SDATA (orig_filename
), emacs_strerror (errno
));
3916 struct buffer
*prev
= current_buffer
;
3920 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
3922 buffer
= Fget_buffer_create (build_string (" *code-converting-work*"));
3923 buf
= XBUFFER (buffer
);
3925 delete_all_overlays (buf
);
3926 buf
->directory
= current_buffer
->directory
;
3927 buf
->read_only
= Qnil
;
3928 buf
->filename
= Qnil
;
3929 buf
->undo_list
= Qt
;
3930 eassert (buf
->overlays_before
== NULL
);
3931 eassert (buf
->overlays_after
== NULL
);
3933 set_buffer_internal (buf
);
3935 buf
->enable_multibyte_characters
= Qnil
;
3937 insert_1_both (read_buf
, nread
, nread
, 0, 0, 0);
3938 TEMP_SET_PT_BOTH (BEG
, BEG_BYTE
);
3939 val
= call2 (Vset_auto_coding_function
,
3940 filename
, make_number (nread
));
3941 set_buffer_internal (prev
);
3943 /* Discard the unwind protect for recovering the
3947 /* Rewind the file for the actual read done later. */
3948 if (lseek (fd
, 0, 0) < 0)
3949 report_file_error ("Setting file position",
3950 Fcons (orig_filename
, Qnil
));
3956 /* If we have not yet decided a coding system, check
3957 file-coding-system-alist. */
3958 Lisp_Object args
[6], coding_systems
;
3960 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
3961 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3962 coding_systems
= Ffind_operation_coding_system (6, args
);
3963 if (CONSP (coding_systems
))
3964 val
= XCAR (coding_systems
);
3968 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3969 /* Ensure we set Vlast_coding_system_used. */
3970 set_coding_system
= 1;
3972 if (NILP (current_buffer
->enable_multibyte_characters
)
3974 /* We must suppress all character code conversion except for
3975 end-of-line conversion. */
3976 setup_raw_text_coding_system (&coding
);
3978 coding
.src_multibyte
= 0;
3979 coding
.dst_multibyte
3980 = !NILP (current_buffer
->enable_multibyte_characters
);
3981 coding_system_decided
= 1;
3984 /* If requested, replace the accessible part of the buffer
3985 with the file contents. Avoid replacing text at the
3986 beginning or end of the buffer that matches the file contents;
3987 that preserves markers pointing to the unchanged parts.
3989 Here we implement this feature in an optimized way
3990 for the case where code conversion is NOT needed.
3991 The following if-statement handles the case of conversion
3992 in a less optimal way.
3994 If the code conversion is "automatic" then we try using this
3995 method and hope for the best.
3996 But if we discover the need for conversion, we give up on this method
3997 and let the following if-statement handle the replace job. */
4000 && !(coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
))
4002 /* same_at_start and same_at_end count bytes,
4003 because file access counts bytes
4004 and BEG and END count bytes. */
4005 int same_at_start
= BEGV_BYTE
;
4006 int same_at_end
= ZV_BYTE
;
4008 /* There is still a possibility we will find the need to do code
4009 conversion. If that happens, we set this variable to 1 to
4010 give up on handling REPLACE in the optimized way. */
4011 int giveup_match_end
= 0;
4013 if (XINT (beg
) != 0)
4015 if (lseek (fd
, XINT (beg
), 0) < 0)
4016 report_file_error ("Setting file position",
4017 Fcons (orig_filename
, Qnil
));
4022 /* Count how many chars at the start of the file
4023 match the text at the beginning of the buffer. */
4028 nread
= emacs_read (fd
, buffer
, sizeof buffer
);
4030 error ("IO error reading %s: %s",
4031 SDATA (orig_filename
), emacs_strerror (errno
));
4032 else if (nread
== 0)
4035 if (coding
.type
== coding_type_undecided
)
4036 detect_coding (&coding
, buffer
, nread
);
4037 if (coding
.common_flags
& CODING_REQUIRE_DECODING_MASK
)
4038 /* We found that the file should be decoded somehow.
4039 Let's give up here. */
4041 giveup_match_end
= 1;
4045 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
4046 detect_eol (&coding
, buffer
, nread
);
4047 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
4048 && coding
.eol_type
!= CODING_EOL_LF
)
4049 /* We found that the format of eol should be decoded.
4050 Let's give up here. */
4052 giveup_match_end
= 1;
4057 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
4058 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
4059 same_at_start
++, bufpos
++;
4060 /* If we found a discrepancy, stop the scan.
4061 Otherwise loop around and scan the next bufferful. */
4062 if (bufpos
!= nread
)
4066 /* If the file matches the buffer completely,
4067 there's no need to replace anything. */
4068 if (same_at_start
- BEGV_BYTE
== XINT (end
))
4072 /* Truncate the buffer to the size of the file. */
4073 del_range_1 (same_at_start
, same_at_end
, 0, 0);
4078 /* Count how many chars at the end of the file
4079 match the text at the end of the buffer. But, if we have
4080 already found that decoding is necessary, don't waste time. */
4081 while (!giveup_match_end
)
4083 int total_read
, nread
, bufpos
, curpos
, trial
;
4085 /* At what file position are we now scanning? */
4086 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
4087 /* If the entire file matches the buffer tail, stop the scan. */
4090 /* How much can we scan in the next step? */
4091 trial
= min (curpos
, sizeof buffer
);
4092 if (lseek (fd
, curpos
- trial
, 0) < 0)
4093 report_file_error ("Setting file position",
4094 Fcons (orig_filename
, Qnil
));
4096 total_read
= nread
= 0;
4097 while (total_read
< trial
)
4099 nread
= emacs_read (fd
, buffer
+ total_read
, trial
- total_read
);
4101 error ("IO error reading %s: %s",
4102 SDATA (orig_filename
), emacs_strerror (errno
));
4103 else if (nread
== 0)
4105 total_read
+= nread
;
4108 /* Scan this bufferful from the end, comparing with
4109 the Emacs buffer. */
4110 bufpos
= total_read
;
4112 /* Compare with same_at_start to avoid counting some buffer text
4113 as matching both at the file's beginning and at the end. */
4114 while (bufpos
> 0 && same_at_end
> same_at_start
4115 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
4116 same_at_end
--, bufpos
--;
4118 /* If we found a discrepancy, stop the scan.
4119 Otherwise loop around and scan the preceding bufferful. */
4122 /* If this discrepancy is because of code conversion,
4123 we cannot use this method; giveup and try the other. */
4124 if (same_at_end
> same_at_start
4125 && FETCH_BYTE (same_at_end
- 1) >= 0200
4126 && ! NILP (current_buffer
->enable_multibyte_characters
)
4127 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
4128 giveup_match_end
= 1;
4137 if (! giveup_match_end
)
4141 /* We win! We can handle REPLACE the optimized way. */
4143 /* Extend the start of non-matching text area to multibyte
4144 character boundary. */
4145 if (! NILP (current_buffer
->enable_multibyte_characters
))
4146 while (same_at_start
> BEGV_BYTE
4147 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4150 /* Extend the end of non-matching text area to multibyte
4151 character boundary. */
4152 if (! NILP (current_buffer
->enable_multibyte_characters
))
4153 while (same_at_end
< ZV_BYTE
4154 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4157 /* Don't try to reuse the same piece of text twice. */
4158 overlap
= (same_at_start
- BEGV_BYTE
4159 - (same_at_end
+ st
.st_size
- ZV
));
4161 same_at_end
+= overlap
;
4163 /* Arrange to read only the nonmatching middle part of the file. */
4164 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
4165 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
4167 del_range_byte (same_at_start
, same_at_end
, 0);
4168 /* Insert from the file at the proper position. */
4169 temp
= BYTE_TO_CHAR (same_at_start
);
4170 SET_PT_BOTH (temp
, same_at_start
);
4172 /* If display currently starts at beginning of line,
4173 keep it that way. */
4174 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4175 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4177 replace_handled
= 1;
4181 /* If requested, replace the accessible part of the buffer
4182 with the file contents. Avoid replacing text at the
4183 beginning or end of the buffer that matches the file contents;
4184 that preserves markers pointing to the unchanged parts.
4186 Here we implement this feature for the case where code conversion
4187 is needed, in a simple way that needs a lot of memory.
4188 The preceding if-statement handles the case of no conversion
4189 in a more optimized way. */
4190 if (!NILP (replace
) && ! replace_handled
&& BEGV
< ZV
)
4192 int same_at_start
= BEGV_BYTE
;
4193 int same_at_end
= ZV_BYTE
;
4196 /* Make sure that the gap is large enough. */
4197 int bufsize
= 2 * st
.st_size
;
4198 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
4201 /* First read the whole file, performing code conversion into
4202 CONVERSION_BUFFER. */
4204 if (lseek (fd
, XINT (beg
), 0) < 0)
4206 xfree (conversion_buffer
);
4207 report_file_error ("Setting file position",
4208 Fcons (orig_filename
, Qnil
));
4211 total
= st
.st_size
; /* Total bytes in the file. */
4212 how_much
= 0; /* Bytes read from file so far. */
4213 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
4214 unprocessed
= 0; /* Bytes not processed in previous loop. */
4216 while (how_much
< total
)
4218 /* try is reserved in some compilers (Microsoft C) */
4219 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
4220 unsigned char *destination
= read_buf
+ unprocessed
;
4223 /* Allow quitting out of the actual I/O. */
4226 this = emacs_read (fd
, destination
, trytry
);
4229 if (this < 0 || this + unprocessed
== 0)
4237 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4239 int require
, result
;
4241 this += unprocessed
;
4243 /* If we are using more space than estimated,
4244 make CONVERSION_BUFFER bigger. */
4245 require
= decoding_buffer_size (&coding
, this);
4246 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
4248 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
4249 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
4252 /* Convert this batch with results in CONVERSION_BUFFER. */
4253 if (how_much
>= total
) /* This is the last block. */
4254 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4255 if (coding
.composing
!= COMPOSITION_DISABLED
)
4256 coding_allocate_composition_data (&coding
, BEGV
);
4257 result
= decode_coding (&coding
, read_buf
,
4258 conversion_buffer
+ inserted
,
4259 this, bufsize
- inserted
);
4261 /* Save for next iteration whatever we didn't convert. */
4262 unprocessed
= this - coding
.consumed
;
4263 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
4264 if (!NILP (current_buffer
->enable_multibyte_characters
))
4265 this = coding
.produced
;
4267 this = str_as_unibyte (conversion_buffer
+ inserted
,
4274 /* At this point, INSERTED is how many characters (i.e. bytes)
4275 are present in CONVERSION_BUFFER.
4276 HOW_MUCH should equal TOTAL,
4277 or should be <= 0 if we couldn't read the file. */
4281 xfree (conversion_buffer
);
4282 coding_free_composition_data (&coding
);
4284 error ("IO error reading %s: %s",
4285 SDATA (orig_filename
), emacs_strerror (errno
));
4286 else if (how_much
== -2)
4287 error ("maximum buffer size exceeded");
4290 /* Compare the beginning of the converted file
4291 with the buffer text. */
4294 while (bufpos
< inserted
&& same_at_start
< same_at_end
4295 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
4296 same_at_start
++, bufpos
++;
4298 /* If the file matches the buffer completely,
4299 there's no need to replace anything. */
4301 if (bufpos
== inserted
)
4303 xfree (conversion_buffer
);
4304 coding_free_composition_data (&coding
);
4307 /* Truncate the buffer to the size of the file. */
4308 del_range_byte (same_at_start
, same_at_end
, 0);
4313 /* Extend the start of non-matching text area to multibyte
4314 character boundary. */
4315 if (! NILP (current_buffer
->enable_multibyte_characters
))
4316 while (same_at_start
> BEGV_BYTE
4317 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start
)))
4320 /* Scan this bufferful from the end, comparing with
4321 the Emacs buffer. */
4324 /* Compare with same_at_start to avoid counting some buffer text
4325 as matching both at the file's beginning and at the end. */
4326 while (bufpos
> 0 && same_at_end
> same_at_start
4327 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
4328 same_at_end
--, bufpos
--;
4330 /* Extend the end of non-matching text area to multibyte
4331 character boundary. */
4332 if (! NILP (current_buffer
->enable_multibyte_characters
))
4333 while (same_at_end
< ZV_BYTE
4334 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
4337 /* Don't try to reuse the same piece of text twice. */
4338 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
4340 same_at_end
+= overlap
;
4342 /* If display currently starts at beginning of line,
4343 keep it that way. */
4344 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
4345 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
4347 /* Replace the chars that we need to replace,
4348 and update INSERTED to equal the number of bytes
4349 we are taking from the file. */
4350 inserted
-= (ZV_BYTE
- same_at_end
) + (same_at_start
- BEGV_BYTE
);
4352 if (same_at_end
!= same_at_start
)
4354 del_range_byte (same_at_start
, same_at_end
, 0);
4356 same_at_start
= GPT_BYTE
;
4360 temp
= BYTE_TO_CHAR (same_at_start
);
4362 /* Insert from the file at the proper position. */
4363 SET_PT_BOTH (temp
, same_at_start
);
4364 insert_1 (conversion_buffer
+ same_at_start
- BEGV_BYTE
, inserted
,
4366 if (coding
.cmp_data
&& coding
.cmp_data
->used
)
4367 coding_restore_composition (&coding
, Fcurrent_buffer ());
4368 coding_free_composition_data (&coding
);
4370 /* Set `inserted' to the number of inserted characters. */
4371 inserted
= PT
- temp
;
4373 xfree (conversion_buffer
);
4382 register Lisp_Object temp
;
4384 total
= XINT (end
) - XINT (beg
);
4386 /* Make sure point-max won't overflow after this insertion. */
4387 XSETINT (temp
, total
);
4388 if (total
!= XINT (temp
))
4389 error ("Maximum buffer size exceeded");
4392 /* For a special file, all we can do is guess. */
4393 total
= READ_BUF_SIZE
;
4395 if (NILP (visit
) && total
> 0)
4396 prepare_to_modify_buffer (PT
, PT
, NULL
);
4399 if (GAP_SIZE
< total
)
4400 make_gap (total
- GAP_SIZE
);
4402 if (XINT (beg
) != 0 || !NILP (replace
))
4404 if (lseek (fd
, XINT (beg
), 0) < 0)
4405 report_file_error ("Setting file position",
4406 Fcons (orig_filename
, Qnil
));
4409 /* In the following loop, HOW_MUCH contains the total bytes read so
4410 far for a regular file, and not changed for a special file. But,
4411 before exiting the loop, it is set to a negative value if I/O
4415 /* Total bytes inserted. */
4418 /* Here, we don't do code conversion in the loop. It is done by
4419 code_convert_region after all data are read into the buffer. */
4421 int gap_size
= GAP_SIZE
;
4423 while (how_much
< total
)
4425 /* try is reserved in some compilers (Microsoft C) */
4426 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
4433 /* Maybe make more room. */
4434 if (gap_size
< trytry
)
4436 make_gap (total
- gap_size
);
4437 gap_size
= GAP_SIZE
;
4440 /* Read from the file, capturing `quit'. When an
4441 error occurs, end the loop, and arrange for a quit
4442 to be signaled after decoding the text we read. */
4443 non_regular_fd
= fd
;
4444 non_regular_inserted
= inserted
;
4445 non_regular_nbytes
= trytry
;
4446 val
= internal_condition_case_1 (read_non_regular
, Qnil
, Qerror
,
4447 read_non_regular_quit
);
4458 /* Allow quitting out of the actual I/O. We don't make text
4459 part of the buffer until all the reading is done, so a C-g
4460 here doesn't do any harm. */
4463 this = emacs_read (fd
, BEG_ADDR
+ PT_BYTE
- BEG_BYTE
+ inserted
, trytry
);
4475 /* For a regular file, where TOTAL is the real size,
4476 count HOW_MUCH to compare with it.
4477 For a special file, where TOTAL is just a buffer size,
4478 so don't bother counting in HOW_MUCH.
4479 (INSERTED is where we count the number of characters inserted.) */
4486 /* Make the text read part of the buffer. */
4487 GAP_SIZE
-= inserted
;
4489 GPT_BYTE
+= inserted
;
4491 ZV_BYTE
+= inserted
;
4496 /* Put an anchor to ensure multi-byte form ends at gap. */
4501 /* Discard the unwind protect for closing the file. */
4505 error ("IO error reading %s: %s",
4506 SDATA (orig_filename
), emacs_strerror (errno
));
4510 if (! coding_system_decided
)
4512 /* The coding system is not yet decided. Decide it by an
4513 optimized method for handling `coding:' tag.
4515 Note that we can get here only if the buffer was empty
4516 before the insertion. */
4520 if (!NILP (Vcoding_system_for_read
))
4521 val
= Vcoding_system_for_read
;
4524 /* Since we are sure that the current buffer was empty
4525 before the insertion, we can toggle
4526 enable-multibyte-characters directly here without taking
4527 care of marker adjustment and byte combining problem. By
4528 this way, we can run Lisp program safely before decoding
4529 the inserted text. */
4530 Lisp_Object unwind_data
;
4531 int count
= SPECPDL_INDEX ();
4533 unwind_data
= Fcons (current_buffer
->enable_multibyte_characters
,
4534 Fcons (current_buffer
->undo_list
,
4535 Fcurrent_buffer ()));
4536 current_buffer
->enable_multibyte_characters
= Qnil
;
4537 current_buffer
->undo_list
= Qt
;
4538 record_unwind_protect (decide_coding_unwind
, unwind_data
);
4540 if (inserted
> 0 && ! NILP (Vset_auto_coding_function
))
4542 val
= call2 (Vset_auto_coding_function
,
4543 filename
, make_number (inserted
));
4548 /* If the coding system is not yet decided, check
4549 file-coding-system-alist. */
4550 Lisp_Object args
[6], coding_systems
;
4552 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
;
4553 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = Qnil
;
4554 coding_systems
= Ffind_operation_coding_system (6, args
);
4555 if (CONSP (coding_systems
))
4556 val
= XCAR (coding_systems
);
4558 unbind_to (count
, Qnil
);
4559 inserted
= Z_BYTE
- BEG_BYTE
;
4562 /* The following kludgy code is to avoid some compiler bug.
4564 setup_coding_system (val, &coding);
4567 struct coding_system temp_coding
;
4568 setup_coding_system (Fcheck_coding_system (val
), &temp_coding
);
4569 bcopy (&temp_coding
, &coding
, sizeof coding
);
4571 /* Ensure we set Vlast_coding_system_used. */
4572 set_coding_system
= 1;
4574 if (NILP (current_buffer
->enable_multibyte_characters
)
4576 /* We must suppress all character code conversion except for
4577 end-of-line conversion. */
4578 setup_raw_text_coding_system (&coding
);
4579 coding
.src_multibyte
= 0;
4580 coding
.dst_multibyte
4581 = !NILP (current_buffer
->enable_multibyte_characters
);
4585 /* Can't do this if part of the buffer might be preserved. */
4587 && (coding
.type
== coding_type_no_conversion
4588 || coding
.type
== coding_type_raw_text
))
4590 /* Visiting a file with these coding system makes the buffer
4592 current_buffer
->enable_multibyte_characters
= Qnil
;
4593 coding
.dst_multibyte
= 0;
4596 if (inserted
> 0 || coding
.type
== coding_type_ccl
)
4598 if (CODING_MAY_REQUIRE_DECODING (&coding
))
4600 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4602 inserted
= coding
.produced_char
;
4605 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
4609 /* Now INSERTED is measured in characters. */
4612 /* Use the conversion type to determine buffer-file-type
4613 (find-buffer-file-type is now used to help determine the
4615 if ((coding
.eol_type
== CODING_EOL_UNDECIDED
4616 || coding
.eol_type
== CODING_EOL_LF
)
4617 && ! CODING_REQUIRE_DECODING (&coding
))
4618 current_buffer
->buffer_file_type
= Qt
;
4620 current_buffer
->buffer_file_type
= Qnil
;
4627 if (!EQ (current_buffer
->undo_list
, Qt
))
4628 current_buffer
->undo_list
= Qnil
;
4630 stat (SDATA (filename
), &st
);
4635 current_buffer
->modtime
= st
.st_mtime
;
4636 current_buffer
->filename
= orig_filename
;
4639 SAVE_MODIFF
= MODIFF
;
4640 current_buffer
->auto_save_modified
= MODIFF
;
4641 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4642 #ifdef CLASH_DETECTION
4645 if (!NILP (current_buffer
->file_truename
))
4646 unlock_file (current_buffer
->file_truename
);
4647 unlock_file (filename
);
4649 #endif /* CLASH_DETECTION */
4651 Fsignal (Qfile_error
,
4652 Fcons (build_string ("not a regular file"),
4653 Fcons (orig_filename
, Qnil
)));
4656 if (set_coding_system
)
4657 Vlast_coding_system_used
= coding
.symbol
;
4659 if (! NILP (Ffboundp (Qafter_insert_file_set_coding
)))
4661 insval
= call2 (Qafter_insert_file_set_coding
, make_number (inserted
),
4663 if (! NILP (insval
))
4665 CHECK_NUMBER (insval
);
4666 inserted
= XFASTINT (insval
);
4670 /* Decode file format */
4673 int empty_undo_list_p
= 0;
4675 /* If we're anyway going to discard undo information, don't
4676 record it in the first place. The buffer's undo list at this
4677 point is either nil or t when visiting a file. */
4680 empty_undo_list_p
= NILP (current_buffer
->undo_list
);
4681 current_buffer
->undo_list
= Qt
;
4684 insval
= call3 (Qformat_decode
,
4685 Qnil
, make_number (inserted
), visit
);
4686 CHECK_NUMBER (insval
);
4687 inserted
= XFASTINT (insval
);
4690 current_buffer
->undo_list
= empty_undo_list_p
? Qnil
: Qt
;
4693 /* Call after-change hooks for the inserted text, aside from the case
4694 of normal visiting (not with REPLACE), which is done in a new buffer
4695 "before" the buffer is changed. */
4696 if (inserted
> 0 && total
> 0
4697 && (NILP (visit
) || !NILP (replace
)))
4699 signal_after_change (PT
, 0, inserted
);
4700 update_compositions (PT
, PT
, CHECK_BORDER
);
4703 p
= Vafter_insert_file_functions
;
4706 insval
= call1 (XCAR (p
), make_number (inserted
));
4709 CHECK_NUMBER (insval
);
4710 inserted
= XFASTINT (insval
);
4717 && current_buffer
->modtime
== -1)
4719 /* If visiting nonexistent file, return nil. */
4720 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
4724 Fsignal (Qquit
, Qnil
);
4726 /* ??? Retval needs to be dealt with in all cases consistently. */
4728 val
= Fcons (orig_filename
,
4729 Fcons (make_number (inserted
),
4732 RETURN_UNGCPRO (unbind_to (count
, val
));
4735 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
));
4736 static Lisp_Object build_annotations_2
P_ ((Lisp_Object
, Lisp_Object
,
4737 Lisp_Object
, Lisp_Object
));
4739 /* If build_annotations switched buffers, switch back to BUF.
4740 Kill the temporary buffer that was selected in the meantime.
4742 Since this kill only the last temporary buffer, some buffers remain
4743 not killed if build_annotations switched buffers more than once.
4747 build_annotations_unwind (buf
)
4752 if (XBUFFER (buf
) == current_buffer
)
4754 tembuf
= Fcurrent_buffer ();
4756 Fkill_buffer (tembuf
);
4760 /* Decide the coding-system to encode the data with. */
4763 choose_write_coding_system (start
, end
, filename
,
4764 append
, visit
, lockname
, coding
)
4765 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
4766 struct coding_system
*coding
;
4771 && NILP (Fstring_equal (current_buffer
->filename
,
4772 current_buffer
->auto_save_file_name
)))
4774 /* We use emacs-mule for auto saving... */
4775 setup_coding_system (Qemacs_mule
, coding
);
4776 /* ... but with the special flag to indicate not to strip off
4777 leading code of eight-bit-control chars. */
4779 goto done_setup_coding
;
4781 else if (!NILP (Vcoding_system_for_write
))
4783 val
= Vcoding_system_for_write
;
4784 if (coding_system_require_warning
4785 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4786 /* Confirm that VAL can surely encode the current region. */
4787 val
= call5 (Vselect_safe_coding_system_function
,
4788 start
, end
, Fcons (Qt
, Fcons (val
, Qnil
)),
4793 /* If the variable `buffer-file-coding-system' is set locally,
4794 it means that the file was read with some kind of code
4795 conversion or the variable is explicitly set by users. We
4796 had better write it out with the same coding system even if
4797 `enable-multibyte-characters' is nil.
4799 If it is not set locally, we anyway have to convert EOL
4800 format if the default value of `buffer-file-coding-system'
4801 tells that it is not Unix-like (LF only) format. */
4802 int using_default_coding
= 0;
4803 int force_raw_text
= 0;
4805 val
= current_buffer
->buffer_file_coding_system
;
4807 || NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4810 if (NILP (current_buffer
->enable_multibyte_characters
))
4816 /* Check file-coding-system-alist. */
4817 Lisp_Object args
[7], coding_systems
;
4819 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4820 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4822 coding_systems
= Ffind_operation_coding_system (7, args
);
4823 if (CONSP (coding_systems
) && !NILP (XCDR (coding_systems
)))
4824 val
= XCDR (coding_systems
);
4828 && !NILP (current_buffer
->buffer_file_coding_system
))
4830 /* If we still have not decided a coding system, use the
4831 default value of buffer-file-coding-system. */
4832 val
= current_buffer
->buffer_file_coding_system
;
4833 using_default_coding
= 1;
4837 && !NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4838 /* Confirm that VAL can surely encode the current region. */
4839 val
= call5 (Vselect_safe_coding_system_function
,
4840 start
, end
, val
, Qnil
, filename
);
4842 setup_coding_system (Fcheck_coding_system (val
), coding
);
4843 if (coding
->eol_type
== CODING_EOL_UNDECIDED
4844 && !using_default_coding
)
4846 if (! EQ (default_buffer_file_coding
.symbol
,
4847 buffer_defaults
.buffer_file_coding_system
))
4848 setup_coding_system (buffer_defaults
.buffer_file_coding_system
,
4849 &default_buffer_file_coding
);
4850 if (default_buffer_file_coding
.eol_type
!= CODING_EOL_UNDECIDED
)
4852 Lisp_Object subsidiaries
;
4854 coding
->eol_type
= default_buffer_file_coding
.eol_type
;
4855 subsidiaries
= Fget (coding
->symbol
, Qeol_type
);
4856 if (VECTORP (subsidiaries
)
4857 && XVECTOR (subsidiaries
)->size
== 3)
4859 = XVECTOR (subsidiaries
)->contents
[coding
->eol_type
];
4864 setup_raw_text_coding_system (coding
);
4865 goto done_setup_coding
;
4868 setup_coding_system (Fcheck_coding_system (val
), coding
);
4871 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4872 coding
->mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4875 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
4876 "r\nFWrite region to file: \ni\ni\ni\np",
4877 doc
: /* Write current region into specified file.
4878 When called from a program, requires three arguments:
4879 START, END and FILENAME. START and END are normally buffer positions
4880 specifying the part of the buffer to write.
4881 If START is nil, that means to use the entire buffer contents.
4882 If START is a string, then output that string to the file
4883 instead of any buffer contents; END is ignored.
4885 Optional fourth argument APPEND if non-nil means
4886 append to existing file contents (if any). If it is an integer,
4887 seek to that offset in the file before writing.
4888 Optional fifth argument VISIT, if t or a string, means
4889 set the last-save-file-modtime of buffer to this file's modtime
4890 and mark buffer not modified.
4891 If VISIT is a string, it is a second file name;
4892 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4893 VISIT is also the file name to lock and unlock for clash detection.
4894 If VISIT is neither t nor nil nor a string,
4895 that means do not display the \"Wrote file\" message.
4896 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4897 use for locking and unlocking, overriding FILENAME and VISIT.
4898 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4899 for an existing file with the same name. If MUSTBENEW is `excl',
4900 that means to get an error if the file already exists; never overwrite.
4901 If MUSTBENEW is neither nil nor `excl', that means ask for
4902 confirmation before overwriting, but do go ahead and overwrite the file
4903 if the user confirms.
4905 This does code conversion according to the value of
4906 `coding-system-for-write', `buffer-file-coding-system', or
4907 `file-coding-system-alist', and sets the variable
4908 `last-coding-system-used' to the coding system actually used. */)
4909 (start
, end
, filename
, append
, visit
, lockname
, mustbenew
)
4910 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, mustbenew
;
4915 const unsigned char *fn
;
4918 int count
= SPECPDL_INDEX ();
4921 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
4923 Lisp_Object handler
;
4924 Lisp_Object visit_file
;
4925 Lisp_Object annotations
;
4926 Lisp_Object encoded_filename
;
4927 int visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4928 int quietly
= !NILP (visit
);
4929 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4930 struct buffer
*given_buffer
;
4932 int buffer_file_type
= O_BINARY
;
4934 struct coding_system coding
;
4936 if (current_buffer
->base_buffer
&& visiting
)
4937 error ("Cannot do file visiting in an indirect buffer");
4939 if (!NILP (start
) && !STRINGP (start
))
4940 validate_region (&start
, &end
);
4942 GCPRO5 (start
, filename
, visit
, visit_file
, lockname
);
4944 filename
= Fexpand_file_name (filename
, Qnil
);
4946 if (!NILP (mustbenew
) && !EQ (mustbenew
, Qexcl
))
4947 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4949 if (STRINGP (visit
))
4950 visit_file
= Fexpand_file_name (visit
, Qnil
);
4952 visit_file
= filename
;
4954 if (NILP (lockname
))
4955 lockname
= visit_file
;
4959 /* If the file name has special constructs in it,
4960 call the corresponding file handler. */
4961 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4962 /* If FILENAME has no handler, see if VISIT has one. */
4963 if (NILP (handler
) && STRINGP (visit
))
4964 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4966 if (!NILP (handler
))
4969 val
= call6 (handler
, Qwrite_region
, start
, end
,
4970 filename
, append
, visit
);
4974 SAVE_MODIFF
= MODIFF
;
4975 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4976 current_buffer
->filename
= visit_file
;
4982 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
4984 /* Special kludge to simplify auto-saving. */
4987 XSETFASTINT (start
, BEG
);
4988 XSETFASTINT (end
, Z
);
4992 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4993 count1
= SPECPDL_INDEX ();
4995 given_buffer
= current_buffer
;
4997 if (!STRINGP (start
))
4999 annotations
= build_annotations (start
, end
);
5001 if (current_buffer
!= given_buffer
)
5003 XSETFASTINT (start
, BEGV
);
5004 XSETFASTINT (end
, ZV
);
5010 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
5012 /* Decide the coding-system to encode the data with.
5013 We used to make this choice before calling build_annotations, but that
5014 leads to problems when a write-annotate-function takes care of
5015 unsavable chars (as was the case with X-Symbol). */
5016 choose_write_coding_system (start
, end
, filename
,
5017 append
, visit
, lockname
, &coding
);
5018 Vlast_coding_system_used
= coding
.symbol
;
5020 given_buffer
= current_buffer
;
5021 if (! STRINGP (start
))
5023 annotations
= build_annotations_2 (start
, end
,
5024 coding
.pre_write_conversion
, annotations
);
5025 if (current_buffer
!= given_buffer
)
5027 XSETFASTINT (start
, BEGV
);
5028 XSETFASTINT (end
, ZV
);
5032 #ifdef CLASH_DETECTION
5035 #if 0 /* This causes trouble for GNUS. */
5036 /* If we've locked this file for some other buffer,
5037 query before proceeding. */
5038 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
5039 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
5042 lock_file (lockname
);
5044 #endif /* CLASH_DETECTION */
5046 encoded_filename
= ENCODE_FILE (filename
);
5048 fn
= SDATA (encoded_filename
);
5052 desc
= emacs_open (fn
, O_WRONLY
| buffer_file_type
, 0);
5053 #else /* not DOS_NT */
5054 desc
= emacs_open (fn
, O_WRONLY
, 0);
5055 #endif /* not DOS_NT */
5057 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
5059 if (auto_saving
) /* Overwrite any previous version of autosave file */
5061 vms_truncate (fn
); /* if fn exists, truncate to zero length */
5062 desc
= emacs_open (fn
, O_RDWR
, 0);
5064 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
5065 ? SDATA (current_buffer
->filename
) : 0,
5068 else /* Write to temporary name and rename if no errors */
5070 Lisp_Object temp_name
;
5071 temp_name
= Ffile_name_directory (filename
);
5073 if (!NILP (temp_name
))
5075 temp_name
= Fmake_temp_name (concat2 (temp_name
,
5076 build_string ("$$SAVE$$")));
5077 fname
= SDATA (filename
);
5078 fn
= SDATA (temp_name
);
5079 desc
= creat_copy_attrs (fname
, fn
);
5082 /* If we can't open the temporary file, try creating a new
5083 version of the original file. VMS "creat" creates a
5084 new version rather than truncating an existing file. */
5087 desc
= creat (fn
, 0666);
5088 #if 0 /* This can clobber an existing file and fail to replace it,
5089 if the user runs out of space. */
5092 /* We can't make a new version;
5093 try to truncate and rewrite existing version if any. */
5095 desc
= emacs_open (fn
, O_RDWR
, 0);
5101 desc
= creat (fn
, 0666);
5105 desc
= emacs_open (fn
,
5106 O_WRONLY
| O_CREAT
| buffer_file_type
5107 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: O_TRUNC
),
5108 S_IREAD
| S_IWRITE
);
5109 #else /* not DOS_NT */
5110 desc
= emacs_open (fn
, O_WRONLY
| O_TRUNC
| O_CREAT
5111 | (EQ (mustbenew
, Qexcl
) ? O_EXCL
: 0),
5112 auto_saving
? auto_save_mode_bits
: 0666);
5113 #endif /* not DOS_NT */
5114 #endif /* not VMS */
5118 #ifdef CLASH_DETECTION
5120 if (!auto_saving
) unlock_file (lockname
);
5122 #endif /* CLASH_DETECTION */
5124 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
5127 record_unwind_protect (close_file_unwind
, make_number (desc
));
5129 if (!NILP (append
) && !NILP (Ffile_regular_p (filename
)))
5133 if (NUMBERP (append
))
5134 ret
= lseek (desc
, XINT (append
), 1);
5136 ret
= lseek (desc
, 0, 2);
5139 #ifdef CLASH_DETECTION
5140 if (!auto_saving
) unlock_file (lockname
);
5141 #endif /* CLASH_DETECTION */
5143 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
5151 * Kludge Warning: The VMS C RTL likes to insert carriage returns
5152 * if we do writes that don't end with a carriage return. Furthermore
5153 * it cannot handle writes of more then 16K. The modified
5154 * version of "sys_write" in SYSDEP.C (see comment there) copes with
5155 * this EXCEPT for the last record (iff it doesn't end with a carriage
5156 * return). This implies that if your buffer doesn't end with a carriage
5157 * return, you get one free... tough. However it also means that if
5158 * we make two calls to sys_write (a la the following code) you can
5159 * get one at the gap as well. The easiest way to fix this (honest)
5160 * is to move the gap to the next newline (or the end of the buffer).
5165 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5166 move_gap (find_next_newline (GPT
, 1));
5168 /* Whether VMS or not, we must move the gap to the next of newline
5169 when we must put designation sequences at beginning of line. */
5170 if (INTEGERP (start
)
5171 && coding
.type
== coding_type_iso2022
5172 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
5173 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
5175 int opoint
= PT
, opoint_byte
= PT_BYTE
;
5176 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
5177 move_gap_both (PT
, PT_BYTE
);
5178 SET_PT_BOTH (opoint
, opoint_byte
);
5185 if (STRINGP (start
))
5187 failure
= 0 > a_write (desc
, start
, 0, SCHARS (start
),
5188 &annotations
, &coding
);
5191 else if (XINT (start
) != XINT (end
))
5193 tem
= CHAR_TO_BYTE (XINT (start
));
5195 if (XINT (start
) < GPT
)
5197 failure
= 0 > a_write (desc
, Qnil
, XINT (start
),
5198 min (GPT
, XINT (end
)) - XINT (start
),
5199 &annotations
, &coding
);
5203 if (XINT (end
) > GPT
&& !failure
)
5205 tem
= max (XINT (start
), GPT
);
5206 failure
= 0 > a_write (desc
, Qnil
, tem
, XINT (end
) - tem
,
5207 &annotations
, &coding
);
5213 /* If file was empty, still need to write the annotations */
5214 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5215 failure
= 0 > a_write (desc
, Qnil
, XINT (end
), 0, &annotations
, &coding
);
5219 if (CODING_REQUIRE_FLUSHING (&coding
)
5220 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
5223 /* We have to flush out a data. */
5224 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5225 failure
= 0 > e_write (desc
, Qnil
, 0, 0, &coding
);
5232 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
5233 Disk full in NFS may be reported here. */
5234 /* mib says that closing the file will try to write as fast as NFS can do
5235 it, and that means the fsync here is not crucial for autosave files. */
5236 if (!auto_saving
&& fsync (desc
) < 0)
5238 /* If fsync fails with EINTR, don't treat that as serious. */
5240 failure
= 1, save_errno
= errno
;
5244 /* Spurious "file has changed on disk" warnings have been
5245 observed on Suns as well.
5246 It seems that `close' can change the modtime, under nfs.
5248 (This has supposedly been fixed in Sunos 4,
5249 but who knows about all the other machines with NFS?) */
5252 /* On VMS and APOLLO, must do the stat after the close
5253 since closing changes the modtime. */
5256 /* Recall that #if defined does not work on VMS. */
5263 /* NFS can report a write failure now. */
5264 if (emacs_close (desc
) < 0)
5265 failure
= 1, save_errno
= errno
;
5268 /* If we wrote to a temporary name and had no errors, rename to real name. */
5272 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
5280 /* Discard the unwind protect for close_file_unwind. */
5281 specpdl_ptr
= specpdl
+ count1
;
5282 /* Restore the original current buffer. */
5283 visit_file
= unbind_to (count
, visit_file
);
5285 #ifdef CLASH_DETECTION
5287 unlock_file (lockname
);
5288 #endif /* CLASH_DETECTION */
5290 /* Do this before reporting IO error
5291 to avoid a "file has changed on disk" warning on
5292 next attempt to save. */
5294 current_buffer
->modtime
= st
.st_mtime
;
5297 error ("IO error writing %s: %s", SDATA (filename
),
5298 emacs_strerror (save_errno
));
5302 SAVE_MODIFF
= MODIFF
;
5303 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5304 current_buffer
->filename
= visit_file
;
5305 update_mode_lines
++;
5310 && ! NILP (Fstring_equal (current_buffer
->filename
,
5311 current_buffer
->auto_save_file_name
)))
5312 SAVE_MODIFF
= MODIFF
;
5318 message_with_string ((INTEGERP (append
)
5328 Lisp_Object
merge ();
5330 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
5331 doc
: /* Return t if (car A) is numerically less than (car B). */)
5335 return Flss (Fcar (a
), Fcar (b
));
5338 /* Build the complete list of annotations appropriate for writing out
5339 the text between START and END, by calling all the functions in
5340 write-region-annotate-functions and merging the lists they return.
5341 If one of these functions switches to a different buffer, we assume
5342 that buffer contains altered text. Therefore, the caller must
5343 make sure to restore the current buffer in all cases,
5344 as save-excursion would do. */
5347 build_annotations (start
, end
)
5348 Lisp_Object start
, end
;
5350 Lisp_Object annotations
;
5352 struct gcpro gcpro1
, gcpro2
;
5353 Lisp_Object original_buffer
;
5354 int i
, used_global
= 0;
5356 XSETBUFFER (original_buffer
, current_buffer
);
5359 p
= Vwrite_region_annotate_functions
;
5360 GCPRO2 (annotations
, p
);
5363 struct buffer
*given_buffer
= current_buffer
;
5364 if (EQ (Qt
, XCAR (p
)) && !used_global
)
5365 { /* Use the global value of the hook. */
5368 arg
[0] = Fdefault_value (Qwrite_region_annotate_functions
);
5370 p
= Fappend (2, arg
);
5373 Vwrite_region_annotations_so_far
= annotations
;
5374 res
= call2 (XCAR (p
), start
, end
);
5375 /* If the function makes a different buffer current,
5376 assume that means this buffer contains altered text to be output.
5377 Reset START and END from the buffer bounds
5378 and discard all previous annotations because they should have
5379 been dealt with by this function. */
5380 if (current_buffer
!= given_buffer
)
5382 XSETFASTINT (start
, BEGV
);
5383 XSETFASTINT (end
, ZV
);
5386 Flength (res
); /* Check basic validity of return value */
5387 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5391 /* Now do the same for annotation functions implied by the file-format */
5392 if (auto_saving
&& (!EQ (current_buffer
->auto_save_file_format
, Qt
)))
5393 p
= current_buffer
->auto_save_file_format
;
5395 p
= current_buffer
->file_format
;
5396 for (i
= 0; CONSP (p
); p
= XCDR (p
), ++i
)
5398 struct buffer
*given_buffer
= current_buffer
;
5400 Vwrite_region_annotations_so_far
= annotations
;
5402 /* Value is either a list of annotations or nil if the function
5403 has written annotations to a temporary buffer, which is now
5405 res
= call5 (Qformat_annotate_function
, XCAR (p
), start
, end
,
5406 original_buffer
, make_number (i
));
5407 if (current_buffer
!= given_buffer
)
5409 XSETFASTINT (start
, BEGV
);
5410 XSETFASTINT (end
, ZV
);
5415 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
5423 build_annotations_2 (start
, end
, pre_write_conversion
, annotations
)
5424 Lisp_Object start
, end
, pre_write_conversion
, annotations
;
5426 struct gcpro gcpro1
;
5429 GCPRO1 (annotations
);
5430 /* At last, do the same for the function PRE_WRITE_CONVERSION
5431 implied by the current coding-system. */
5432 if (!NILP (pre_write_conversion
))
5434 struct buffer
*given_buffer
= current_buffer
;
5435 Vwrite_region_annotations_so_far
= annotations
;
5436 res
= call2 (pre_write_conversion
, start
, end
);
5438 annotations
= (current_buffer
!= given_buffer
5440 : merge (annotations
, res
, Qcar_less_than_car
));
5447 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5448 If STRING is nil, POS is the character position in the current buffer.
5449 Intersperse with them the annotations from *ANNOT
5450 which fall within the range of POS to POS + NCHARS,
5451 each at its appropriate position.
5453 We modify *ANNOT by discarding elements as we use them up.
5455 The return value is negative in case of system call failure. */
5458 a_write (desc
, string
, pos
, nchars
, annot
, coding
)
5461 register int nchars
;
5464 struct coding_system
*coding
;
5468 int lastpos
= pos
+ nchars
;
5470 while (NILP (*annot
) || CONSP (*annot
))
5472 tem
= Fcar_safe (Fcar (*annot
));
5475 nextpos
= XFASTINT (tem
);
5477 /* If there are no more annotations in this range,
5478 output the rest of the range all at once. */
5479 if (! (nextpos
>= pos
&& nextpos
<= lastpos
))
5480 return e_write (desc
, string
, pos
, lastpos
, coding
);
5482 /* Output buffer text up to the next annotation's position. */
5485 if (0 > e_write (desc
, string
, pos
, nextpos
, coding
))
5489 /* Output the annotation. */
5490 tem
= Fcdr (Fcar (*annot
));
5493 if (0 > e_write (desc
, tem
, 0, SCHARS (tem
), coding
))
5496 *annot
= Fcdr (*annot
);
5501 #ifndef WRITE_BUF_SIZE
5502 #define WRITE_BUF_SIZE (16 * 1024)
5505 /* Write text in the range START and END into descriptor DESC,
5506 encoding them with coding system CODING. If STRING is nil, START
5507 and END are character positions of the current buffer, else they
5508 are indexes to the string STRING. */
5511 e_write (desc
, string
, start
, end
, coding
)
5515 struct coding_system
*coding
;
5517 register char *addr
;
5518 register int nbytes
;
5519 char buf
[WRITE_BUF_SIZE
];
5523 coding
->composing
= COMPOSITION_DISABLED
;
5524 if (coding
->composing
!= COMPOSITION_DISABLED
)
5525 coding_save_composition (coding
, start
, end
, string
);
5527 if (STRINGP (string
))
5529 addr
= SDATA (string
);
5530 nbytes
= SBYTES (string
);
5531 coding
->src_multibyte
= STRING_MULTIBYTE (string
);
5533 else if (start
< end
)
5535 /* It is assured that the gap is not in the range START and END-1. */
5536 addr
= CHAR_POS_ADDR (start
);
5537 nbytes
= CHAR_TO_BYTE (end
) - CHAR_TO_BYTE (start
);
5538 coding
->src_multibyte
5539 = !NILP (current_buffer
->enable_multibyte_characters
);
5545 coding
->src_multibyte
= 1;
5548 /* We used to have a code for handling selective display here. But,
5549 now it is handled within encode_coding. */
5554 result
= encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
5555 if (coding
->produced
> 0)
5557 coding
->produced
-= emacs_write (desc
, buf
, coding
->produced
);
5558 if (coding
->produced
)
5564 nbytes
-= coding
->consumed
;
5565 addr
+= coding
->consumed
;
5566 if (result
== CODING_FINISH_INSUFFICIENT_SRC
5569 /* The source text ends by an incomplete multibyte form.
5570 There's no way other than write it out as is. */
5571 nbytes
-= emacs_write (desc
, addr
, nbytes
);
5580 start
+= coding
->consumed_char
;
5581 if (coding
->cmp_data
)
5582 coding_adjust_composition_offset (coding
, start
);
5585 if (coding
->cmp_data
)
5586 coding_free_composition_data (coding
);
5591 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
5592 Sverify_visited_file_modtime
, 1, 1, 0,
5593 doc
: /* Return t if last mod time of BUF's visited file matches what BUF records.
5594 This means that the file has not been changed since it was visited or saved.
5595 See Info node `(elisp)Modification Time' for more details. */)
5601 Lisp_Object handler
;
5602 Lisp_Object filename
;
5607 if (!STRINGP (b
->filename
)) return Qt
;
5608 if (b
->modtime
== 0) return Qt
;
5610 /* If the file name has special constructs in it,
5611 call the corresponding file handler. */
5612 handler
= Ffind_file_name_handler (b
->filename
,
5613 Qverify_visited_file_modtime
);
5614 if (!NILP (handler
))
5615 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
5617 filename
= ENCODE_FILE (b
->filename
);
5619 if (stat (SDATA (filename
), &st
) < 0)
5621 /* If the file doesn't exist now and didn't exist before,
5622 we say that it isn't modified, provided the error is a tame one. */
5623 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
5628 if (st
.st_mtime
== b
->modtime
5629 /* If both are positive, accept them if they are off by one second. */
5630 || (st
.st_mtime
> 0 && b
->modtime
> 0
5631 && (st
.st_mtime
== b
->modtime
+ 1
5632 || st
.st_mtime
== b
->modtime
- 1)))
5637 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
5638 Sclear_visited_file_modtime
, 0, 0, 0,
5639 doc
: /* Clear out records of last mod time of visited file.
5640 Next attempt to save will certainly not complain of a discrepancy. */)
5643 current_buffer
->modtime
= 0;
5647 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
5648 Svisited_file_modtime
, 0, 0, 0,
5649 doc
: /* Return the current buffer's recorded visited file modification time.
5650 The value is a list of the form (HIGH LOW), like the time values
5651 that `file-attributes' returns. If the current buffer has no recorded
5652 file modification time, this function returns 0.
5653 See Info node `(elisp)Modification Time' for more details. */)
5657 tcons
= long_to_cons ((unsigned long) current_buffer
->modtime
);
5659 return list2 (XCAR (tcons
), XCDR (tcons
));
5663 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
5664 Sset_visited_file_modtime
, 0, 1, 0,
5665 doc
: /* Update buffer's recorded modification time from the visited file's time.
5666 Useful if the buffer was not read from the file normally
5667 or if the file itself has been changed for some known benign reason.
5668 An argument specifies the modification time value to use
5669 \(instead of that of the visited file), in the form of a list
5670 \(HIGH . LOW) or (HIGH LOW). */)
5672 Lisp_Object time_list
;
5674 if (!NILP (time_list
))
5675 current_buffer
->modtime
= cons_to_long (time_list
);
5678 register Lisp_Object filename
;
5680 Lisp_Object handler
;
5682 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
5684 /* If the file name has special constructs in it,
5685 call the corresponding file handler. */
5686 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
5687 if (!NILP (handler
))
5688 /* The handler can find the file name the same way we did. */
5689 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
5691 filename
= ENCODE_FILE (filename
);
5693 if (stat (SDATA (filename
), &st
) >= 0)
5694 current_buffer
->modtime
= st
.st_mtime
;
5701 auto_save_error (error
)
5704 Lisp_Object args
[3], msg
;
5706 struct gcpro gcpro1
;
5710 args
[0] = build_string ("Auto-saving %s: %s");
5711 args
[1] = current_buffer
->name
;
5712 args
[2] = Ferror_message_string (error
);
5713 msg
= Fformat (3, args
);
5715 nbytes
= SBYTES (msg
);
5717 for (i
= 0; i
< 3; ++i
)
5720 message2 (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5722 message2_nolog (SDATA (msg
), nbytes
, STRING_MULTIBYTE (msg
));
5723 Fsleep_for (make_number (1), Qnil
);
5736 auto_save_mode_bits
= 0666;
5738 /* Get visited file's mode to become the auto save file's mode. */
5739 if (! NILP (current_buffer
->filename
))
5741 if (stat (SDATA (current_buffer
->filename
), &st
) >= 0)
5742 /* But make sure we can overwrite it later! */
5743 auto_save_mode_bits
= st
.st_mode
| 0600;
5744 else if ((modes
= Ffile_modes (current_buffer
->filename
),
5746 /* Remote files don't cooperate with stat. */
5747 auto_save_mode_bits
= XINT (modes
) | 0600;
5751 Fwrite_region (Qnil
, Qnil
,
5752 current_buffer
->auto_save_file_name
,
5753 Qnil
, Qlambda
, Qnil
, Qnil
);
5757 do_auto_save_unwind (stream
) /* used as unwind-protect function */
5762 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
5763 | XFASTINT (XCDR (stream
))));
5768 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
5771 minibuffer_auto_raise
= XINT (value
);
5776 do_auto_save_make_dir (dir
)
5779 return call2 (Qmake_directory
, dir
, Qt
);
5783 do_auto_save_eh (ignore
)
5789 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
5790 doc
: /* Auto-save all buffers that need it.
5791 This is all buffers that have auto-saving enabled
5792 and are changed since last auto-saved.
5793 Auto-saving writes the buffer into a file
5794 so that your editing is not lost if the system crashes.
5795 This file is not the file you visited; that changes only when you save.
5796 Normally we run the normal hook `auto-save-hook' before saving.
5798 A non-nil NO-MESSAGE argument means do not print any message if successful.
5799 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5800 (no_message
, current_only
)
5801 Lisp_Object no_message
, current_only
;
5803 struct buffer
*old
= current_buffer
, *b
;
5804 Lisp_Object tail
, buf
;
5806 int do_handled_files
;
5809 Lisp_Object lispstream
;
5810 int count
= SPECPDL_INDEX ();
5811 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
5812 int old_message_p
= 0;
5813 struct gcpro gcpro1
, gcpro2
;
5815 if (max_specpdl_size
< specpdl_size
+ 40)
5816 max_specpdl_size
= specpdl_size
+ 40;
5821 if (NILP (no_message
))
5823 old_message_p
= push_message ();
5824 record_unwind_protect (pop_message_unwind
, Qnil
);
5827 /* Ordinarily don't quit within this function,
5828 but don't make it impossible to quit (in case we get hung in I/O). */
5832 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5833 point to non-strings reached from Vbuffer_alist. */
5835 if (!NILP (Vrun_hooks
))
5836 call1 (Vrun_hooks
, intern ("auto-save-hook"));
5838 if (STRINGP (Vauto_save_list_file_name
))
5840 Lisp_Object listfile
;
5842 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
5844 /* Don't try to create the directory when shutting down Emacs,
5845 because creating the directory might signal an error, and
5846 that would leave Emacs in a strange state. */
5847 if (!NILP (Vrun_hooks
))
5851 GCPRO2 (dir
, listfile
);
5852 dir
= Ffile_name_directory (listfile
);
5853 if (NILP (Ffile_directory_p (dir
)))
5854 internal_condition_case_1 (do_auto_save_make_dir
,
5855 dir
, Fcons (Fcons (Qfile_error
, Qnil
), Qnil
),
5860 stream
= fopen (SDATA (listfile
), "w");
5863 /* Arrange to close that file whether or not we get an error.
5864 Also reset auto_saving to 0. */
5865 lispstream
= Fcons (Qnil
, Qnil
);
5866 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
5867 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
5878 record_unwind_protect (do_auto_save_unwind
, lispstream
);
5879 record_unwind_protect (do_auto_save_unwind_1
,
5880 make_number (minibuffer_auto_raise
));
5881 minibuffer_auto_raise
= 0;
5884 /* On first pass, save all files that don't have handlers.
5885 On second pass, save all files that do have handlers.
5887 If Emacs is crashing, the handlers may tweak what is causing
5888 Emacs to crash in the first place, and it would be a shame if
5889 Emacs failed to autosave perfectly ordinary files because it
5890 couldn't handle some ange-ftp'd file. */
5892 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
5893 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCDR (tail
))
5895 buf
= XCDR (XCAR (tail
));
5898 /* Record all the buffers that have auto save mode
5899 in the special file that lists them. For each of these buffers,
5900 Record visited name (if any) and auto save name. */
5901 if (STRINGP (b
->auto_save_file_name
)
5902 && stream
!= NULL
&& do_handled_files
== 0)
5904 if (!NILP (b
->filename
))
5906 fwrite (SDATA (b
->filename
), 1,
5907 SBYTES (b
->filename
), stream
);
5909 putc ('\n', stream
);
5910 fwrite (SDATA (b
->auto_save_file_name
), 1,
5911 SBYTES (b
->auto_save_file_name
), stream
);
5912 putc ('\n', stream
);
5915 if (!NILP (current_only
)
5916 && b
!= current_buffer
)
5919 /* Don't auto-save indirect buffers.
5920 The base buffer takes care of it. */
5924 /* Check for auto save enabled
5925 and file changed since last auto save
5926 and file changed since last real save. */
5927 if (STRINGP (b
->auto_save_file_name
)
5928 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
5929 && b
->auto_save_modified
< BUF_MODIFF (b
)
5930 /* -1 means we've turned off autosaving for a while--see below. */
5931 && XINT (b
->save_length
) >= 0
5932 && (do_handled_files
5933 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
5936 EMACS_TIME before_time
, after_time
;
5938 EMACS_GET_TIME (before_time
);
5940 /* If we had a failure, don't try again for 20 minutes. */
5941 if (b
->auto_save_failure_time
>= 0
5942 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
5945 if ((XFASTINT (b
->save_length
) * 10
5946 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
5947 /* A short file is likely to change a large fraction;
5948 spare the user annoying messages. */
5949 && XFASTINT (b
->save_length
) > 5000
5950 /* These messages are frequent and annoying for `*mail*'. */
5951 && !EQ (b
->filename
, Qnil
)
5952 && NILP (no_message
))
5954 /* It has shrunk too much; turn off auto-saving here. */
5955 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
5956 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5958 minibuffer_auto_raise
= 0;
5959 /* Turn off auto-saving until there's a real save,
5960 and prevent any more warnings. */
5961 XSETINT (b
->save_length
, -1);
5962 Fsleep_for (make_number (1), Qnil
);
5965 set_buffer_internal (b
);
5966 if (!auto_saved
&& NILP (no_message
))
5967 message1 ("Auto-saving...");
5968 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
5970 b
->auto_save_modified
= BUF_MODIFF (b
);
5971 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
5972 set_buffer_internal (old
);
5974 EMACS_GET_TIME (after_time
);
5976 /* If auto-save took more than 60 seconds,
5977 assume it was an NFS failure that got a timeout. */
5978 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
5979 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
5983 /* Prevent another auto save till enough input events come in. */
5984 record_auto_save ();
5986 if (auto_saved
&& NILP (no_message
))
5990 /* If we are going to restore an old message,
5991 give time to read ours. */
5992 sit_for (1, 0, 0, 0, 0);
5996 /* If we displayed a message and then restored a state
5997 with no message, leave a "done" message on the screen. */
5998 message1 ("Auto-saving...done");
6003 /* This restores the message-stack status. */
6004 unbind_to (count
, Qnil
);
6008 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
6009 Sset_buffer_auto_saved
, 0, 0, 0,
6010 doc
: /* Mark current buffer as auto-saved with its current text.
6011 No auto-save file will be written until the buffer changes again. */)
6014 current_buffer
->auto_save_modified
= MODIFF
;
6015 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
6016 current_buffer
->auto_save_failure_time
= -1;
6020 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
6021 Sclear_buffer_auto_save_failure
, 0, 0, 0,
6022 doc
: /* Clear any record of a recent auto-save failure in the current buffer. */)
6025 current_buffer
->auto_save_failure_time
= -1;
6029 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
6031 doc
: /* Return t if buffer has been auto-saved since last read in or saved. */)
6034 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
6037 /* Reading and completing file names */
6038 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
6040 /* In the string VAL, change each $ to $$ and return the result. */
6043 double_dollars (val
)
6046 register const unsigned char *old
;
6047 register unsigned char *new;
6051 osize
= SBYTES (val
);
6053 /* Count the number of $ characters. */
6054 for (n
= osize
, count
= 0, old
= SDATA (val
); n
> 0; n
--)
6055 if (*old
++ == '$') count
++;
6059 val
= make_uninit_multibyte_string (SCHARS (val
) + count
,
6062 for (n
= osize
; n
> 0; n
--)
6076 read_file_name_cleanup (arg
)
6079 return (current_buffer
->directory
= arg
);
6082 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
6084 doc
: /* Internal subroutine for read-file-name. Do not call this. */)
6085 (string
, dir
, action
)
6086 Lisp_Object string
, dir
, action
;
6087 /* action is nil for complete, t for return list of completions,
6088 lambda for verify final value */
6090 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
6092 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
6094 CHECK_STRING (string
);
6101 /* No need to protect ACTION--we only compare it with t and nil. */
6102 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
6104 if (SCHARS (string
) == 0)
6106 if (EQ (action
, Qlambda
))
6114 orig_string
= string
;
6115 string
= Fsubstitute_in_file_name (string
);
6116 changed
= NILP (Fstring_equal (string
, orig_string
));
6117 name
= Ffile_name_nondirectory (string
);
6118 val
= Ffile_name_directory (string
);
6120 realdir
= Fexpand_file_name (val
, realdir
);
6125 specdir
= Ffile_name_directory (string
);
6126 val
= Ffile_name_completion (name
, realdir
);
6131 return double_dollars (string
);
6135 if (!NILP (specdir
))
6136 val
= concat2 (specdir
, val
);
6138 return double_dollars (val
);
6141 #endif /* not VMS */
6145 if (EQ (action
, Qt
))
6147 Lisp_Object all
= Ffile_name_all_completions (name
, realdir
);
6151 if (NILP (Vread_file_name_predicate
)
6152 || EQ (Vread_file_name_predicate
, Qfile_exists_p
))
6156 if (EQ (Vread_file_name_predicate
, Qfile_directory_p
))
6158 /* Brute-force speed up for directory checking:
6159 Discard strings which don't end in a slash. */
6160 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6162 Lisp_Object tem
= XCAR (all
);
6164 if (STRINGP (tem
) &&
6165 (len
= SCHARS (tem
), len
> 0) &&
6166 IS_DIRECTORY_SEP (SREF (tem
, len
-1)))
6167 comp
= Fcons (tem
, comp
);
6173 /* Must do it the hard (and slow) way. */
6174 GCPRO3 (all
, comp
, specdir
);
6175 count
= SPECPDL_INDEX ();
6176 record_unwind_protect (read_file_name_cleanup
, current_buffer
->directory
);
6177 current_buffer
->directory
= realdir
;
6178 for (comp
= Qnil
; CONSP (all
); all
= XCDR (all
))
6179 if (!NILP (call1 (Vread_file_name_predicate
, XCAR (all
))))
6180 comp
= Fcons (XCAR (all
), comp
);
6181 unbind_to (count
, Qnil
);
6184 return Fnreverse (comp
);
6187 /* Only other case actually used is ACTION = lambda */
6189 /* Supposedly this helps commands such as `cd' that read directory names,
6190 but can someone explain how it helps them? -- RMS */
6191 if (SCHARS (name
) == 0)
6194 string
= Fexpand_file_name (string
, dir
);
6195 if (!NILP (Vread_file_name_predicate
))
6196 return call1 (Vread_file_name_predicate
, string
);
6197 return Ffile_exists_p (string
);
6200 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p
,
6201 Snext_read_file_uses_dialog_p
, 0, 0, 0,
6202 doc
: /* Return t if a call to `read-file-name' will use a dialog.
6203 The return value is only relevant for a call to `read-file-name' that happens
6204 before any other event (mouse or keypress) is handeled. */)
6207 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6208 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
6217 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 6, 0,
6218 doc
: /* Read file name, prompting with PROMPT and completing in directory DIR.
6219 Value is not expanded---you must call `expand-file-name' yourself.
6220 Default name to DEFAULT-FILENAME if user exits the minibuffer with
6221 the same non-empty string that was inserted by this function.
6222 (If DEFAULT-FILENAME is omitted, the visited file name is used,
6223 except that if INITIAL is specified, that combined with DIR is used.)
6224 If the user exits with an empty minibuffer, this function returns
6225 an empty string. (This can only happen if the user erased the
6226 pre-inserted contents or if `insert-default-directory' is nil.)
6227 Fourth arg MUSTMATCH non-nil means require existing file's name.
6228 Non-nil and non-t means also require confirmation after completion.
6229 Fifth arg INITIAL specifies text to start with.
6230 If optional sixth arg PREDICATE is non-nil, possible completions and
6231 the resulting file name must satisfy (funcall PREDICATE NAME).
6232 DIR should be an absolute directory name. It defaults to the value of
6233 `default-directory'.
6235 If this command was invoked with the mouse, use a file dialog box if
6236 `use-dialog-box' is non-nil, and the window system or X toolkit in use
6237 provides a file dialog box.
6239 See also `read-file-name-completion-ignore-case'
6240 and `read-file-name-function'. */)
6241 (prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
)
6242 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
, predicate
;
6244 Lisp_Object val
, insdef
, tem
;
6245 struct gcpro gcpro1
, gcpro2
;
6246 register char *homedir
;
6247 Lisp_Object decoded_homedir
;
6248 int replace_in_history
= 0;
6249 int add_to_history
= 0;
6253 dir
= current_buffer
->directory
;
6254 if (NILP (Ffile_name_absolute_p (dir
)))
6255 dir
= Fexpand_file_name (dir
, Qnil
);
6256 if (NILP (default_filename
))
6259 ? Fexpand_file_name (initial
, dir
)
6260 : current_buffer
->filename
);
6262 /* If dir starts with user's homedir, change that to ~. */
6263 homedir
= (char *) egetenv ("HOME");
6265 /* homedir can be NULL in temacs, since Vprocess_environment is not
6266 yet set up. We shouldn't crash in that case. */
6269 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
6270 CORRECT_DIR_SEPS (homedir
);
6275 = DECODE_FILE (make_unibyte_string (homedir
, strlen (homedir
)));
6278 && !strncmp (SDATA (decoded_homedir
), SDATA (dir
),
6279 SBYTES (decoded_homedir
))
6280 && IS_DIRECTORY_SEP (SREF (dir
, SBYTES (decoded_homedir
))))
6282 dir
= Fsubstring (dir
, make_number (SCHARS (decoded_homedir
)), Qnil
);
6283 dir
= concat2 (build_string ("~"), dir
);
6285 /* Likewise for default_filename. */
6287 && STRINGP (default_filename
)
6288 && !strncmp (SDATA (decoded_homedir
), SDATA (default_filename
),
6289 SBYTES (decoded_homedir
))
6290 && IS_DIRECTORY_SEP (SREF (default_filename
, SBYTES (decoded_homedir
))))
6293 = Fsubstring (default_filename
,
6294 make_number (SCHARS (decoded_homedir
)), Qnil
);
6295 default_filename
= concat2 (build_string ("~"), default_filename
);
6297 if (!NILP (default_filename
))
6299 CHECK_STRING (default_filename
);
6300 default_filename
= double_dollars (default_filename
);
6303 if (insert_default_directory
&& STRINGP (dir
))
6306 if (!NILP (initial
))
6308 Lisp_Object args
[2], pos
;
6312 insdef
= Fconcat (2, args
);
6313 pos
= make_number (SCHARS (double_dollars (dir
)));
6314 insdef
= Fcons (double_dollars (insdef
), pos
);
6317 insdef
= double_dollars (insdef
);
6319 else if (STRINGP (initial
))
6320 insdef
= Fcons (double_dollars (initial
), make_number (0));
6324 if (!NILP (Vread_file_name_function
))
6326 Lisp_Object args
[7];
6328 GCPRO2 (insdef
, default_filename
);
6329 args
[0] = Vread_file_name_function
;
6332 args
[3] = default_filename
;
6333 args
[4] = mustmatch
;
6335 args
[6] = predicate
;
6336 RETURN_UNGCPRO (Ffuncall (7, args
));
6339 count
= SPECPDL_INDEX ();
6340 specbind (intern ("completion-ignore-case"),
6341 read_file_name_completion_ignore_case
? Qt
: Qnil
);
6342 specbind (intern ("minibuffer-completing-file-name"), Qt
);
6343 specbind (intern ("read-file-name-predicate"),
6344 (NILP (predicate
) ? Qfile_exists_p
: predicate
));
6346 GCPRO2 (insdef
, default_filename
);
6348 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
6349 if (! NILP (Fnext_read_file_uses_dialog_p ()))
6351 /* If DIR contains a file name, split it. */
6353 file
= Ffile_name_nondirectory (dir
);
6354 if (SCHARS (file
) && NILP (default_filename
))
6356 default_filename
= file
;
6357 dir
= Ffile_name_directory (dir
);
6359 if (!NILP(default_filename
))
6360 default_filename
= Fexpand_file_name (default_filename
, dir
);
6361 val
= Fx_file_dialog (prompt
, dir
, default_filename
, mustmatch
,
6362 EQ (predicate
, Qfile_directory_p
) ? Qt
: Qnil
);
6367 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
6368 dir
, mustmatch
, insdef
,
6369 Qfile_name_history
, default_filename
, Qnil
);
6371 tem
= Fsymbol_value (Qfile_name_history
);
6372 if (CONSP (tem
) && EQ (XCAR (tem
), val
))
6373 replace_in_history
= 1;
6375 /* If Fcompleting_read returned the inserted default string itself
6376 (rather than a new string with the same contents),
6377 it has to mean that the user typed RET with the minibuffer empty.
6378 In that case, we really want to return ""
6379 so that commands such as set-visited-file-name can distinguish. */
6380 if (EQ (val
, default_filename
))
6382 /* In this case, Fcompleting_read has not added an element
6383 to the history. Maybe we should. */
6384 if (! replace_in_history
)
6390 unbind_to (count
, Qnil
);
6393 error ("No file name specified");
6395 tem
= Fstring_equal (val
, CONSP (insdef
) ? XCAR (insdef
) : insdef
);
6397 if (!NILP (tem
) && !NILP (default_filename
))
6398 val
= default_filename
;
6399 val
= Fsubstitute_in_file_name (val
);
6401 if (replace_in_history
)
6402 /* Replace what Fcompleting_read added to the history
6403 with what we will actually return. */
6405 Lisp_Object val1
= double_dollars (val
);
6406 tem
= Fsymbol_value (Qfile_name_history
);
6407 if (history_delete_duplicates
)
6408 XSETCDR (tem
, Fdelete (val1
, XCDR(tem
)));
6409 XSETCAR (tem
, val1
);
6411 else if (add_to_history
)
6413 /* Add the value to the history--but not if it matches
6414 the last value already there. */
6415 Lisp_Object val1
= double_dollars (val
);
6416 tem
= Fsymbol_value (Qfile_name_history
);
6417 if (! CONSP (tem
) || NILP (Fequal (XCAR (tem
), val1
)))
6419 if (history_delete_duplicates
) tem
= Fdelete (val1
, tem
);
6420 Fset (Qfile_name_history
, Fcons (val1
, tem
));
6431 /* Must be set before any path manipulation is performed. */
6432 XSETFASTINT (Vdirectory_sep_char
, '/');
6439 Qexpand_file_name
= intern ("expand-file-name");
6440 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
6441 Qdirectory_file_name
= intern ("directory-file-name");
6442 Qfile_name_directory
= intern ("file-name-directory");
6443 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
6444 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
6445 Qfile_name_as_directory
= intern ("file-name-as-directory");
6446 Qcopy_file
= intern ("copy-file");
6447 Qmake_directory_internal
= intern ("make-directory-internal");
6448 Qmake_directory
= intern ("make-directory");
6449 Qdelete_directory
= intern ("delete-directory");
6450 Qdelete_file
= intern ("delete-file");
6451 Qrename_file
= intern ("rename-file");
6452 Qadd_name_to_file
= intern ("add-name-to-file");
6453 Qmake_symbolic_link
= intern ("make-symbolic-link");
6454 Qfile_exists_p
= intern ("file-exists-p");
6455 Qfile_executable_p
= intern ("file-executable-p");
6456 Qfile_readable_p
= intern ("file-readable-p");
6457 Qfile_writable_p
= intern ("file-writable-p");
6458 Qfile_symlink_p
= intern ("file-symlink-p");
6459 Qaccess_file
= intern ("access-file");
6460 Qfile_directory_p
= intern ("file-directory-p");
6461 Qfile_regular_p
= intern ("file-regular-p");
6462 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
6463 Qfile_modes
= intern ("file-modes");
6464 Qset_file_modes
= intern ("set-file-modes");
6465 Qset_file_times
= intern ("set-file-times");
6466 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
6467 Qinsert_file_contents
= intern ("insert-file-contents");
6468 Qwrite_region
= intern ("write-region");
6469 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
6470 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
6471 Qauto_save_coding
= intern ("auto-save-coding");
6473 staticpro (&Qexpand_file_name
);
6474 staticpro (&Qsubstitute_in_file_name
);
6475 staticpro (&Qdirectory_file_name
);
6476 staticpro (&Qfile_name_directory
);
6477 staticpro (&Qfile_name_nondirectory
);
6478 staticpro (&Qunhandled_file_name_directory
);
6479 staticpro (&Qfile_name_as_directory
);
6480 staticpro (&Qcopy_file
);
6481 staticpro (&Qmake_directory_internal
);
6482 staticpro (&Qmake_directory
);
6483 staticpro (&Qdelete_directory
);
6484 staticpro (&Qdelete_file
);
6485 staticpro (&Qrename_file
);
6486 staticpro (&Qadd_name_to_file
);
6487 staticpro (&Qmake_symbolic_link
);
6488 staticpro (&Qfile_exists_p
);
6489 staticpro (&Qfile_executable_p
);
6490 staticpro (&Qfile_readable_p
);
6491 staticpro (&Qfile_writable_p
);
6492 staticpro (&Qaccess_file
);
6493 staticpro (&Qfile_symlink_p
);
6494 staticpro (&Qfile_directory_p
);
6495 staticpro (&Qfile_regular_p
);
6496 staticpro (&Qfile_accessible_directory_p
);
6497 staticpro (&Qfile_modes
);
6498 staticpro (&Qset_file_modes
);
6499 staticpro (&Qset_file_times
);
6500 staticpro (&Qfile_newer_than_file_p
);
6501 staticpro (&Qinsert_file_contents
);
6502 staticpro (&Qwrite_region
);
6503 staticpro (&Qverify_visited_file_modtime
);
6504 staticpro (&Qset_visited_file_modtime
);
6505 staticpro (&Qauto_save_coding
);
6507 Qfile_name_history
= intern ("file-name-history");
6508 Fset (Qfile_name_history
, Qnil
);
6509 staticpro (&Qfile_name_history
);
6511 Qfile_error
= intern ("file-error");
6512 staticpro (&Qfile_error
);
6513 Qfile_already_exists
= intern ("file-already-exists");
6514 staticpro (&Qfile_already_exists
);
6515 Qfile_date_error
= intern ("file-date-error");
6516 staticpro (&Qfile_date_error
);
6517 Qexcl
= intern ("excl");
6521 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
6522 staticpro (&Qfind_buffer_file_type
);
6525 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
6526 doc
: /* *Coding system for encoding file names.
6527 If it is nil, `default-file-name-coding-system' (which see) is used. */);
6528 Vfile_name_coding_system
= Qnil
;
6530 DEFVAR_LISP ("default-file-name-coding-system",
6531 &Vdefault_file_name_coding_system
,
6532 doc
: /* Default coding system for encoding file names.
6533 This variable is used only when `file-name-coding-system' is nil.
6535 This variable is set/changed by the command `set-language-environment'.
6536 User should not set this variable manually,
6537 instead use `file-name-coding-system' to get a constant encoding
6538 of file names regardless of the current language environment. */);
6539 Vdefault_file_name_coding_system
= Qnil
;
6541 Qformat_decode
= intern ("format-decode");
6542 staticpro (&Qformat_decode
);
6543 Qformat_annotate_function
= intern ("format-annotate-function");
6544 staticpro (&Qformat_annotate_function
);
6545 Qafter_insert_file_set_coding
= intern ("after-insert-file-set-coding");
6546 staticpro (&Qafter_insert_file_set_coding
);
6548 Qcar_less_than_car
= intern ("car-less-than-car");
6549 staticpro (&Qcar_less_than_car
);
6551 Fput (Qfile_error
, Qerror_conditions
,
6552 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
6553 Fput (Qfile_error
, Qerror_message
,
6554 build_string ("File error"));
6556 Fput (Qfile_already_exists
, Qerror_conditions
,
6557 Fcons (Qfile_already_exists
,
6558 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6559 Fput (Qfile_already_exists
, Qerror_message
,
6560 build_string ("File already exists"));
6562 Fput (Qfile_date_error
, Qerror_conditions
,
6563 Fcons (Qfile_date_error
,
6564 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
6565 Fput (Qfile_date_error
, Qerror_message
,
6566 build_string ("Cannot set file date"));
6568 DEFVAR_LISP ("read-file-name-function", &Vread_file_name_function
,
6569 doc
: /* If this is non-nil, `read-file-name' does its work by calling this function. */);
6570 Vread_file_name_function
= Qnil
;
6572 DEFVAR_LISP ("read-file-name-predicate", &Vread_file_name_predicate
,
6573 doc
: /* Current predicate used by `read-file-name-internal'. */);
6574 Vread_file_name_predicate
= Qnil
;
6576 DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case
,
6577 doc
: /* *Non-nil means when reading a file name completion ignores case. */);
6578 #if defined VMS || defined DOS_NT || defined MAC_OS
6579 read_file_name_completion_ignore_case
= 1;
6581 read_file_name_completion_ignore_case
= 0;
6584 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
6585 doc
: /* *Non-nil means when reading a filename start with default dir in minibuffer.
6586 If the initial minibuffer contents are non-empty, you can usually
6587 request a default filename by typing RETURN without editing. For some
6588 commands, exiting with an empty minibuffer has a special meaning,
6589 such as making the current buffer visit no file in the case of
6590 `set-visited-file-name'.
6591 If this variable is non-nil, the minibuffer contents are always
6592 initially non-empty and typing RETURN without editing will fetch the
6593 default name, if one is provided. Note however that this default name
6594 is not necessarily the name originally inserted in the minibuffer, if
6595 that is just the default directory.
6596 If this variable is nil, the minibuffer often starts out empty. In
6597 that case you may have to explicitly fetch the next history element to
6598 request the default name. */);
6599 insert_default_directory
= 1;
6601 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
6602 doc
: /* *Non-nil means write new files with record format `stmlf'.
6603 nil means use format `var'. This variable is meaningful only on VMS. */);
6604 vms_stmlf_recfm
= 0;
6606 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
6607 doc
: /* Directory separator character for built-in functions that return file names.
6608 The value is always ?/. Don't use this variable, just use `/'. */);
6610 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
6611 doc
: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
6612 If a file name matches REGEXP, then all I/O on that file is done by calling
6615 The first argument given to HANDLER is the name of the I/O primitive
6616 to be handled; the remaining arguments are the arguments that were
6617 passed to that primitive. For example, if you do
6618 (file-exists-p FILENAME)
6619 and FILENAME is handled by HANDLER, then HANDLER is called like this:
6620 (funcall HANDLER 'file-exists-p FILENAME)
6621 The function `find-file-name-handler' checks this list for a handler
6622 for its argument. */);
6623 Vfile_name_handler_alist
= Qnil
;
6625 DEFVAR_LISP ("set-auto-coding-function",
6626 &Vset_auto_coding_function
,
6627 doc
: /* If non-nil, a function to call to decide a coding system of file.
6628 Two arguments are passed to this function: the file name
6629 and the length of a file contents following the point.
6630 This function should return a coding system to decode the file contents.
6631 It should check the file name against `auto-coding-alist'.
6632 If no coding system is decided, it should check a coding system
6633 specified in the heading lines with the format:
6634 -*- ... coding: CODING-SYSTEM; ... -*-
6635 or local variable spec of the tailing lines with `coding:' tag. */);
6636 Vset_auto_coding_function
= Qnil
;
6638 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
6639 doc
: /* A list of functions to be called at the end of `insert-file-contents'.
6640 Each is passed one argument, the number of characters inserted.
6641 It should return the new character count, and leave point the same.
6642 If `insert-file-contents' is intercepted by a handler from
6643 `file-name-handler-alist', that handler is responsible for calling the
6644 functions in `after-insert-file-functions' if appropriate. */);
6645 Vafter_insert_file_functions
= Qnil
;
6647 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
6648 doc
: /* A list of functions to be called at the start of `write-region'.
6649 Each is passed two arguments, START and END as for `write-region'.
6650 These are usually two numbers but not always; see the documentation
6651 for `write-region'. The function should return a list of pairs
6652 of the form (POSITION . STRING), consisting of strings to be effectively
6653 inserted at the specified positions of the file being written (1 means to
6654 insert before the first byte written). The POSITIONs must be sorted into
6655 increasing order. If there are several functions in the list, the several
6656 lists are merged destructively. Alternatively, the function can return
6657 with a different buffer current; in that case it should pay attention
6658 to the annotations returned by previous functions and listed in
6659 `write-region-annotations-so-far'.*/);
6660 Vwrite_region_annotate_functions
= Qnil
;
6661 staticpro (&Qwrite_region_annotate_functions
);
6662 Qwrite_region_annotate_functions
6663 = intern ("write-region-annotate-functions");
6665 DEFVAR_LISP ("write-region-annotations-so-far",
6666 &Vwrite_region_annotations_so_far
,
6667 doc
: /* When an annotation function is called, this holds the previous annotations.
6668 These are the annotations made by other annotation functions
6669 that were already called. See also `write-region-annotate-functions'. */);
6670 Vwrite_region_annotations_so_far
= Qnil
;
6672 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
6673 doc
: /* A list of file name handlers that temporarily should not be used.
6674 This applies only to the operation `inhibit-file-name-operation'. */);
6675 Vinhibit_file_name_handlers
= Qnil
;
6677 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
6678 doc
: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6679 Vinhibit_file_name_operation
= Qnil
;
6681 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
6682 doc
: /* File name in which we write a list of all auto save file names.
6683 This variable is initialized automatically from `auto-save-list-file-prefix'
6684 shortly after Emacs reads your `.emacs' file, if you have not yet given it
6685 a non-nil value. */);
6686 Vauto_save_list_file_name
= Qnil
;
6688 defsubr (&Sfind_file_name_handler
);
6689 defsubr (&Sfile_name_directory
);
6690 defsubr (&Sfile_name_nondirectory
);
6691 defsubr (&Sunhandled_file_name_directory
);
6692 defsubr (&Sfile_name_as_directory
);
6693 defsubr (&Sdirectory_file_name
);
6694 defsubr (&Smake_temp_name
);
6695 defsubr (&Sexpand_file_name
);
6696 defsubr (&Ssubstitute_in_file_name
);
6697 defsubr (&Scopy_file
);
6698 defsubr (&Smake_directory_internal
);
6699 defsubr (&Sdelete_directory
);
6700 defsubr (&Sdelete_file
);
6701 defsubr (&Srename_file
);
6702 defsubr (&Sadd_name_to_file
);
6704 defsubr (&Smake_symbolic_link
);
6705 #endif /* S_IFLNK */
6707 defsubr (&Sdefine_logical_name
);
6710 defsubr (&Ssysnetunam
);
6711 #endif /* HPUX_NET */
6712 defsubr (&Sfile_name_absolute_p
);
6713 defsubr (&Sfile_exists_p
);
6714 defsubr (&Sfile_executable_p
);
6715 defsubr (&Sfile_readable_p
);
6716 defsubr (&Sfile_writable_p
);
6717 defsubr (&Saccess_file
);
6718 defsubr (&Sfile_symlink_p
);
6719 defsubr (&Sfile_directory_p
);
6720 defsubr (&Sfile_accessible_directory_p
);
6721 defsubr (&Sfile_regular_p
);
6722 defsubr (&Sfile_modes
);
6723 defsubr (&Sset_file_modes
);
6724 defsubr (&Sset_file_times
);
6725 defsubr (&Sset_default_file_modes
);
6726 defsubr (&Sdefault_file_modes
);
6727 defsubr (&Sfile_newer_than_file_p
);
6728 defsubr (&Sinsert_file_contents
);
6729 defsubr (&Swrite_region
);
6730 defsubr (&Scar_less_than_car
);
6731 defsubr (&Sverify_visited_file_modtime
);
6732 defsubr (&Sclear_visited_file_modtime
);
6733 defsubr (&Svisited_file_modtime
);
6734 defsubr (&Sset_visited_file_modtime
);
6735 defsubr (&Sdo_auto_save
);
6736 defsubr (&Sset_buffer_auto_saved
);
6737 defsubr (&Sclear_buffer_auto_save_failure
);
6738 defsubr (&Srecent_auto_save_p
);
6740 defsubr (&Sread_file_name_internal
);
6741 defsubr (&Sread_file_name
);
6742 defsubr (&Snext_read_file_uses_dialog_p
);
6745 defsubr (&Sunix_sync
);
6749 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
6750 (do not change this comment) */