]> code.delx.au - gnu-emacs/blob - src/fileio.c
Use offsetof instead of own definition
[gnu-emacs] / src / fileio.c
1 /* File IO for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996,
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
5
6 This file is part of GNU Emacs.
7
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
12
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
17
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20
21 #include <config.h>
22 #include <limits.h>
23
24 #ifdef HAVE_FCNTL_H
25 #include <fcntl.h>
26 #endif
27
28 #include <stdio.h>
29 #include <sys/types.h>
30 #include <sys/stat.h>
31 #include <setjmp.h>
32
33 #ifdef HAVE_UNISTD_H
34 #include <unistd.h>
35 #endif
36
37 #if !defined (S_ISLNK) && defined (S_IFLNK)
38 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
39 #endif
40
41 #if !defined (S_ISFIFO) && defined (S_IFIFO)
42 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
43 #endif
44
45 #if !defined (S_ISREG) && defined (S_IFREG)
46 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
47 #endif
48
49 #ifdef HAVE_PWD_H
50 #include <pwd.h>
51 #endif
52
53 #include <ctype.h>
54 #include <errno.h>
55
56 #ifdef HAVE_LIBSELINUX
57 #include <selinux/selinux.h>
58 #include <selinux/context.h>
59 #endif
60
61 #include "lisp.h"
62 #include "intervals.h"
63 #include "buffer.h"
64 #include "character.h"
65 #include "coding.h"
66 #include "window.h"
67 #include "blockinput.h"
68 #include "frame.h"
69 #include "dispextern.h"
70
71 #ifdef WINDOWSNT
72 #define NOMINMAX 1
73 #include <windows.h>
74 #include <stdlib.h>
75 #include <fcntl.h>
76 #endif /* not WINDOWSNT */
77
78 #ifdef MSDOS
79 #include "msdos.h"
80 #include <sys/param.h>
81 #include <fcntl.h>
82 #include <string.h>
83 #endif
84
85 #ifdef DOS_NT
86 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
87 redirector allows the six letters between 'Z' and 'a' as well. */
88 #ifdef MSDOS
89 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
90 #endif
91 #ifdef WINDOWSNT
92 #define IS_DRIVE(x) isalpha (x)
93 #endif
94 /* Need to lower-case the drive letter, or else expanded
95 filenames will sometimes compare inequal, because
96 `expand-file-name' doesn't always down-case the drive letter. */
97 #define DRIVE_LETTER(x) (tolower (x))
98 #endif
99
100 #include "systime.h"
101
102 #ifdef HPUX
103 #include <netio.h>
104 #endif
105
106 #include "commands.h"
107 extern int use_dialog_box;
108 extern int use_file_dialog;
109
110 #ifndef O_WRONLY
111 #define O_WRONLY 1
112 #endif
113
114 #ifndef O_RDONLY
115 #define O_RDONLY 0
116 #endif
117
118 #ifndef S_ISLNK
119 # define lstat stat
120 #endif
121
122 #ifndef FILE_SYSTEM_CASE
123 #define FILE_SYSTEM_CASE(filename) (filename)
124 #endif
125
126 /* Nonzero during writing of auto-save files */
127 int auto_saving;
128
129 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
130 a new file with the same mode as the original */
131 int auto_save_mode_bits;
132
133 /* Set by auto_save_1 if an error occurred during the last auto-save. */
134 int auto_save_error_occurred;
135
136 /* The symbol bound to coding-system-for-read when
137 insert-file-contents is called for recovering a file. This is not
138 an actual coding system name, but just an indicator to tell
139 insert-file-contents to use `emacs-mule' with a special flag for
140 auto saving and recovering a file. */
141 Lisp_Object Qauto_save_coding;
142
143 /* Coding system for file names, or nil if none. */
144 Lisp_Object Vfile_name_coding_system;
145
146 /* Coding system for file names used only when
147 Vfile_name_coding_system is nil. */
148 Lisp_Object Vdefault_file_name_coding_system;
149
150 /* Alist of elements (REGEXP . HANDLER) for file names
151 whose I/O is done with a special handler. */
152 Lisp_Object Vfile_name_handler_alist;
153
154 /* Property name of a file name handler,
155 which gives a list of operations it handles.. */
156 Lisp_Object Qoperations;
157
158 /* Lisp functions for translating file formats */
159 Lisp_Object Qformat_decode, Qformat_annotate_function;
160
161 /* Function to be called to decide a coding system of a reading file. */
162 Lisp_Object Vset_auto_coding_function;
163
164 /* Functions to be called to process text properties in inserted file. */
165 Lisp_Object Vafter_insert_file_functions;
166
167 /* Lisp function for setting buffer-file-coding-system and the
168 multibyteness of the current buffer after inserting a file. */
169 Lisp_Object Qafter_insert_file_set_coding;
170
171 /* Functions to be called to create text property annotations for file. */
172 Lisp_Object Vwrite_region_annotate_functions;
173 Lisp_Object Qwrite_region_annotate_functions;
174 Lisp_Object Vwrite_region_post_annotation_function;
175
176 /* During build_annotations, each time an annotation function is called,
177 this holds the annotations made by the previous functions. */
178 Lisp_Object Vwrite_region_annotations_so_far;
179
180 /* Each time an annotation function changes the buffer, the new buffer
181 is added here. */
182 Lisp_Object Vwrite_region_annotation_buffers;
183
184 /* File name in which we write a list of all our auto save files. */
185 Lisp_Object Vauto_save_list_file_name;
186
187 /* Whether or not files are auto-saved into themselves. */
188 Lisp_Object Vauto_save_visited_file_name;
189
190 /* Whether or not to continue auto-saving after a large deletion. */
191 Lisp_Object Vauto_save_include_big_deletions;
192
193 /* On NT, specifies the directory separator character, used (eg.) when
194 expanding file names. This can be bound to / or \. */
195 Lisp_Object Vdirectory_sep_char;
196
197 #ifdef HAVE_FSYNC
198 /* Nonzero means skip the call to fsync in Fwrite-region. */
199 int write_region_inhibit_fsync;
200 #endif
201
202 /* Non-zero means call move-file-to-trash in Fdelete_file or
203 Fdelete_directory_internal. */
204 int delete_by_moving_to_trash;
205
206 Lisp_Object Qdelete_by_moving_to_trash;
207
208 /* Lisp function for moving files to trash. */
209 Lisp_Object Qmove_file_to_trash;
210
211 /* Lisp function for recursively copying directories. */
212 Lisp_Object Qcopy_directory;
213
214 /* Lisp function for recursively deleting directories. */
215 Lisp_Object Qdelete_directory;
216
217 extern Lisp_Object Vuser_login_name;
218
219 #ifdef WINDOWSNT
220 extern Lisp_Object Vw32_get_true_file_attributes;
221 #endif
222
223 extern int minibuf_level;
224
225 extern int minibuffer_auto_raise;
226
227 /* These variables describe handlers that have "already" had a chance
228 to handle the current operation.
229
230 Vinhibit_file_name_handlers is a list of file name handlers.
231 Vinhibit_file_name_operation is the operation being handled.
232 If we try to handle that operation, we ignore those handlers. */
233
234 static Lisp_Object Vinhibit_file_name_handlers;
235 static Lisp_Object Vinhibit_file_name_operation;
236
237 Lisp_Object Qfile_error, Qfile_already_exists, Qfile_date_error;
238 Lisp_Object Qexcl;
239 Lisp_Object Qfile_name_history;
240
241 Lisp_Object Qcar_less_than_car;
242
243 static int a_write (int, Lisp_Object, int, int,
244 Lisp_Object *, struct coding_system *);
245 static int e_write (int, Lisp_Object, int, int, struct coding_system *);
246
247 \f
248 void
249 report_file_error (const char *string, Lisp_Object data)
250 {
251 Lisp_Object errstring;
252 int errorno = errno;
253 char *str;
254
255 synchronize_system_messages_locale ();
256 str = strerror (errorno);
257 errstring = code_convert_string_norecord (make_unibyte_string (str,
258 strlen (str)),
259 Vlocale_coding_system, 0);
260
261 while (1)
262 switch (errorno)
263 {
264 case EEXIST:
265 xsignal (Qfile_already_exists, Fcons (errstring, data));
266 break;
267 default:
268 /* System error messages are capitalized. Downcase the initial
269 unless it is followed by a slash. (The slash case caters to
270 error messages that begin with "I/O" or, in German, "E/A".) */
271 if (STRING_MULTIBYTE (errstring)
272 && ! EQ (Faref (errstring, make_number (1)), make_number ('/')))
273 {
274 int c;
275
276 str = (char *) SDATA (errstring);
277 c = STRING_CHAR (str);
278 Faset (errstring, make_number (0), make_number (DOWNCASE (c)));
279 }
280
281 xsignal (Qfile_error,
282 Fcons (build_string (string), Fcons (errstring, data)));
283 }
284 }
285
286 Lisp_Object
287 close_file_unwind (Lisp_Object fd)
288 {
289 emacs_close (XFASTINT (fd));
290 return Qnil;
291 }
292
293 /* Restore point, having saved it as a marker. */
294
295 Lisp_Object
296 restore_point_unwind (Lisp_Object location)
297 {
298 Fgoto_char (location);
299 Fset_marker (location, Qnil, Qnil);
300 return Qnil;
301 }
302
303 \f
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_internal;
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_selinux_context;
332 Lisp_Object Qset_file_selinux_context;
333 Lisp_Object Qfile_newer_than_file_p;
334 Lisp_Object Qinsert_file_contents;
335 Lisp_Object Qwrite_region;
336 Lisp_Object Qverify_visited_file_modtime;
337 Lisp_Object Qset_visited_file_modtime;
338
339 DEFUN ("find-file-name-handler", Ffind_file_name_handler, Sfind_file_name_handler, 2, 2, 0,
340 doc: /* Return FILENAME's handler function for OPERATION, if it has one.
341 Otherwise, return nil.
342 A file name is handled if one of the regular expressions in
343 `file-name-handler-alist' matches it.
344
345 If OPERATION equals `inhibit-file-name-operation', then we ignore
346 any handlers that are members of `inhibit-file-name-handlers',
347 but we still do run any other handlers. This lets handlers
348 use the standard functions without calling themselves recursively. */)
349 (Lisp_Object filename, Lisp_Object operation)
350 {
351 /* This function must not munge the match data. */
352 Lisp_Object chain, inhibited_handlers, result;
353 int pos = -1;
354
355 result = Qnil;
356 CHECK_STRING (filename);
357
358 if (EQ (operation, Vinhibit_file_name_operation))
359 inhibited_handlers = Vinhibit_file_name_handlers;
360 else
361 inhibited_handlers = Qnil;
362
363 for (chain = Vfile_name_handler_alist; CONSP (chain);
364 chain = XCDR (chain))
365 {
366 Lisp_Object elt;
367 elt = XCAR (chain);
368 if (CONSP (elt))
369 {
370 Lisp_Object string = XCAR (elt);
371 int match_pos;
372 Lisp_Object handler = XCDR (elt);
373 Lisp_Object operations = Qnil;
374
375 if (SYMBOLP (handler))
376 operations = Fget (handler, Qoperations);
377
378 if (STRINGP (string)
379 && (match_pos = fast_string_match (string, filename)) > pos
380 && (NILP (operations) || ! NILP (Fmemq (operation, operations))))
381 {
382 Lisp_Object tem;
383
384 handler = XCDR (elt);
385 tem = Fmemq (handler, inhibited_handlers);
386 if (NILP (tem))
387 {
388 result = handler;
389 pos = match_pos;
390 }
391 }
392 }
393
394 QUIT;
395 }
396 return result;
397 }
398 \f
399 DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory,
400 1, 1, 0,
401 doc: /* Return the directory component in file name FILENAME.
402 Return nil if FILENAME does not include a directory.
403 Otherwise return a directory name.
404 Given a Unix syntax file name, returns a string ending in slash. */)
405 (Lisp_Object filename)
406 {
407 #ifndef DOS_NT
408 register const unsigned char *beg;
409 #else
410 register unsigned char *beg;
411 #endif
412 register const unsigned char *p;
413 Lisp_Object handler;
414
415 CHECK_STRING (filename);
416
417 /* If the file name has special constructs in it,
418 call the corresponding file handler. */
419 handler = Ffind_file_name_handler (filename, Qfile_name_directory);
420 if (!NILP (handler))
421 return call2 (handler, Qfile_name_directory, filename);
422
423 filename = FILE_SYSTEM_CASE (filename);
424 #ifdef DOS_NT
425 beg = (unsigned char *) alloca (SBYTES (filename) + 1);
426 memcpy (beg, SDATA (filename), SBYTES (filename) + 1);
427 #else
428 beg = SDATA (filename);
429 #endif
430 p = beg + SBYTES (filename);
431
432 while (p != beg && !IS_DIRECTORY_SEP (p[-1])
433 #ifdef DOS_NT
434 /* only recognise drive specifier at the beginning */
435 && !(p[-1] == ':'
436 /* handle the "/:d:foo" and "/:foo" cases correctly */
437 && ((p == beg + 2 && !IS_DIRECTORY_SEP (*beg))
438 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
439 #endif
440 ) p--;
441
442 if (p == beg)
443 return Qnil;
444 #ifdef DOS_NT
445 /* Expansion of "c:" to drive and default directory. */
446 if (p[-1] == ':')
447 {
448 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
449 unsigned char *res = alloca (MAXPATHLEN + 1);
450 unsigned char *r = res;
451
452 if (p == beg + 4 && IS_DIRECTORY_SEP (*beg) && beg[1] == ':')
453 {
454 strncpy (res, beg, 2);
455 beg += 2;
456 r += 2;
457 }
458
459 if (getdefdir (toupper (*beg) - 'A' + 1, r))
460 {
461 if (!IS_DIRECTORY_SEP (res[strlen (res) - 1]))
462 strcat (res, "/");
463 beg = res;
464 p = beg + strlen (beg);
465 }
466 }
467 dostounix_filename (beg);
468 #endif /* DOS_NT */
469
470 return make_specified_string (beg, -1, p - beg, STRING_MULTIBYTE (filename));
471 }
472
473 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory,
474 Sfile_name_nondirectory, 1, 1, 0,
475 doc: /* Return file name FILENAME sans its directory.
476 For example, in a Unix-syntax file name,
477 this is everything after the last slash,
478 or the entire name if it contains no slash. */)
479 (Lisp_Object filename)
480 {
481 register const unsigned char *beg, *p, *end;
482 Lisp_Object handler;
483
484 CHECK_STRING (filename);
485
486 /* If the file name has special constructs in it,
487 call the corresponding file handler. */
488 handler = Ffind_file_name_handler (filename, Qfile_name_nondirectory);
489 if (!NILP (handler))
490 return call2 (handler, Qfile_name_nondirectory, filename);
491
492 beg = SDATA (filename);
493 end = p = beg + SBYTES (filename);
494
495 while (p != beg && !IS_DIRECTORY_SEP (p[-1])
496 #ifdef DOS_NT
497 /* only recognise drive specifier at beginning */
498 && !(p[-1] == ':'
499 /* handle the "/:d:foo" case correctly */
500 && (p == beg + 2 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
501 #endif
502 )
503 p--;
504
505 return make_specified_string (p, -1, end - p, STRING_MULTIBYTE (filename));
506 }
507
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 If FILENAME refers to a file which is not accessible from a local process,
516 then this should return nil.
517 The `call-process' and `start-process' functions use this function to
518 get a current directory to run processes in. */)
519 (Lisp_Object filename)
520 {
521 Lisp_Object handler;
522
523 /* If the file name has special constructs in it,
524 call the corresponding file handler. */
525 handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory);
526 if (!NILP (handler))
527 return call2 (handler, Qunhandled_file_name_directory, filename);
528
529 return Ffile_name_directory (filename);
530 }
531
532 \f
533 char *
534 file_name_as_directory (char *out, char *in)
535 {
536 int size = strlen (in) - 1;
537
538 strcpy (out, in);
539
540 if (size < 0)
541 {
542 out[0] = '.';
543 out[1] = '/';
544 out[2] = 0;
545 return out;
546 }
547
548 /* For Unix syntax, Append a slash if necessary */
549 if (!IS_DIRECTORY_SEP (out[size]))
550 {
551 out[size + 1] = DIRECTORY_SEP;
552 out[size + 2] = '\0';
553 }
554 #ifdef DOS_NT
555 dostounix_filename (out);
556 #endif
557 return out;
558 }
559
560 DEFUN ("file-name-as-directory", Ffile_name_as_directory,
561 Sfile_name_as_directory, 1, 1, 0,
562 doc: /* Return a string representing the file name FILE interpreted as a directory.
563 This operation exists because a directory is also a file, but its name as
564 a directory is different from its name as a file.
565 The result can be used as the value of `default-directory'
566 or passed as second argument to `expand-file-name'.
567 For a Unix-syntax file name, just appends a slash. */)
568 (Lisp_Object file)
569 {
570 char *buf;
571 Lisp_Object handler;
572
573 CHECK_STRING (file);
574 if (NILP (file))
575 return Qnil;
576
577 /* If the file name has special constructs in it,
578 call the corresponding file handler. */
579 handler = Ffind_file_name_handler (file, Qfile_name_as_directory);
580 if (!NILP (handler))
581 return call2 (handler, Qfile_name_as_directory, file);
582
583 buf = (char *) alloca (SBYTES (file) + 10);
584 file_name_as_directory (buf, SDATA (file));
585 return make_specified_string (buf, -1, strlen (buf),
586 STRING_MULTIBYTE (file));
587 }
588 \f
589 /*
590 * Convert from directory name to filename.
591 * On UNIX, it's simple: just make sure there isn't a terminating /
592
593 * Value is nonzero if the string output is different from the input.
594 */
595
596 int
597 directory_file_name (char *src, char *dst)
598 {
599 long slen;
600
601 slen = strlen (src);
602
603 /* Process as Unix format: just remove any final slash.
604 But leave "/" unchanged; do not change it to "". */
605 strcpy (dst, src);
606 if (slen > 1
607 && IS_DIRECTORY_SEP (dst[slen - 1])
608 #ifdef DOS_NT
609 && !IS_ANY_SEP (dst[slen - 2])
610 #endif
611 )
612 dst[slen - 1] = 0;
613 #ifdef DOS_NT
614 dostounix_filename (dst);
615 #endif
616 return 1;
617 }
618
619 DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name,
620 1, 1, 0,
621 doc: /* Returns the file name of the directory named DIRECTORY.
622 This is the name of the file that holds the data for the directory 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 In Unix-syntax, this function just removes the final slash. */)
626 (Lisp_Object directory)
627 {
628 char *buf;
629 Lisp_Object handler;
630
631 CHECK_STRING (directory);
632
633 if (NILP (directory))
634 return Qnil;
635
636 /* If the file name has special constructs in it,
637 call the corresponding file handler. */
638 handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
639 if (!NILP (handler))
640 return call2 (handler, Qdirectory_file_name, directory);
641
642 buf = (char *) alloca (SBYTES (directory) + 20);
643 directory_file_name (SDATA (directory), buf);
644 return make_specified_string (buf, -1, strlen (buf),
645 STRING_MULTIBYTE (directory));
646 }
647
648 static const char make_temp_name_tbl[64] =
649 {
650 'A','B','C','D','E','F','G','H',
651 'I','J','K','L','M','N','O','P',
652 'Q','R','S','T','U','V','W','X',
653 'Y','Z','a','b','c','d','e','f',
654 'g','h','i','j','k','l','m','n',
655 'o','p','q','r','s','t','u','v',
656 'w','x','y','z','0','1','2','3',
657 '4','5','6','7','8','9','-','_'
658 };
659
660 static unsigned make_temp_name_count, make_temp_name_count_initialized_p;
661
662 /* Value is a temporary file name starting with PREFIX, a string.
663
664 The Emacs process number forms part of the result, so there is
665 no danger of generating a name being used by another process.
666 In addition, this function makes an attempt to choose a name
667 which has no existing file. To make this work, PREFIX should be
668 an absolute file name.
669
670 BASE64_P non-zero means add the pid as 3 characters in base64
671 encoding. In this case, 6 characters will be added to PREFIX to
672 form the file name. Otherwise, if Emacs is running on a system
673 with long file names, add the pid as a decimal number.
674
675 This function signals an error if no unique file name could be
676 generated. */
677
678 Lisp_Object
679 make_temp_name (Lisp_Object prefix, int base64_p)
680 {
681 Lisp_Object val;
682 int len, clen;
683 int pid;
684 unsigned char *p, *data;
685 char pidbuf[20];
686 int pidlen;
687
688 CHECK_STRING (prefix);
689
690 /* VAL is created by adding 6 characters to PREFIX. The first
691 three are the PID of this process, in base 64, and the second
692 three are incremented if the file already exists. This ensures
693 262144 unique file names per PID per PREFIX. */
694
695 pid = (int) getpid ();
696
697 if (base64_p)
698 {
699 pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6;
700 pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6;
701 pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6;
702 pidlen = 3;
703 }
704 else
705 {
706 #ifdef HAVE_LONG_FILE_NAMES
707 sprintf (pidbuf, "%d", pid);
708 pidlen = strlen (pidbuf);
709 #else
710 pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6;
711 pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6;
712 pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6;
713 pidlen = 3;
714 #endif
715 }
716
717 len = SBYTES (prefix); clen = SCHARS (prefix);
718 val = make_uninit_multibyte_string (clen + 3 + pidlen, len + 3 + pidlen);
719 if (!STRING_MULTIBYTE (prefix))
720 STRING_SET_UNIBYTE (val);
721 data = SDATA (val);
722 memcpy (data, SDATA (prefix), len);
723 p = data + len;
724
725 memcpy (p, pidbuf, pidlen);
726 p += pidlen;
727
728 /* Here we try to minimize useless stat'ing when this function is
729 invoked many times successively with the same PREFIX. We achieve
730 this by initializing count to a random value, and incrementing it
731 afterwards.
732
733 We don't want make-temp-name to be called while dumping,
734 because then make_temp_name_count_initialized_p would get set
735 and then make_temp_name_count would not be set when Emacs starts. */
736
737 if (!make_temp_name_count_initialized_p)
738 {
739 make_temp_name_count = (unsigned) time (NULL);
740 make_temp_name_count_initialized_p = 1;
741 }
742
743 while (1)
744 {
745 struct stat ignored;
746 unsigned num = make_temp_name_count;
747
748 p[0] = make_temp_name_tbl[num & 63], num >>= 6;
749 p[1] = make_temp_name_tbl[num & 63], num >>= 6;
750 p[2] = make_temp_name_tbl[num & 63], num >>= 6;
751
752 /* Poor man's congruential RN generator. Replace with
753 ++make_temp_name_count for debugging. */
754 make_temp_name_count += 25229;
755 make_temp_name_count %= 225307;
756
757 if (stat (data, &ignored) < 0)
758 {
759 /* We want to return only if errno is ENOENT. */
760 if (errno == ENOENT)
761 return val;
762 else
763 /* The error here is dubious, but there is little else we
764 can do. The alternatives are to return nil, which is
765 as bad as (and in many cases worse than) throwing the
766 error, or to ignore the error, which will likely result
767 in looping through 225307 stat's, which is not only
768 dog-slow, but also useless since it will fallback to
769 the errow below, anyway. */
770 report_file_error ("Cannot create temporary name for prefix",
771 Fcons (prefix, Qnil));
772 /* not reached */
773 }
774 }
775
776 error ("Cannot create temporary name for prefix `%s'",
777 SDATA (prefix));
778 return Qnil;
779 }
780
781
782 DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0,
783 doc: /* Generate temporary file name (string) starting with PREFIX (a string).
784 The Emacs process number forms part of the result,
785 so there is no danger of generating a name being used by another process.
786
787 In addition, this function makes an attempt to choose a name
788 which has no existing file. To make this work,
789 PREFIX should be an absolute file name.
790
791 There is a race condition between calling `make-temp-name' and creating the
792 file which opens all kinds of security holes. For that reason, you should
793 probably use `make-temp-file' instead, except in three circumstances:
794
795 * If you are creating the file in the user's home directory.
796 * If you are creating a directory rather than an ordinary file.
797 * If you are taking special precautions as `make-temp-file' does. */)
798 (Lisp_Object prefix)
799 {
800 return make_temp_name (prefix, 0);
801 }
802
803
804 \f
805 DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
806 doc: /* Convert filename NAME to absolute, and canonicalize it.
807 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
808 \(does not start with slash or tilde); if DEFAULT-DIRECTORY is nil or missing,
809 the current buffer's value of `default-directory' is used.
810 File name components that are `.' are removed, and
811 so are file name components followed by `..', along with the `..' itself;
812 note that these simplifications are done without checking the resulting
813 file names in the file system.
814 An initial `~/' expands to your home directory.
815 An initial `~USER/' expands to USER's home directory.
816 See also the function `substitute-in-file-name'.
817
818 For technical reasons, this function can return correct but
819 non-intuitive results for the root directory; for instance,
820 \(expand-file-name ".." "/") returns "/..". For this reason, use
821 (directory-file-name (file-name-directory dirname)) to traverse a
822 filesystem tree, not (expand-file-name ".." dirname). */)
823 (Lisp_Object name, Lisp_Object default_directory)
824 {
825 /* These point to SDATA and need to be careful with string-relocation
826 during GC (via DECODE_FILE). */
827 unsigned char *nm, *newdir;
828 /* This should only point to alloca'd data. */
829 unsigned char *target;
830
831 int tlen;
832 struct passwd *pw;
833 #ifdef DOS_NT
834 int drive = 0;
835 int collapse_newdir = 1;
836 int is_escaped = 0;
837 #endif /* DOS_NT */
838 int length;
839 Lisp_Object handler, result;
840 int multibyte;
841 Lisp_Object hdir;
842
843 CHECK_STRING (name);
844
845 /* If the file name has special constructs in it,
846 call the corresponding file handler. */
847 handler = Ffind_file_name_handler (name, Qexpand_file_name);
848 if (!NILP (handler))
849 return call3 (handler, Qexpand_file_name, name, default_directory);
850
851 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
852 if (NILP (default_directory))
853 default_directory = current_buffer->directory;
854 if (! STRINGP (default_directory))
855 {
856 #ifdef DOS_NT
857 /* "/" is not considered a root directory on DOS_NT, so using "/"
858 here causes an infinite recursion in, e.g., the following:
859
860 (let (default-directory)
861 (expand-file-name "a"))
862
863 To avoid this, we set default_directory to the root of the
864 current drive. */
865 extern char *emacs_root_dir (void);
866
867 default_directory = build_string (emacs_root_dir ());
868 #else
869 default_directory = build_string ("/");
870 #endif
871 }
872
873 if (!NILP (default_directory))
874 {
875 handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
876 if (!NILP (handler))
877 return call3 (handler, Qexpand_file_name, name, default_directory);
878 }
879
880 {
881 unsigned char *o = SDATA (default_directory);
882
883 /* Make sure DEFAULT_DIRECTORY is properly expanded.
884 It would be better to do this down below where we actually use
885 default_directory. Unfortunately, calling Fexpand_file_name recursively
886 could invoke GC, and the strings might be relocated. This would
887 be annoying because we have pointers into strings lying around
888 that would need adjusting, and people would add new pointers to
889 the code and forget to adjust them, resulting in intermittent bugs.
890 Putting this call here avoids all that crud.
891
892 The EQ test avoids infinite recursion. */
893 if (! NILP (default_directory) && !EQ (default_directory, name)
894 /* Save time in some common cases - as long as default_directory
895 is not relative, it can be canonicalized with name below (if it
896 is needed at all) without requiring it to be expanded now. */
897 #ifdef DOS_NT
898 /* Detect MSDOS file names with drive specifiers. */
899 && ! (IS_DRIVE (o[0]) && IS_DEVICE_SEP (o[1])
900 && IS_DIRECTORY_SEP (o[2]))
901 #ifdef WINDOWSNT
902 /* Detect Windows file names in UNC format. */
903 && ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1]))
904 #endif
905 #else /* not DOS_NT */
906 /* Detect Unix absolute file names (/... alone is not absolute on
907 DOS or Windows). */
908 && ! (IS_DIRECTORY_SEP (o[0]))
909 #endif /* not DOS_NT */
910 )
911 {
912 struct gcpro gcpro1;
913
914 GCPRO1 (name);
915 default_directory = Fexpand_file_name (default_directory, Qnil);
916 UNGCPRO;
917 }
918 }
919 name = FILE_SYSTEM_CASE (name);
920 multibyte = STRING_MULTIBYTE (name);
921 if (multibyte != STRING_MULTIBYTE (default_directory))
922 {
923 if (multibyte)
924 default_directory = string_to_multibyte (default_directory);
925 else
926 {
927 name = string_to_multibyte (name);
928 multibyte = 1;
929 }
930 }
931
932 /* Make a local copy of nm[] to protect it from GC in DECODE_FILE below. */
933 nm = (unsigned char *) alloca (SBYTES (name) + 1);
934 memcpy (nm, SDATA (name), SBYTES (name) + 1);
935
936 #ifdef DOS_NT
937 /* Note if special escape prefix is present, but remove for now. */
938 if (nm[0] == '/' && nm[1] == ':')
939 {
940 is_escaped = 1;
941 nm += 2;
942 }
943
944 /* Find and remove drive specifier if present; this makes nm absolute
945 even if the rest of the name appears to be relative. Only look for
946 drive specifier at the beginning. */
947 if (IS_DRIVE (nm[0]) && IS_DEVICE_SEP (nm[1]))
948 {
949 drive = nm[0];
950 nm += 2;
951 }
952
953 #ifdef WINDOWSNT
954 /* If we see "c://somedir", we want to strip the first slash after the
955 colon when stripping the drive letter. Otherwise, this expands to
956 "//somedir". */
957 if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
958 nm++;
959
960 /* Discard any previous drive specifier if nm is now in UNC format. */
961 if (IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
962 {
963 drive = 0;
964 }
965 #endif /* WINDOWSNT */
966 #endif /* DOS_NT */
967
968 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
969 none are found, we can probably return right away. We will avoid
970 allocating a new string if name is already fully expanded. */
971 if (
972 IS_DIRECTORY_SEP (nm[0])
973 #ifdef MSDOS
974 && drive && !is_escaped
975 #endif
976 #ifdef WINDOWSNT
977 && (drive || IS_DIRECTORY_SEP (nm[1])) && !is_escaped
978 #endif
979 )
980 {
981 /* If it turns out that the filename we want to return is just a
982 suffix of FILENAME, we don't need to go through and edit
983 things; we just need to construct a new string using data
984 starting at the middle of FILENAME. If we set lose to a
985 non-zero value, that means we've discovered that we can't do
986 that cool trick. */
987 int lose = 0;
988 unsigned char *p = nm;
989
990 while (*p)
991 {
992 /* Since we know the name is absolute, we can assume that each
993 element starts with a "/". */
994
995 /* "." and ".." are hairy. */
996 if (IS_DIRECTORY_SEP (p[0])
997 && p[1] == '.'
998 && (IS_DIRECTORY_SEP (p[2])
999 || p[2] == 0
1000 || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3])
1001 || p[3] == 0))))
1002 lose = 1;
1003 /* We want to replace multiple `/' in a row with a single
1004 slash. */
1005 else if (p > nm
1006 && IS_DIRECTORY_SEP (p[0])
1007 && IS_DIRECTORY_SEP (p[1]))
1008 lose = 1;
1009 p++;
1010 }
1011 if (!lose)
1012 {
1013 #ifdef DOS_NT
1014 /* Make sure directories are all separated with /, but
1015 avoid allocation of a new string when not required. */
1016 dostounix_filename (nm);
1017 #ifdef WINDOWSNT
1018 if (IS_DIRECTORY_SEP (nm[1]))
1019 {
1020 if (strcmp (nm, SDATA (name)) != 0)
1021 name = make_specified_string (nm, -1, strlen (nm), multibyte);
1022 }
1023 else
1024 #endif
1025 /* drive must be set, so this is okay */
1026 if (strcmp (nm - 2, SDATA (name)) != 0)
1027 {
1028 char temp[] = " :";
1029
1030 name = make_specified_string (nm, -1, p - nm, multibyte);
1031 temp[0] = DRIVE_LETTER (drive);
1032 name = concat2 (build_string (temp), name);
1033 }
1034 return name;
1035 #else /* not DOS_NT */
1036 if (strcmp (nm, SDATA (name)) == 0)
1037 return name;
1038 return make_specified_string (nm, -1, strlen (nm), multibyte);
1039 #endif /* not DOS_NT */
1040 }
1041 }
1042
1043 /* At this point, nm might or might not be an absolute file name. We
1044 need to expand ~ or ~user if present, otherwise prefix nm with
1045 default_directory if nm is not absolute, and finally collapse /./
1046 and /foo/../ sequences.
1047
1048 We set newdir to be the appropriate prefix if one is needed:
1049 - the relevant user directory if nm starts with ~ or ~user
1050 - the specified drive's working dir (DOS/NT only) if nm does not
1051 start with /
1052 - the value of default_directory.
1053
1054 Note that these prefixes are not guaranteed to be absolute (except
1055 for the working dir of a drive). Therefore, to ensure we always
1056 return an absolute name, if the final prefix is not absolute we
1057 append it to the current working directory. */
1058
1059 newdir = 0;
1060
1061 if (nm[0] == '~') /* prefix ~ */
1062 {
1063 if (IS_DIRECTORY_SEP (nm[1])
1064 || nm[1] == 0) /* ~ by itself */
1065 {
1066 Lisp_Object tem;
1067
1068 if (!(newdir = (unsigned char *) egetenv ("HOME")))
1069 newdir = (unsigned char *) "";
1070 nm++;
1071 /* egetenv may return a unibyte string, which will bite us since
1072 we expect the directory to be multibyte. */
1073 tem = build_string (newdir);
1074 if (!STRING_MULTIBYTE (tem))
1075 {
1076 hdir = DECODE_FILE (tem);
1077 newdir = SDATA (hdir);
1078 }
1079 #ifdef DOS_NT
1080 collapse_newdir = 0;
1081 #endif
1082 }
1083 else /* ~user/filename */
1084 {
1085 unsigned char *o, *p;
1086 for (p = nm; *p && (!IS_DIRECTORY_SEP (*p)); p++);
1087 o = alloca (p - nm + 1);
1088 memcpy (o, nm, p - nm);
1089 o [p - nm] = 0;
1090
1091 BLOCK_INPUT;
1092 pw = (struct passwd *) getpwnam (o + 1);
1093 UNBLOCK_INPUT;
1094 if (pw)
1095 {
1096 newdir = (unsigned char *) pw -> pw_dir;
1097 nm = p;
1098 #ifdef DOS_NT
1099 collapse_newdir = 0;
1100 #endif
1101 }
1102
1103 /* If we don't find a user of that name, leave the name
1104 unchanged; don't move nm forward to p. */
1105 }
1106 }
1107
1108 #ifdef DOS_NT
1109 /* On DOS and Windows, nm is absolute if a drive name was specified;
1110 use the drive's current directory as the prefix if needed. */
1111 if (!newdir && drive)
1112 {
1113 /* Get default directory if needed to make nm absolute. */
1114 if (!IS_DIRECTORY_SEP (nm[0]))
1115 {
1116 newdir = alloca (MAXPATHLEN + 1);
1117 if (!getdefdir (toupper (drive) - 'A' + 1, newdir))
1118 newdir = NULL;
1119 }
1120 if (!newdir)
1121 {
1122 /* Either nm starts with /, or drive isn't mounted. */
1123 newdir = alloca (4);
1124 newdir[0] = DRIVE_LETTER (drive);
1125 newdir[1] = ':';
1126 newdir[2] = '/';
1127 newdir[3] = 0;
1128 }
1129 }
1130 #endif /* DOS_NT */
1131
1132 /* Finally, if no prefix has been specified and nm is not absolute,
1133 then it must be expanded relative to default_directory. */
1134
1135 if (1
1136 #ifndef DOS_NT
1137 /* /... alone is not absolute on DOS and Windows. */
1138 && !IS_DIRECTORY_SEP (nm[0])
1139 #endif
1140 #ifdef WINDOWSNT
1141 && !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
1142 #endif
1143 && !newdir)
1144 {
1145 newdir = SDATA (default_directory);
1146 #ifdef DOS_NT
1147 /* Note if special escape prefix is present, but remove for now. */
1148 if (newdir[0] == '/' && newdir[1] == ':')
1149 {
1150 is_escaped = 1;
1151 newdir += 2;
1152 }
1153 #endif
1154 }
1155
1156 #ifdef DOS_NT
1157 if (newdir)
1158 {
1159 /* First ensure newdir is an absolute name. */
1160 if (
1161 /* Detect MSDOS file names with drive specifiers. */
1162 ! (IS_DRIVE (newdir[0])
1163 && IS_DEVICE_SEP (newdir[1]) && IS_DIRECTORY_SEP (newdir[2]))
1164 #ifdef WINDOWSNT
1165 /* Detect Windows file names in UNC format. */
1166 && ! (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
1167 #endif
1168 )
1169 {
1170 /* Effectively, let newdir be (expand-file-name newdir cwd).
1171 Because of the admonition against calling expand-file-name
1172 when we have pointers into lisp strings, we accomplish this
1173 indirectly by prepending newdir to nm if necessary, and using
1174 cwd (or the wd of newdir's drive) as the new newdir. */
1175
1176 if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1]))
1177 {
1178 drive = newdir[0];
1179 newdir += 2;
1180 }
1181 if (!IS_DIRECTORY_SEP (nm[0]))
1182 {
1183 char * tmp = alloca (strlen (newdir) + strlen (nm) + 2);
1184 file_name_as_directory (tmp, newdir);
1185 strcat (tmp, nm);
1186 nm = tmp;
1187 }
1188 newdir = alloca (MAXPATHLEN + 1);
1189 if (drive)
1190 {
1191 if (!getdefdir (toupper (drive) - 'A' + 1, newdir))
1192 newdir = "/";
1193 }
1194 else
1195 getwd (newdir);
1196 }
1197
1198 /* Strip off drive name from prefix, if present. */
1199 if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1]))
1200 {
1201 drive = newdir[0];
1202 newdir += 2;
1203 }
1204
1205 /* Keep only a prefix from newdir if nm starts with slash
1206 (//server/share for UNC, nothing otherwise). */
1207 if (IS_DIRECTORY_SEP (nm[0]) && collapse_newdir)
1208 {
1209 #ifdef WINDOWSNT
1210 if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
1211 {
1212 unsigned char *p;
1213 newdir = strcpy (alloca (strlen (newdir) + 1), newdir);
1214 p = newdir + 2;
1215 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
1216 p++;
1217 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
1218 *p = 0;
1219 }
1220 else
1221 #endif
1222 newdir = "";
1223 }
1224 }
1225 #endif /* DOS_NT */
1226
1227 if (newdir)
1228 {
1229 /* Get rid of any slash at the end of newdir, unless newdir is
1230 just / or // (an incomplete UNC name). */
1231 length = strlen (newdir);
1232 if (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1])
1233 #ifdef WINDOWSNT
1234 && !(length == 2 && IS_DIRECTORY_SEP (newdir[0]))
1235 #endif
1236 )
1237 {
1238 unsigned char *temp = (unsigned char *) alloca (length);
1239 memcpy (temp, newdir, length - 1);
1240 temp[length - 1] = 0;
1241 newdir = temp;
1242 }
1243 tlen = length + 1;
1244 }
1245 else
1246 tlen = 0;
1247
1248 /* Now concatenate the directory and name to new space in the stack frame */
1249 tlen += strlen (nm) + 1;
1250 #ifdef DOS_NT
1251 /* Reserve space for drive specifier and escape prefix, since either
1252 or both may need to be inserted. (The Microsoft x86 compiler
1253 produces incorrect code if the following two lines are combined.) */
1254 target = (unsigned char *) alloca (tlen + 4);
1255 target += 4;
1256 #else /* not DOS_NT */
1257 target = (unsigned char *) alloca (tlen);
1258 #endif /* not DOS_NT */
1259 *target = 0;
1260
1261 if (newdir)
1262 {
1263 if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0]))
1264 {
1265 #ifdef DOS_NT
1266 /* If newdir is effectively "C:/", then the drive letter will have
1267 been stripped and newdir will be "/". Concatenating with an
1268 absolute directory in nm produces "//", which will then be
1269 incorrectly treated as a network share. Ignore newdir in
1270 this case (keeping the drive letter). */
1271 if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0])
1272 && newdir[1] == '\0'))
1273 #endif
1274 strcpy (target, newdir);
1275 }
1276 else
1277 file_name_as_directory (target, newdir);
1278 }
1279
1280 strcat (target, nm);
1281
1282 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1283 appear. */
1284 {
1285 unsigned char *p = target;
1286 unsigned char *o = target;
1287
1288 while (*p)
1289 {
1290 if (!IS_DIRECTORY_SEP (*p))
1291 {
1292 *o++ = *p++;
1293 }
1294 else if (p[1] == '.'
1295 && (IS_DIRECTORY_SEP (p[2])
1296 || p[2] == 0))
1297 {
1298 /* If "/." is the entire filename, keep the "/". Otherwise,
1299 just delete the whole "/.". */
1300 if (o == target && p[2] == '\0')
1301 *o++ = *p;
1302 p += 2;
1303 }
1304 else if (p[1] == '.' && p[2] == '.'
1305 /* `/../' is the "superroot" on certain file systems.
1306 Turned off on DOS_NT systems because they have no
1307 "superroot" and because this causes us to produce
1308 file names like "d:/../foo" which fail file-related
1309 functions of the underlying OS. (To reproduce, try a
1310 long series of "../../" in default_directory, longer
1311 than the number of levels from the root.) */
1312 #ifndef DOS_NT
1313 && o != target
1314 #endif
1315 && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0))
1316 {
1317 #ifdef WINDOWSNT
1318 unsigned char *prev_o = o;
1319 #endif
1320 while (o != target && (--o) && !IS_DIRECTORY_SEP (*o))
1321 ;
1322 #ifdef WINDOWSNT
1323 /* Don't go below server level in UNC filenames. */
1324 if (o == target + 1 && IS_DIRECTORY_SEP (*o)
1325 && IS_DIRECTORY_SEP (*target))
1326 o = prev_o;
1327 else
1328 #endif
1329 /* Keep initial / only if this is the whole name. */
1330 if (o == target && IS_ANY_SEP (*o) && p[3] == 0)
1331 ++o;
1332 p += 3;
1333 }
1334 else if (p > target && IS_DIRECTORY_SEP (p[1]))
1335 /* Collapse multiple `/' in a row. */
1336 p++;
1337 else
1338 {
1339 *o++ = *p++;
1340 }
1341 }
1342
1343 #ifdef DOS_NT
1344 /* At last, set drive name. */
1345 #ifdef WINDOWSNT
1346 /* Except for network file name. */
1347 if (!(IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1])))
1348 #endif /* WINDOWSNT */
1349 {
1350 if (!drive) abort ();
1351 target -= 2;
1352 target[0] = DRIVE_LETTER (drive);
1353 target[1] = ':';
1354 }
1355 /* Reinsert the escape prefix if required. */
1356 if (is_escaped)
1357 {
1358 target -= 2;
1359 target[0] = '/';
1360 target[1] = ':';
1361 }
1362 dostounix_filename (target);
1363 #endif /* DOS_NT */
1364
1365 result = make_specified_string (target, -1, o - target, multibyte);
1366 }
1367
1368 /* Again look to see if the file name has special constructs in it
1369 and perhaps call the corresponding file handler. This is needed
1370 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1371 the ".." component gives us "/user@host:/bar/../baz" which needs
1372 to be expanded again. */
1373 handler = Ffind_file_name_handler (result, Qexpand_file_name);
1374 if (!NILP (handler))
1375 return call3 (handler, Qexpand_file_name, result, default_directory);
1376
1377 return result;
1378 }
1379
1380 #if 0
1381 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1382 This is the old version of expand-file-name, before it was thoroughly
1383 rewritten for Emacs 10.31. We leave this version here commented-out,
1384 because the code is very complex and likely to have subtle bugs. If
1385 bugs _are_ found, it might be of interest to look at the old code and
1386 see what did it do in the relevant situation.
1387
1388 Don't remove this code: it's true that it will be accessible
1389 from the repository, but a few years from deletion, people will
1390 forget it is there. */
1391
1392 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1393 DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
1394 "Convert FILENAME to absolute, and canonicalize it.\n\
1395 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1396 \(does not start with slash); if DEFAULT is nil or missing,\n\
1397 the current buffer's value of default-directory is used.\n\
1398 Filenames containing `.' or `..' as components are simplified;\n\
1399 initial `~/' expands to your home directory.\n\
1400 See also the function `substitute-in-file-name'.")
1401 (name, defalt)
1402 Lisp_Object name, defalt;
1403 {
1404 unsigned char *nm;
1405
1406 register unsigned char *newdir, *p, *o;
1407 int tlen;
1408 unsigned char *target;
1409 struct passwd *pw;
1410 int lose;
1411
1412 CHECK_STRING (name);
1413 nm = SDATA (name);
1414
1415 /* If nm is absolute, flush ...// and detect /./ and /../.
1416 If no /./ or /../ we can return right away. */
1417 if (nm[0] == '/')
1418 {
1419 p = nm;
1420 lose = 0;
1421 while (*p)
1422 {
1423 if (p[0] == '/' && p[1] == '/'
1424 )
1425 nm = p + 1;
1426 if (p[0] == '/' && p[1] == '~')
1427 nm = p + 1, lose = 1;
1428 if (p[0] == '/' && p[1] == '.'
1429 && (p[2] == '/' || p[2] == 0
1430 || (p[2] == '.' && (p[3] == '/' || p[3] == 0))))
1431 lose = 1;
1432 p++;
1433 }
1434 if (!lose)
1435 {
1436 if (nm == SDATA (name))
1437 return name;
1438 return build_string (nm);
1439 }
1440 }
1441
1442 /* Now determine directory to start with and put it in NEWDIR */
1443
1444 newdir = 0;
1445
1446 if (nm[0] == '~') /* prefix ~ */
1447 if (nm[1] == '/' || nm[1] == 0)/* ~/filename */
1448 {
1449 if (!(newdir = (unsigned char *) egetenv ("HOME")))
1450 newdir = (unsigned char *) "";
1451 nm++;
1452 }
1453 else /* ~user/filename */
1454 {
1455 /* Get past ~ to user */
1456 unsigned char *user = nm + 1;
1457 /* Find end of name. */
1458 unsigned char *ptr = (unsigned char *) strchr (user, '/');
1459 int len = ptr ? ptr - user : strlen (user);
1460 /* Copy the user name into temp storage. */
1461 o = (unsigned char *) alloca (len + 1);
1462 memcpy (o, user, len);
1463 o[len] = 0;
1464
1465 /* Look up the user name. */
1466 BLOCK_INPUT;
1467 pw = (struct passwd *) getpwnam (o + 1);
1468 UNBLOCK_INPUT;
1469 if (!pw)
1470 error ("\"%s\" isn't a registered user", o + 1);
1471
1472 newdir = (unsigned char *) pw->pw_dir;
1473
1474 /* Discard the user name from NM. */
1475 nm += len;
1476 }
1477
1478 if (nm[0] != '/' && !newdir)
1479 {
1480 if (NILP (defalt))
1481 defalt = current_buffer->directory;
1482 CHECK_STRING (defalt);
1483 newdir = SDATA (defalt);
1484 }
1485
1486 /* Now concatenate the directory and name to new space in the stack frame */
1487
1488 tlen = (newdir ? strlen (newdir) + 1 : 0) + strlen (nm) + 1;
1489 target = (unsigned char *) alloca (tlen);
1490 *target = 0;
1491
1492 if (newdir)
1493 {
1494 if (nm[0] == 0 || nm[0] == '/')
1495 strcpy (target, newdir);
1496 else
1497 file_name_as_directory (target, newdir);
1498 }
1499
1500 strcat (target, nm);
1501
1502 /* Now canonicalize by removing /. and /foo/.. if they appear */
1503
1504 p = target;
1505 o = target;
1506
1507 while (*p)
1508 {
1509 if (*p != '/')
1510 {
1511 *o++ = *p++;
1512 }
1513 else if (!strncmp (p, "//", 2)
1514 )
1515 {
1516 o = target;
1517 p++;
1518 }
1519 else if (p[0] == '/' && p[1] == '.'
1520 && (p[2] == '/' || p[2] == 0))
1521 p += 2;
1522 else if (!strncmp (p, "/..", 3)
1523 /* `/../' is the "superroot" on certain file systems. */
1524 && o != target
1525 && (p[3] == '/' || p[3] == 0))
1526 {
1527 while (o != target && *--o != '/')
1528 ;
1529 if (o == target && *o == '/')
1530 ++o;
1531 p += 3;
1532 }
1533 else
1534 {
1535 *o++ = *p++;
1536 }
1537 }
1538
1539 return make_string (target, o - target);
1540 }
1541 #endif
1542 \f
1543 /* If /~ or // appears, discard everything through first slash. */
1544 static int
1545 file_name_absolute_p (const unsigned char *filename)
1546 {
1547 return
1548 (IS_DIRECTORY_SEP (*filename) || *filename == '~'
1549 #ifdef DOS_NT
1550 || (IS_DRIVE (*filename) && IS_DEVICE_SEP (filename[1])
1551 && IS_DIRECTORY_SEP (filename[2]))
1552 #endif
1553 );
1554 }
1555
1556 static unsigned char *
1557 search_embedded_absfilename (unsigned char *nm, unsigned char *endp)
1558 {
1559 unsigned char *p, *s;
1560
1561 for (p = nm + 1; p < endp; p++)
1562 {
1563 if ((0
1564 || IS_DIRECTORY_SEP (p[-1]))
1565 && file_name_absolute_p (p)
1566 #if defined (WINDOWSNT) || defined(CYGWIN)
1567 /* // at start of file name is meaningful in Apollo,
1568 WindowsNT and Cygwin systems. */
1569 && !(IS_DIRECTORY_SEP (p[0]) && p - 1 == nm)
1570 #endif /* not (WINDOWSNT || CYGWIN) */
1571 )
1572 {
1573 for (s = p; *s && (!IS_DIRECTORY_SEP (*s)); s++);
1574 if (p[0] == '~' && s > p + 1) /* we've got "/~something/" */
1575 {
1576 unsigned char *o = alloca (s - p + 1);
1577 struct passwd *pw;
1578 memcpy (o, p, s - p);
1579 o [s - p] = 0;
1580
1581 /* If we have ~user and `user' exists, discard
1582 everything up to ~. But if `user' does not exist, leave
1583 ~user alone, it might be a literal file name. */
1584 BLOCK_INPUT;
1585 pw = getpwnam (o + 1);
1586 UNBLOCK_INPUT;
1587 if (pw)
1588 return p;
1589 }
1590 else
1591 return p;
1592 }
1593 }
1594 return NULL;
1595 }
1596
1597 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name,
1598 Ssubstitute_in_file_name, 1, 1, 0,
1599 doc: /* Substitute environment variables referred to in FILENAME.
1600 `$FOO' where FOO is an environment variable name means to substitute
1601 the value of that variable. The variable name should be terminated
1602 with a character not a letter, digit or underscore; otherwise, enclose
1603 the entire variable name in braces.
1604
1605 If `/~' appears, all of FILENAME through that `/' is discarded.
1606 If `//' appears, everything up to and including the first of
1607 those `/' is discarded. */)
1608 (Lisp_Object filename)
1609 {
1610 unsigned char *nm;
1611
1612 register unsigned char *s, *p, *o, *x, *endp;
1613 unsigned char *target = NULL;
1614 int total = 0;
1615 int substituted = 0;
1616 int multibyte;
1617 unsigned char *xnm;
1618 Lisp_Object handler;
1619
1620 CHECK_STRING (filename);
1621
1622 multibyte = STRING_MULTIBYTE (filename);
1623
1624 /* If the file name has special constructs in it,
1625 call the corresponding file handler. */
1626 handler = Ffind_file_name_handler (filename, Qsubstitute_in_file_name);
1627 if (!NILP (handler))
1628 return call2 (handler, Qsubstitute_in_file_name, filename);
1629
1630 /* Always work on a copy of the string, in case GC happens during
1631 decode of environment variables, causing the original Lisp_String
1632 data to be relocated. */
1633 nm = (unsigned char *) alloca (SBYTES (filename) + 1);
1634 memcpy (nm, SDATA (filename), SBYTES (filename) + 1);
1635
1636 #ifdef DOS_NT
1637 dostounix_filename (nm);
1638 substituted = (strcmp (nm, SDATA (filename)) != 0);
1639 #endif
1640 endp = nm + SBYTES (filename);
1641
1642 /* If /~ or // appears, discard everything through first slash. */
1643 p = search_embedded_absfilename (nm, endp);
1644 if (p)
1645 /* Start over with the new string, so we check the file-name-handler
1646 again. Important with filenames like "/home/foo//:/hello///there"
1647 which whould substitute to "/:/hello///there" rather than "/there". */
1648 return Fsubstitute_in_file_name
1649 (make_specified_string (p, -1, endp - p, multibyte));
1650
1651 /* See if any variables are substituted into the string
1652 and find the total length of their values in `total' */
1653
1654 for (p = nm; p != endp;)
1655 if (*p != '$')
1656 p++;
1657 else
1658 {
1659 p++;
1660 if (p == endp)
1661 goto badsubst;
1662 else if (*p == '$')
1663 {
1664 /* "$$" means a single "$" */
1665 p++;
1666 total -= 1;
1667 substituted = 1;
1668 continue;
1669 }
1670 else if (*p == '{')
1671 {
1672 o = ++p;
1673 while (p != endp && *p != '}') p++;
1674 if (*p != '}') goto missingclose;
1675 s = p;
1676 }
1677 else
1678 {
1679 o = p;
1680 while (p != endp && (isalnum (*p) || *p == '_')) p++;
1681 s = p;
1682 }
1683
1684 /* Copy out the variable name */
1685 target = (unsigned char *) alloca (s - o + 1);
1686 strncpy (target, o, s - o);
1687 target[s - o] = 0;
1688 #ifdef DOS_NT
1689 strupr (target); /* $home == $HOME etc. */
1690 #endif /* DOS_NT */
1691
1692 /* Get variable value */
1693 o = (unsigned char *) egetenv (target);
1694 if (o)
1695 {
1696 /* Don't try to guess a maximum length - UTF8 can use up to
1697 four bytes per character. This code is unlikely to run
1698 in a situation that requires performance, so decoding the
1699 env variables twice should be acceptable. Note that
1700 decoding may cause a garbage collect. */
1701 Lisp_Object orig, decoded;
1702 orig = make_unibyte_string (o, strlen (o));
1703 decoded = DECODE_FILE (orig);
1704 total += SBYTES (decoded);
1705 substituted = 1;
1706 }
1707 else if (*p == '}')
1708 goto badvar;
1709 }
1710
1711 if (!substituted)
1712 return filename;
1713
1714 /* If substitution required, recopy the string and do it */
1715 /* Make space in stack frame for the new copy */
1716 xnm = (unsigned char *) alloca (SBYTES (filename) + total + 1);
1717 x = xnm;
1718
1719 /* Copy the rest of the name through, replacing $ constructs with values */
1720 for (p = nm; *p;)
1721 if (*p != '$')
1722 *x++ = *p++;
1723 else
1724 {
1725 p++;
1726 if (p == endp)
1727 goto badsubst;
1728 else if (*p == '$')
1729 {
1730 *x++ = *p++;
1731 continue;
1732 }
1733 else if (*p == '{')
1734 {
1735 o = ++p;
1736 while (p != endp && *p != '}') p++;
1737 if (*p != '}') goto missingclose;
1738 s = p++;
1739 }
1740 else
1741 {
1742 o = p;
1743 while (p != endp && (isalnum (*p) || *p == '_')) p++;
1744 s = p;
1745 }
1746
1747 /* Copy out the variable name */
1748 target = (unsigned char *) alloca (s - o + 1);
1749 strncpy (target, o, s - o);
1750 target[s - o] = 0;
1751 #ifdef DOS_NT
1752 strupr (target); /* $home == $HOME etc. */
1753 #endif /* DOS_NT */
1754
1755 /* Get variable value */
1756 o = (unsigned char *) egetenv (target);
1757 if (!o)
1758 {
1759 *x++ = '$';
1760 strcpy (x, target); x+= strlen (target);
1761 }
1762 else
1763 {
1764 Lisp_Object orig, decoded;
1765 int orig_length, decoded_length;
1766 orig_length = strlen (o);
1767 orig = make_unibyte_string (o, orig_length);
1768 decoded = DECODE_FILE (orig);
1769 decoded_length = SBYTES (decoded);
1770 strncpy (x, SDATA (decoded), decoded_length);
1771 x += decoded_length;
1772
1773 /* If environment variable needed decoding, return value
1774 needs to be multibyte. */
1775 if (decoded_length != orig_length
1776 || strncmp (SDATA (decoded), o, orig_length))
1777 multibyte = 1;
1778 }
1779 }
1780
1781 *x = 0;
1782
1783 /* If /~ or // appears, discard everything through first slash. */
1784 while ((p = search_embedded_absfilename (xnm, x)))
1785 /* This time we do not start over because we've already expanded envvars
1786 and replaced $$ with $. Maybe we should start over as well, but we'd
1787 need to quote some $ to $$ first. */
1788 xnm = p;
1789
1790 return make_specified_string (xnm, -1, x - xnm, multibyte);
1791
1792 badsubst:
1793 error ("Bad format environment-variable substitution");
1794 missingclose:
1795 error ("Missing \"}\" in environment-variable substitution");
1796 badvar:
1797 error ("Substituting nonexistent environment variable \"%s\"", target);
1798
1799 /* NOTREACHED */
1800 return Qnil;
1801 }
1802 \f
1803 /* A slightly faster and more convenient way to get
1804 (directory-file-name (expand-file-name FOO)). */
1805
1806 Lisp_Object
1807 expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir)
1808 {
1809 register Lisp_Object absname;
1810
1811 absname = Fexpand_file_name (filename, defdir);
1812
1813 /* Remove final slash, if any (unless this is the root dir).
1814 stat behaves differently depending! */
1815 if (SCHARS (absname) > 1
1816 && IS_DIRECTORY_SEP (SREF (absname, SBYTES (absname) - 1))
1817 && !IS_DEVICE_SEP (SREF (absname, SBYTES (absname)-2)))
1818 /* We cannot take shortcuts; they might be wrong for magic file names. */
1819 absname = Fdirectory_file_name (absname);
1820 return absname;
1821 }
1822 \f
1823 /* Signal an error if the file ABSNAME already exists.
1824 If INTERACTIVE is nonzero, ask the user whether to proceed,
1825 and bypass the error if the user says to go ahead.
1826 QUERYSTRING is a name for the action that is being considered
1827 to alter the file.
1828
1829 *STATPTR is used to store the stat information if the file exists.
1830 If the file does not exist, STATPTR->st_mode is set to 0.
1831 If STATPTR is null, we don't store into it.
1832
1833 If QUICK is nonzero, we ask for y or n, not yes or no. */
1834
1835 void
1836 barf_or_query_if_file_exists (Lisp_Object absname, unsigned char *querystring, int interactive, struct stat *statptr, int quick)
1837 {
1838 register Lisp_Object tem, encoded_filename;
1839 struct stat statbuf;
1840 struct gcpro gcpro1;
1841
1842 encoded_filename = ENCODE_FILE (absname);
1843
1844 /* stat is a good way to tell whether the file exists,
1845 regardless of what access permissions it has. */
1846 if (lstat (SDATA (encoded_filename), &statbuf) >= 0)
1847 {
1848 if (! interactive)
1849 xsignal2 (Qfile_already_exists,
1850 build_string ("File already exists"), absname);
1851 GCPRO1 (absname);
1852 tem = format2 ("File %s already exists; %s anyway? ",
1853 absname, build_string (querystring));
1854 if (quick)
1855 tem = Fy_or_n_p (tem);
1856 else
1857 tem = do_yes_or_no_p (tem);
1858 UNGCPRO;
1859 if (NILP (tem))
1860 xsignal2 (Qfile_already_exists,
1861 build_string ("File already exists"), absname);
1862 if (statptr)
1863 *statptr = statbuf;
1864 }
1865 else
1866 {
1867 if (statptr)
1868 statptr->st_mode = 0;
1869 }
1870 return;
1871 }
1872
1873 DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 6,
1874 "fCopy file: \nGCopy %s to file: \np\nP",
1875 doc: /* Copy FILE to NEWNAME. Both args must be strings.
1876 If NEWNAME names a directory, copy FILE there.
1877
1878 This function always sets the file modes of the output file to match
1879 the input file.
1880
1881 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
1882 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
1883 signal a `file-already-exists' error without overwriting. If
1884 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
1885 about overwriting; this is what happens in interactive use with M-x.
1886 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
1887 existing file.
1888
1889 Fourth arg KEEP-TIME non-nil means give the output file the same
1890 last-modified time as the old one. (This works on only some systems.)
1891
1892 A prefix arg makes KEEP-TIME non-nil.
1893
1894 If PRESERVE-UID-GID is non-nil, we try to transfer the
1895 uid and gid of FILE to NEWNAME.
1896
1897 If PRESERVE-SELINUX-CONTEXT is non-nil and SELinux is enabled
1898 on the system, we copy the SELinux context of FILE to NEWNAME. */)
1899 (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists, Lisp_Object keep_time, Lisp_Object preserve_uid_gid, Lisp_Object preserve_selinux_context)
1900 {
1901 int ifd, ofd, n;
1902 char buf[16 * 1024];
1903 struct stat st, out_st;
1904 Lisp_Object handler;
1905 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1906 int count = SPECPDL_INDEX ();
1907 int input_file_statable_p;
1908 Lisp_Object encoded_file, encoded_newname;
1909 #if HAVE_LIBSELINUX
1910 security_context_t con;
1911 int fail, conlength = 0;
1912 #endif
1913
1914 encoded_file = encoded_newname = Qnil;
1915 GCPRO4 (file, newname, encoded_file, encoded_newname);
1916 CHECK_STRING (file);
1917 CHECK_STRING (newname);
1918
1919 if (!NILP (Ffile_directory_p (newname)))
1920 newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname);
1921 else
1922 newname = Fexpand_file_name (newname, Qnil);
1923
1924 file = Fexpand_file_name (file, Qnil);
1925
1926 /* If the input file name has special constructs in it,
1927 call the corresponding file handler. */
1928 handler = Ffind_file_name_handler (file, Qcopy_file);
1929 /* Likewise for output file name. */
1930 if (NILP (handler))
1931 handler = Ffind_file_name_handler (newname, Qcopy_file);
1932 if (!NILP (handler))
1933 RETURN_UNGCPRO (call7 (handler, Qcopy_file, file, newname,
1934 ok_if_already_exists, keep_time, preserve_uid_gid,
1935 preserve_selinux_context));
1936
1937 encoded_file = ENCODE_FILE (file);
1938 encoded_newname = ENCODE_FILE (newname);
1939
1940 if (NILP (ok_if_already_exists)
1941 || INTEGERP (ok_if_already_exists))
1942 barf_or_query_if_file_exists (newname, "copy to it",
1943 INTEGERP (ok_if_already_exists), &out_st, 0);
1944 else if (stat (SDATA (encoded_newname), &out_st) < 0)
1945 out_st.st_mode = 0;
1946
1947 #ifdef WINDOWSNT
1948 if (!CopyFile (SDATA (encoded_file),
1949 SDATA (encoded_newname),
1950 FALSE))
1951 report_file_error ("Copying file", Fcons (file, Fcons (newname, Qnil)));
1952 /* CopyFile retains the timestamp by default. */
1953 else if (NILP (keep_time))
1954 {
1955 EMACS_TIME now;
1956 DWORD attributes;
1957 char * filename;
1958
1959 EMACS_GET_TIME (now);
1960 filename = SDATA (encoded_newname);
1961
1962 /* Ensure file is writable while its modified time is set. */
1963 attributes = GetFileAttributes (filename);
1964 SetFileAttributes (filename, attributes & ~FILE_ATTRIBUTE_READONLY);
1965 if (set_file_times (filename, now, now))
1966 {
1967 /* Restore original attributes. */
1968 SetFileAttributes (filename, attributes);
1969 xsignal2 (Qfile_date_error,
1970 build_string ("Cannot set file date"), newname);
1971 }
1972 /* Restore original attributes. */
1973 SetFileAttributes (filename, attributes);
1974 }
1975 #else /* not WINDOWSNT */
1976 immediate_quit = 1;
1977 ifd = emacs_open (SDATA (encoded_file), O_RDONLY, 0);
1978 immediate_quit = 0;
1979
1980 if (ifd < 0)
1981 report_file_error ("Opening input file", Fcons (file, Qnil));
1982
1983 record_unwind_protect (close_file_unwind, make_number (ifd));
1984
1985 /* We can only copy regular files and symbolic links. Other files are not
1986 copyable by us. */
1987 input_file_statable_p = (fstat (ifd, &st) >= 0);
1988
1989 #if HAVE_LIBSELINUX
1990 if (!NILP (preserve_selinux_context) && is_selinux_enabled ())
1991 {
1992 conlength = fgetfilecon (ifd, &con);
1993 if (conlength == -1)
1994 report_file_error ("Doing fgetfilecon", Fcons (file, Qnil));
1995 }
1996 #endif
1997
1998 if (out_st.st_mode != 0
1999 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
2000 {
2001 errno = 0;
2002 report_file_error ("Input and output files are the same",
2003 Fcons (file, Fcons (newname, Qnil)));
2004 }
2005
2006 #if defined (S_ISREG) && defined (S_ISLNK)
2007 if (input_file_statable_p)
2008 {
2009 if (!(S_ISREG (st.st_mode)) && !(S_ISLNK (st.st_mode)))
2010 {
2011 #if defined (EISDIR)
2012 /* Get a better looking error message. */
2013 errno = EISDIR;
2014 #endif /* EISDIR */
2015 report_file_error ("Non-regular file", Fcons (file, Qnil));
2016 }
2017 }
2018 #endif /* S_ISREG && S_ISLNK */
2019
2020 #ifdef MSDOS
2021 /* System's default file type was set to binary by _fmode in emacs.c. */
2022 ofd = emacs_open (SDATA (encoded_newname),
2023 O_WRONLY | O_TRUNC | O_CREAT
2024 | (NILP (ok_if_already_exists) ? O_EXCL : 0),
2025 S_IREAD | S_IWRITE);
2026 #else /* not MSDOS */
2027 ofd = emacs_open (SDATA (encoded_newname),
2028 O_WRONLY | O_TRUNC | O_CREAT
2029 | (NILP (ok_if_already_exists) ? O_EXCL : 0),
2030 0666);
2031 #endif /* not MSDOS */
2032 if (ofd < 0)
2033 report_file_error ("Opening output file", Fcons (newname, Qnil));
2034
2035 record_unwind_protect (close_file_unwind, make_number (ofd));
2036
2037 immediate_quit = 1;
2038 QUIT;
2039 while ((n = emacs_read (ifd, buf, sizeof buf)) > 0)
2040 if (emacs_write (ofd, buf, n) != n)
2041 report_file_error ("I/O error", Fcons (newname, Qnil));
2042 immediate_quit = 0;
2043
2044 #ifndef MSDOS
2045 /* Preserve the original file modes, and if requested, also its
2046 owner and group. */
2047 if (input_file_statable_p)
2048 {
2049 if (! NILP (preserve_uid_gid))
2050 fchown (ofd, st.st_uid, st.st_gid);
2051 fchmod (ofd, st.st_mode & 07777);
2052 }
2053 #endif /* not MSDOS */
2054
2055 #if HAVE_LIBSELINUX
2056 if (conlength > 0)
2057 {
2058 /* Set the modified context back to the file. */
2059 fail = fsetfilecon (ofd, con);
2060 if (fail)
2061 report_file_error ("Doing fsetfilecon", Fcons (newname, Qnil));
2062
2063 freecon (con);
2064 }
2065 #endif
2066
2067 /* Closing the output clobbers the file times on some systems. */
2068 if (emacs_close (ofd) < 0)
2069 report_file_error ("I/O error", Fcons (newname, Qnil));
2070
2071 if (input_file_statable_p)
2072 {
2073 if (!NILP (keep_time))
2074 {
2075 EMACS_TIME atime, mtime;
2076 EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
2077 EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
2078 if (set_file_times (SDATA (encoded_newname),
2079 atime, mtime))
2080 xsignal2 (Qfile_date_error,
2081 build_string ("Cannot set file date"), newname);
2082 }
2083 }
2084
2085 emacs_close (ifd);
2086
2087 #ifdef MSDOS
2088 if (input_file_statable_p)
2089 {
2090 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2091 and if it can't, it tells so. Otherwise, under MSDOS we usually
2092 get only the READ bit, which will make the copied file read-only,
2093 so it's better not to chmod at all. */
2094 if ((_djstat_flags & _STFAIL_WRITEBIT) == 0)
2095 chmod (SDATA (encoded_newname), st.st_mode & 07777);
2096 }
2097 #endif /* MSDOS */
2098 #endif /* not WINDOWSNT */
2099
2100 /* Discard the unwind protects. */
2101 specpdl_ptr = specpdl + count;
2102
2103 UNGCPRO;
2104 return Qnil;
2105 }
2106 \f
2107 DEFUN ("make-directory-internal", Fmake_directory_internal,
2108 Smake_directory_internal, 1, 1, 0,
2109 doc: /* Create a new directory named DIRECTORY. */)
2110 (Lisp_Object directory)
2111 {
2112 const unsigned char *dir;
2113 Lisp_Object handler;
2114 Lisp_Object encoded_dir;
2115
2116 CHECK_STRING (directory);
2117 directory = Fexpand_file_name (directory, Qnil);
2118
2119 handler = Ffind_file_name_handler (directory, Qmake_directory_internal);
2120 if (!NILP (handler))
2121 return call2 (handler, Qmake_directory_internal, directory);
2122
2123 encoded_dir = ENCODE_FILE (directory);
2124
2125 dir = SDATA (encoded_dir);
2126
2127 #ifdef WINDOWSNT
2128 if (mkdir (dir) != 0)
2129 #else
2130 if (mkdir (dir, 0777) != 0)
2131 #endif
2132 report_file_error ("Creating directory", list1 (directory));
2133
2134 return Qnil;
2135 }
2136
2137 DEFUN ("delete-directory-internal", Fdelete_directory_internal,
2138 Sdelete_directory_internal, 1, 1, 0,
2139 doc: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2140 (Lisp_Object directory)
2141 {
2142 const unsigned char *dir;
2143 Lisp_Object handler;
2144 Lisp_Object encoded_dir;
2145
2146 CHECK_STRING (directory);
2147 directory = Fdirectory_file_name (Fexpand_file_name (directory, Qnil));
2148 encoded_dir = ENCODE_FILE (directory);
2149 dir = SDATA (encoded_dir);
2150
2151 if (rmdir (dir) != 0)
2152 report_file_error ("Removing directory", list1 (directory));
2153
2154 return Qnil;
2155 }
2156
2157 DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 2,
2158 "(list (read-file-name \
2159 (if (and delete-by-moving-to-trash (null current-prefix-arg)) \
2160 \"Move file to trash: \" \"Delete file: \") \
2161 nil default-directory (confirm-nonexistent-file-or-buffer)) \
2162 (null current-prefix-arg))",
2163 doc: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2164 If file has multiple names, it continues to exist with the other names.
2165 TRASH non-nil means to trash the file instead of deleting, provided
2166 `delete-by-moving-to-trash' is non-nil.
2167
2168 When called interactively, TRASH is t if no prefix argument is given.
2169 With a prefix argument, TRASH is nil. */)
2170 (Lisp_Object filename, Lisp_Object trash)
2171 {
2172 Lisp_Object handler;
2173 Lisp_Object encoded_file;
2174 struct gcpro gcpro1;
2175
2176 GCPRO1 (filename);
2177 if (!NILP (Ffile_directory_p (filename))
2178 && NILP (Ffile_symlink_p (filename)))
2179 xsignal2 (Qfile_error,
2180 build_string ("Removing old name: is a directory"),
2181 filename);
2182 UNGCPRO;
2183 filename = Fexpand_file_name (filename, Qnil);
2184
2185 handler = Ffind_file_name_handler (filename, Qdelete_file);
2186 if (!NILP (handler))
2187 return call3 (handler, Qdelete_file, filename, trash);
2188
2189 if (delete_by_moving_to_trash && !NILP (trash))
2190 return call1 (Qmove_file_to_trash, filename);
2191
2192 encoded_file = ENCODE_FILE (filename);
2193
2194 if (0 > unlink (SDATA (encoded_file)))
2195 report_file_error ("Removing old name", list1 (filename));
2196 return Qnil;
2197 }
2198
2199 static Lisp_Object
2200 internal_delete_file_1 (Lisp_Object ignore)
2201 {
2202 return Qt;
2203 }
2204
2205 /* Delete file FILENAME, returning 1 if successful and 0 if failed.
2206 This ignores `delete-by-moving-to-trash'. */
2207
2208 int
2209 internal_delete_file (Lisp_Object filename)
2210 {
2211 Lisp_Object tem;
2212
2213 tem = internal_condition_case_2 (Fdelete_file, filename, Qnil,
2214 Qt, internal_delete_file_1);
2215 return NILP (tem);
2216 }
2217 \f
2218 DEFUN ("rename-file", Frename_file, Srename_file, 2, 3,
2219 "fRename file: \nGRename %s to file: \np",
2220 doc: /* Rename FILE as NEWNAME. Both args must be strings.
2221 If file has names other than FILE, it continues to have those names.
2222 Signals a `file-already-exists' error if a file NEWNAME already exists
2223 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2224 A number as third arg means request confirmation if NEWNAME already exists.
2225 This is what happens in interactive use with M-x. */)
2226 (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists)
2227 {
2228 Lisp_Object handler;
2229 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2230 Lisp_Object encoded_file, encoded_newname, symlink_target;
2231
2232 symlink_target = encoded_file = encoded_newname = Qnil;
2233 GCPRO5 (file, newname, encoded_file, encoded_newname, symlink_target);
2234 CHECK_STRING (file);
2235 CHECK_STRING (newname);
2236 file = Fexpand_file_name (file, Qnil);
2237
2238 if ((!NILP (Ffile_directory_p (newname)))
2239 #ifdef DOS_NT
2240 /* If the file names are identical but for the case,
2241 don't attempt to move directory to itself. */
2242 && (NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname))))
2243 #endif
2244 )
2245 {
2246 Lisp_Object fname = NILP (Ffile_directory_p (file))
2247 ? file : Fdirectory_file_name (file);
2248 newname = Fexpand_file_name (Ffile_name_nondirectory (fname), newname);
2249 }
2250 else
2251 newname = Fexpand_file_name (newname, Qnil);
2252
2253 /* If the file name has special constructs in it,
2254 call the corresponding file handler. */
2255 handler = Ffind_file_name_handler (file, Qrename_file);
2256 if (NILP (handler))
2257 handler = Ffind_file_name_handler (newname, Qrename_file);
2258 if (!NILP (handler))
2259 RETURN_UNGCPRO (call4 (handler, Qrename_file,
2260 file, newname, ok_if_already_exists));
2261
2262 encoded_file = ENCODE_FILE (file);
2263 encoded_newname = ENCODE_FILE (newname);
2264
2265 #ifdef DOS_NT
2266 /* If the file names are identical but for the case, don't ask for
2267 confirmation: they simply want to change the letter-case of the
2268 file name. */
2269 if (NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname))))
2270 #endif
2271 if (NILP (ok_if_already_exists)
2272 || INTEGERP (ok_if_already_exists))
2273 barf_or_query_if_file_exists (newname, "rename to it",
2274 INTEGERP (ok_if_already_exists), 0, 0);
2275 if (0 > rename (SDATA (encoded_file), SDATA (encoded_newname)))
2276 {
2277 if (errno == EXDEV)
2278 {
2279 int count;
2280 #ifdef S_IFLNK
2281 symlink_target = Ffile_symlink_p (file);
2282 if (! NILP (symlink_target))
2283 Fmake_symbolic_link (symlink_target, newname,
2284 NILP (ok_if_already_exists) ? Qnil : Qt);
2285 else
2286 #endif
2287 if (!NILP (Ffile_directory_p (file)))
2288 call4 (Qcopy_directory, file, newname, Qt, Qnil);
2289 else
2290 /* We have already prompted if it was an integer, so don't
2291 have copy-file prompt again. */
2292 Fcopy_file (file, newname,
2293 NILP (ok_if_already_exists) ? Qnil : Qt,
2294 Qt, Qt, Qt);
2295
2296 count = SPECPDL_INDEX ();
2297 specbind (Qdelete_by_moving_to_trash, Qnil);
2298
2299 if (!NILP (Ffile_directory_p (file))
2300 #ifdef S_IFLNK
2301 && NILP (symlink_target)
2302 #endif
2303 )
2304 call2 (Qdelete_directory, file, Qt);
2305 else
2306 Fdelete_file (file, Qnil);
2307 unbind_to (count, Qnil);
2308 }
2309 else
2310 report_file_error ("Renaming", list2 (file, newname));
2311 }
2312 UNGCPRO;
2313 return Qnil;
2314 }
2315
2316 DEFUN ("add-name-to-file", Fadd_name_to_file, Sadd_name_to_file, 2, 3,
2317 "fAdd name to file: \nGName to add to %s: \np",
2318 doc: /* Give FILE additional name NEWNAME. Both args must be strings.
2319 Signals a `file-already-exists' error if a file NEWNAME already exists
2320 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2321 A number as third arg means request confirmation if NEWNAME already exists.
2322 This is what happens in interactive use with M-x. */)
2323 (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists)
2324 {
2325 Lisp_Object handler;
2326 Lisp_Object encoded_file, encoded_newname;
2327 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2328
2329 GCPRO4 (file, newname, encoded_file, encoded_newname);
2330 encoded_file = encoded_newname = Qnil;
2331 CHECK_STRING (file);
2332 CHECK_STRING (newname);
2333 file = Fexpand_file_name (file, Qnil);
2334
2335 if (!NILP (Ffile_directory_p (newname)))
2336 newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname);
2337 else
2338 newname = Fexpand_file_name (newname, Qnil);
2339
2340 /* If the file name has special constructs in it,
2341 call the corresponding file handler. */
2342 handler = Ffind_file_name_handler (file, Qadd_name_to_file);
2343 if (!NILP (handler))
2344 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, file,
2345 newname, ok_if_already_exists));
2346
2347 /* If the new name has special constructs in it,
2348 call the corresponding file handler. */
2349 handler = Ffind_file_name_handler (newname, Qadd_name_to_file);
2350 if (!NILP (handler))
2351 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, file,
2352 newname, ok_if_already_exists));
2353
2354 encoded_file = ENCODE_FILE (file);
2355 encoded_newname = ENCODE_FILE (newname);
2356
2357 if (NILP (ok_if_already_exists)
2358 || INTEGERP (ok_if_already_exists))
2359 barf_or_query_if_file_exists (newname, "make it a new name",
2360 INTEGERP (ok_if_already_exists), 0, 0);
2361
2362 unlink (SDATA (newname));
2363 if (0 > link (SDATA (encoded_file), SDATA (encoded_newname)))
2364 report_file_error ("Adding new name", list2 (file, newname));
2365
2366 UNGCPRO;
2367 return Qnil;
2368 }
2369
2370 DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3,
2371 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2372 doc: /* Make a symbolic link to FILENAME, named LINKNAME.
2373 Both args must be strings.
2374 Signals a `file-already-exists' error if a file LINKNAME already exists
2375 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2376 A number as third arg means request confirmation if LINKNAME already exists.
2377 This happens for interactive use with M-x. */)
2378 (Lisp_Object filename, Lisp_Object linkname, Lisp_Object ok_if_already_exists)
2379 {
2380 Lisp_Object handler;
2381 Lisp_Object encoded_filename, encoded_linkname;
2382 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2383
2384 GCPRO4 (filename, linkname, encoded_filename, encoded_linkname);
2385 encoded_filename = encoded_linkname = Qnil;
2386 CHECK_STRING (filename);
2387 CHECK_STRING (linkname);
2388 /* If the link target has a ~, we must expand it to get
2389 a truly valid file name. Otherwise, do not expand;
2390 we want to permit links to relative file names. */
2391 if (SREF (filename, 0) == '~')
2392 filename = Fexpand_file_name (filename, Qnil);
2393
2394 if (!NILP (Ffile_directory_p (linkname)))
2395 linkname = Fexpand_file_name (Ffile_name_nondirectory (filename), linkname);
2396 else
2397 linkname = Fexpand_file_name (linkname, Qnil);
2398
2399 /* If the file name has special constructs in it,
2400 call the corresponding file handler. */
2401 handler = Ffind_file_name_handler (filename, Qmake_symbolic_link);
2402 if (!NILP (handler))
2403 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
2404 linkname, ok_if_already_exists));
2405
2406 /* If the new link name has special constructs in it,
2407 call the corresponding file handler. */
2408 handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link);
2409 if (!NILP (handler))
2410 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
2411 linkname, ok_if_already_exists));
2412
2413 #ifdef S_IFLNK
2414 encoded_filename = ENCODE_FILE (filename);
2415 encoded_linkname = ENCODE_FILE (linkname);
2416
2417 if (NILP (ok_if_already_exists)
2418 || INTEGERP (ok_if_already_exists))
2419 barf_or_query_if_file_exists (linkname, "make it a link",
2420 INTEGERP (ok_if_already_exists), 0, 0);
2421 if (0 > symlink (SDATA (encoded_filename),
2422 SDATA (encoded_linkname)))
2423 {
2424 /* If we didn't complain already, silently delete existing file. */
2425 if (errno == EEXIST)
2426 {
2427 unlink (SDATA (encoded_linkname));
2428 if (0 <= symlink (SDATA (encoded_filename),
2429 SDATA (encoded_linkname)))
2430 {
2431 UNGCPRO;
2432 return Qnil;
2433 }
2434 }
2435
2436 report_file_error ("Making symbolic link", list2 (filename, linkname));
2437 }
2438 UNGCPRO;
2439 return Qnil;
2440
2441 #else
2442 UNGCPRO;
2443 xsignal1 (Qfile_error, build_string ("Symbolic links are not supported"));
2444
2445 #endif /* S_IFLNK */
2446 }
2447
2448 \f
2449 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, Sfile_name_absolute_p,
2450 1, 1, 0,
2451 doc: /* Return t if file FILENAME specifies an absolute file name.
2452 On Unix, this is a name starting with a `/' or a `~'. */)
2453 (Lisp_Object filename)
2454 {
2455 CHECK_STRING (filename);
2456 return file_name_absolute_p (SDATA (filename)) ? Qt : Qnil;
2457 }
2458 \f
2459 /* Return nonzero if file FILENAME exists and can be executed. */
2460
2461 static int
2462 check_executable (char *filename)
2463 {
2464 #ifdef DOS_NT
2465 int len = strlen (filename);
2466 char *suffix;
2467 struct stat st;
2468 if (stat (filename, &st) < 0)
2469 return 0;
2470 return ((st.st_mode & S_IEXEC) != 0);
2471 #else /* not DOS_NT */
2472 #ifdef HAVE_EUIDACCESS
2473 return (euidaccess (filename, 1) >= 0);
2474 #else
2475 /* Access isn't quite right because it uses the real uid
2476 and we really want to test with the effective uid.
2477 But Unix doesn't give us a right way to do it. */
2478 return (access (filename, 1) >= 0);
2479 #endif
2480 #endif /* not DOS_NT */
2481 }
2482
2483 /* Return nonzero if file FILENAME exists and can be written. */
2484
2485 static int
2486 check_writable (char *filename)
2487 {
2488 #ifdef MSDOS
2489 struct stat st;
2490 if (stat (filename, &st) < 0)
2491 return 0;
2492 return (st.st_mode & S_IWRITE || (st.st_mode & S_IFMT) == S_IFDIR);
2493 #else /* not MSDOS */
2494 #ifdef HAVE_EUIDACCESS
2495 return (euidaccess (filename, 2) >= 0);
2496 #else
2497 /* Access isn't quite right because it uses the real uid
2498 and we really want to test with the effective uid.
2499 But Unix doesn't give us a right way to do it.
2500 Opening with O_WRONLY could work for an ordinary file,
2501 but would lose for directories. */
2502 return (access (filename, 2) >= 0);
2503 #endif
2504 #endif /* not MSDOS */
2505 }
2506
2507 DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0,
2508 doc: /* Return t if file FILENAME exists (whether or not you can read it.)
2509 See also `file-readable-p' and `file-attributes'.
2510 This returns nil for a symlink to a nonexistent file.
2511 Use `file-symlink-p' to test for such links. */)
2512 (Lisp_Object filename)
2513 {
2514 Lisp_Object absname;
2515 Lisp_Object handler;
2516 struct stat statbuf;
2517
2518 CHECK_STRING (filename);
2519 absname = Fexpand_file_name (filename, Qnil);
2520
2521 /* If the file name has special constructs in it,
2522 call the corresponding file handler. */
2523 handler = Ffind_file_name_handler (absname, Qfile_exists_p);
2524 if (!NILP (handler))
2525 return call2 (handler, Qfile_exists_p, absname);
2526
2527 absname = ENCODE_FILE (absname);
2528
2529 return (stat (SDATA (absname), &statbuf) >= 0) ? Qt : Qnil;
2530 }
2531
2532 DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0,
2533 doc: /* Return t if FILENAME can be executed by you.
2534 For a directory, this means you can access files in that directory. */)
2535 (Lisp_Object filename)
2536 {
2537 Lisp_Object absname;
2538 Lisp_Object handler;
2539
2540 CHECK_STRING (filename);
2541 absname = Fexpand_file_name (filename, Qnil);
2542
2543 /* If the file name has special constructs in it,
2544 call the corresponding file handler. */
2545 handler = Ffind_file_name_handler (absname, Qfile_executable_p);
2546 if (!NILP (handler))
2547 return call2 (handler, Qfile_executable_p, absname);
2548
2549 absname = ENCODE_FILE (absname);
2550
2551 return (check_executable (SDATA (absname)) ? Qt : Qnil);
2552 }
2553
2554 DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0,
2555 doc: /* Return t if file FILENAME exists and you can read it.
2556 See also `file-exists-p' and `file-attributes'. */)
2557 (Lisp_Object filename)
2558 {
2559 Lisp_Object absname;
2560 Lisp_Object handler;
2561 int desc;
2562 int flags;
2563 struct stat statbuf;
2564
2565 CHECK_STRING (filename);
2566 absname = Fexpand_file_name (filename, Qnil);
2567
2568 /* If the file name has special constructs in it,
2569 call the corresponding file handler. */
2570 handler = Ffind_file_name_handler (absname, Qfile_readable_p);
2571 if (!NILP (handler))
2572 return call2 (handler, Qfile_readable_p, absname);
2573
2574 absname = ENCODE_FILE (absname);
2575
2576 #if defined(DOS_NT) || defined(macintosh)
2577 /* Under MS-DOS, Windows, and Macintosh, open does not work for
2578 directories. */
2579 if (access (SDATA (absname), 0) == 0)
2580 return Qt;
2581 return Qnil;
2582 #else /* not DOS_NT and not macintosh */
2583 flags = O_RDONLY;
2584 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2585 /* Opening a fifo without O_NONBLOCK can wait.
2586 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2587 except in the case of a fifo, on a system which handles it. */
2588 desc = stat (SDATA (absname), &statbuf);
2589 if (desc < 0)
2590 return Qnil;
2591 if (S_ISFIFO (statbuf.st_mode))
2592 flags |= O_NONBLOCK;
2593 #endif
2594 desc = emacs_open (SDATA (absname), flags, 0);
2595 if (desc < 0)
2596 return Qnil;
2597 emacs_close (desc);
2598 return Qt;
2599 #endif /* not DOS_NT and not macintosh */
2600 }
2601
2602 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2603 on the RT/PC. */
2604 DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
2605 doc: /* Return t if file FILENAME can be written or created by you. */)
2606 (Lisp_Object filename)
2607 {
2608 Lisp_Object absname, dir, encoded;
2609 Lisp_Object handler;
2610 struct stat statbuf;
2611
2612 CHECK_STRING (filename);
2613 absname = Fexpand_file_name (filename, Qnil);
2614
2615 /* If the file name has special constructs in it,
2616 call the corresponding file handler. */
2617 handler = Ffind_file_name_handler (absname, Qfile_writable_p);
2618 if (!NILP (handler))
2619 return call2 (handler, Qfile_writable_p, absname);
2620
2621 encoded = ENCODE_FILE (absname);
2622 if (stat (SDATA (encoded), &statbuf) >= 0)
2623 return (check_writable (SDATA (encoded))
2624 ? Qt : Qnil);
2625
2626 dir = Ffile_name_directory (absname);
2627 #ifdef MSDOS
2628 if (!NILP (dir))
2629 dir = Fdirectory_file_name (dir);
2630 #endif /* MSDOS */
2631
2632 dir = ENCODE_FILE (dir);
2633 #ifdef WINDOWSNT
2634 /* The read-only attribute of the parent directory doesn't affect
2635 whether a file or directory can be created within it. Some day we
2636 should check ACLs though, which do affect this. */
2637 if (stat (SDATA (dir), &statbuf) < 0)
2638 return Qnil;
2639 return (statbuf.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
2640 #else
2641 return (check_writable (!NILP (dir) ? (char *) SDATA (dir) : "")
2642 ? Qt : Qnil);
2643 #endif
2644 }
2645 \f
2646 DEFUN ("access-file", Faccess_file, Saccess_file, 2, 2, 0,
2647 doc: /* Access file FILENAME, and get an error if that does not work.
2648 The second argument STRING is used in the error message.
2649 If there is no error, returns nil. */)
2650 (Lisp_Object filename, Lisp_Object string)
2651 {
2652 Lisp_Object handler, encoded_filename, absname;
2653 int fd;
2654
2655 CHECK_STRING (filename);
2656 absname = Fexpand_file_name (filename, Qnil);
2657
2658 CHECK_STRING (string);
2659
2660 /* If the file name has special constructs in it,
2661 call the corresponding file handler. */
2662 handler = Ffind_file_name_handler (absname, Qaccess_file);
2663 if (!NILP (handler))
2664 return call3 (handler, Qaccess_file, absname, string);
2665
2666 encoded_filename = ENCODE_FILE (absname);
2667
2668 fd = emacs_open (SDATA (encoded_filename), O_RDONLY, 0);
2669 if (fd < 0)
2670 report_file_error (SDATA (string), Fcons (filename, Qnil));
2671 emacs_close (fd);
2672
2673 return Qnil;
2674 }
2675 \f
2676 DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0,
2677 doc: /* Return non-nil if file FILENAME is the name of a symbolic link.
2678 The value is the link target, as a string.
2679 Otherwise it returns nil.
2680
2681 This function returns t when given the name of a symlink that
2682 points to a nonexistent file. */)
2683 (Lisp_Object filename)
2684 {
2685 Lisp_Object handler;
2686
2687 CHECK_STRING (filename);
2688 filename = Fexpand_file_name (filename, Qnil);
2689
2690 /* If the file name has special constructs in it,
2691 call the corresponding file handler. */
2692 handler = Ffind_file_name_handler (filename, Qfile_symlink_p);
2693 if (!NILP (handler))
2694 return call2 (handler, Qfile_symlink_p, filename);
2695
2696 #ifdef S_IFLNK
2697 {
2698 char *buf;
2699 int bufsize;
2700 int valsize;
2701 Lisp_Object val;
2702
2703 filename = ENCODE_FILE (filename);
2704
2705 bufsize = 50;
2706 buf = NULL;
2707 do
2708 {
2709 bufsize *= 2;
2710 buf = (char *) xrealloc (buf, bufsize);
2711 memset (buf, 0, bufsize);
2712
2713 errno = 0;
2714 valsize = readlink (SDATA (filename), buf, bufsize);
2715 if (valsize == -1)
2716 {
2717 #ifdef ERANGE
2718 /* HP-UX reports ERANGE if buffer is too small. */
2719 if (errno == ERANGE)
2720 valsize = bufsize;
2721 else
2722 #endif
2723 {
2724 xfree (buf);
2725 return Qnil;
2726 }
2727 }
2728 }
2729 while (valsize >= bufsize);
2730
2731 val = make_string (buf, valsize);
2732 if (buf[0] == '/' && strchr (buf, ':'))
2733 val = concat2 (build_string ("/:"), val);
2734 xfree (buf);
2735 val = DECODE_FILE (val);
2736 return val;
2737 }
2738 #else /* not S_IFLNK */
2739 return Qnil;
2740 #endif /* not S_IFLNK */
2741 }
2742
2743 DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0,
2744 doc: /* Return t if FILENAME names an existing directory.
2745 Symbolic links to directories count as directories.
2746 See `file-symlink-p' to distinguish symlinks. */)
2747 (Lisp_Object filename)
2748 {
2749 register Lisp_Object absname;
2750 struct stat st;
2751 Lisp_Object handler;
2752
2753 absname = expand_and_dir_to_file (filename, current_buffer->directory);
2754
2755 /* If the file name has special constructs in it,
2756 call the corresponding file handler. */
2757 handler = Ffind_file_name_handler (absname, Qfile_directory_p);
2758 if (!NILP (handler))
2759 return call2 (handler, Qfile_directory_p, absname);
2760
2761 absname = ENCODE_FILE (absname);
2762
2763 if (stat (SDATA (absname), &st) < 0)
2764 return Qnil;
2765 return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
2766 }
2767
2768 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, Sfile_accessible_directory_p, 1, 1, 0,
2769 doc: /* Return t if file FILENAME names a directory you can open.
2770 For the value to be t, FILENAME must specify the name of a directory as a file,
2771 and the directory must allow you to open files in it. In order to use a
2772 directory as a buffer's current directory, this predicate must return true.
2773 A directory name spec may be given instead; then the value is t
2774 if the directory so specified exists and really is a readable and
2775 searchable directory. */)
2776 (Lisp_Object filename)
2777 {
2778 Lisp_Object handler;
2779 int tem;
2780 struct gcpro gcpro1;
2781
2782 /* If the file name has special constructs in it,
2783 call the corresponding file handler. */
2784 handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p);
2785 if (!NILP (handler))
2786 return call2 (handler, Qfile_accessible_directory_p, filename);
2787
2788 GCPRO1 (filename);
2789 tem = (NILP (Ffile_directory_p (filename))
2790 || NILP (Ffile_executable_p (filename)));
2791 UNGCPRO;
2792 return tem ? Qnil : Qt;
2793 }
2794
2795 DEFUN ("file-regular-p", Ffile_regular_p, Sfile_regular_p, 1, 1, 0,
2796 doc: /* Return t if FILENAME names a regular file.
2797 This is the sort of file that holds an ordinary stream of data bytes.
2798 Symbolic links to regular files count as regular files.
2799 See `file-symlink-p' to distinguish symlinks. */)
2800 (Lisp_Object filename)
2801 {
2802 register Lisp_Object absname;
2803 struct stat st;
2804 Lisp_Object handler;
2805
2806 absname = expand_and_dir_to_file (filename, current_buffer->directory);
2807
2808 /* If the file name has special constructs in it,
2809 call the corresponding file handler. */
2810 handler = Ffind_file_name_handler (absname, Qfile_regular_p);
2811 if (!NILP (handler))
2812 return call2 (handler, Qfile_regular_p, absname);
2813
2814 absname = ENCODE_FILE (absname);
2815
2816 #ifdef WINDOWSNT
2817 {
2818 int result;
2819 Lisp_Object tem = Vw32_get_true_file_attributes;
2820
2821 /* Tell stat to use expensive method to get accurate info. */
2822 Vw32_get_true_file_attributes = Qt;
2823 result = stat (SDATA (absname), &st);
2824 Vw32_get_true_file_attributes = tem;
2825
2826 if (result < 0)
2827 return Qnil;
2828 return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
2829 }
2830 #else
2831 if (stat (SDATA (absname), &st) < 0)
2832 return Qnil;
2833 return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
2834 #endif
2835 }
2836 \f
2837 DEFUN ("file-selinux-context", Ffile_selinux_context,
2838 Sfile_selinux_context, 1, 1, 0,
2839 doc: /* Return SELinux context of file named FILENAME,
2840 as a list ("user", "role", "type", "range"). Return (nil, nil, nil, nil)
2841 if file does not exist, is not accessible, or SELinux is disabled */)
2842 (Lisp_Object filename)
2843 {
2844 Lisp_Object absname;
2845 Lisp_Object values[4];
2846 Lisp_Object handler;
2847 #if HAVE_LIBSELINUX
2848 security_context_t con;
2849 int conlength;
2850 context_t context;
2851 #endif
2852
2853 absname = expand_and_dir_to_file (filename, current_buffer->directory);
2854
2855 /* If the file name has special constructs in it,
2856 call the corresponding file handler. */
2857 handler = Ffind_file_name_handler (absname, Qfile_selinux_context);
2858 if (!NILP (handler))
2859 return call2 (handler, Qfile_selinux_context, absname);
2860
2861 absname = ENCODE_FILE (absname);
2862
2863 values[0] = Qnil;
2864 values[1] = Qnil;
2865 values[2] = Qnil;
2866 values[3] = Qnil;
2867 #if HAVE_LIBSELINUX
2868 if (is_selinux_enabled ())
2869 {
2870 conlength = lgetfilecon (SDATA (absname), &con);
2871 if (conlength > 0)
2872 {
2873 context = context_new (con);
2874 if (context_user_get (context))
2875 values[0] = build_string (context_user_get (context));
2876 if (context_role_get (context))
2877 values[1] = build_string (context_role_get (context));
2878 if (context_type_get (context))
2879 values[2] = build_string (context_type_get (context));
2880 if (context_range_get (context))
2881 values[3] = build_string (context_range_get (context));
2882 context_free (context);
2883 }
2884 if (con)
2885 freecon (con);
2886 }
2887 #endif
2888
2889 return Flist (sizeof(values) / sizeof(values[0]), values);
2890 }
2891 \f
2892 DEFUN ("set-file-selinux-context", Fset_file_selinux_context,
2893 Sset_file_selinux_context, 2, 2, 0,
2894 doc: /* Set SELinux context of file named FILENAME to CONTEXT
2895 as a list ("user", "role", "type", "range"). Has no effect if SELinux
2896 is disabled. */)
2897 (Lisp_Object filename, Lisp_Object context)
2898 {
2899 Lisp_Object absname, encoded_absname;
2900 Lisp_Object handler;
2901 Lisp_Object user = CAR_SAFE (context);
2902 Lisp_Object role = CAR_SAFE (CDR_SAFE (context));
2903 Lisp_Object type = CAR_SAFE (CDR_SAFE (CDR_SAFE (context)));
2904 Lisp_Object range = CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (context))));
2905 #if HAVE_LIBSELINUX
2906 security_context_t con;
2907 int fail, conlength;
2908 context_t parsed_con;
2909 #endif
2910
2911 absname = Fexpand_file_name (filename, current_buffer->directory);
2912
2913 /* If the file name has special constructs in it,
2914 call the corresponding file handler. */
2915 handler = Ffind_file_name_handler (absname, Qset_file_selinux_context);
2916 if (!NILP (handler))
2917 return call3 (handler, Qset_file_selinux_context, absname, context);
2918
2919 encoded_absname = ENCODE_FILE (absname);
2920
2921 #if HAVE_LIBSELINUX
2922 if (is_selinux_enabled ())
2923 {
2924 /* Get current file context. */
2925 conlength = lgetfilecon (SDATA (encoded_absname), &con);
2926 if (conlength > 0)
2927 {
2928 parsed_con = context_new (con);
2929 /* Change the parts defined in the parameter.*/
2930 if (STRINGP (user))
2931 {
2932 if (context_user_set (parsed_con, SDATA (user)))
2933 error ("Doing context_user_set");
2934 }
2935 if (STRINGP (role))
2936 {
2937 if (context_role_set (parsed_con, SDATA (role)))
2938 error ("Doing context_role_set");
2939 }
2940 if (STRINGP (type))
2941 {
2942 if (context_type_set (parsed_con, SDATA (type)))
2943 error ("Doing context_type_set");
2944 }
2945 if (STRINGP (range))
2946 {
2947 if (context_range_set (parsed_con, SDATA (range)))
2948 error ("Doing context_range_set");
2949 }
2950
2951 /* Set the modified context back to the file. */
2952 fail = lsetfilecon (SDATA (encoded_absname), context_str (parsed_con));
2953 if (fail)
2954 report_file_error ("Doing lsetfilecon", Fcons (absname, Qnil));
2955
2956 context_free (parsed_con);
2957 }
2958 else
2959 report_file_error("Doing lgetfilecon", Fcons (absname, Qnil));
2960
2961 if (con)
2962 freecon (con);
2963 }
2964 #endif
2965
2966 return Qnil;
2967 }
2968 \f
2969 DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
2970 doc: /* Return mode bits of file named FILENAME, as an integer.
2971 Return nil, if file does not exist or is not accessible. */)
2972 (Lisp_Object filename)
2973 {
2974 Lisp_Object absname;
2975 struct stat st;
2976 Lisp_Object handler;
2977
2978 absname = expand_and_dir_to_file (filename, current_buffer->directory);
2979
2980 /* If the file name has special constructs in it,
2981 call the corresponding file handler. */
2982 handler = Ffind_file_name_handler (absname, Qfile_modes);
2983 if (!NILP (handler))
2984 return call2 (handler, Qfile_modes, absname);
2985
2986 absname = ENCODE_FILE (absname);
2987
2988 if (stat (SDATA (absname), &st) < 0)
2989 return Qnil;
2990
2991 return make_number (st.st_mode & 07777);
2992 }
2993
2994 DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 2,
2995 "(let ((file (read-file-name \"File: \"))) \
2996 (list file (read-file-modes nil file)))",
2997 doc: /* Set mode bits of file named FILENAME to MODE (an integer).
2998 Only the 12 low bits of MODE are used.
2999
3000 Interactively, mode bits are read by `read-file-modes', which accepts
3001 symbolic notation, like the `chmod' command from GNU Coreutils. */)
3002 (Lisp_Object filename, Lisp_Object mode)
3003 {
3004 Lisp_Object absname, encoded_absname;
3005 Lisp_Object handler;
3006
3007 absname = Fexpand_file_name (filename, current_buffer->directory);
3008 CHECK_NUMBER (mode);
3009
3010 /* If the file name has special constructs in it,
3011 call the corresponding file handler. */
3012 handler = Ffind_file_name_handler (absname, Qset_file_modes);
3013 if (!NILP (handler))
3014 return call3 (handler, Qset_file_modes, absname, mode);
3015
3016 encoded_absname = ENCODE_FILE (absname);
3017
3018 if (chmod (SDATA (encoded_absname), XINT (mode)) < 0)
3019 report_file_error ("Doing chmod", Fcons (absname, Qnil));
3020
3021 return Qnil;
3022 }
3023
3024 DEFUN ("set-default-file-modes", Fset_default_file_modes, Sset_default_file_modes, 1, 1, 0,
3025 doc: /* Set the file permission bits for newly created files.
3026 The argument MODE should be an integer; only the low 9 bits are used.
3027 This setting is inherited by subprocesses. */)
3028 (Lisp_Object mode)
3029 {
3030 CHECK_NUMBER (mode);
3031
3032 umask ((~ XINT (mode)) & 0777);
3033
3034 return Qnil;
3035 }
3036
3037 DEFUN ("default-file-modes", Fdefault_file_modes, Sdefault_file_modes, 0, 0, 0,
3038 doc: /* Return the default file protection for created files.
3039 The value is an integer. */)
3040 (void)
3041 {
3042 int realmask;
3043 Lisp_Object value;
3044
3045 realmask = umask (0);
3046 umask (realmask);
3047
3048 XSETINT (value, (~ realmask) & 0777);
3049 return value;
3050 }
3051 \f
3052 extern int lisp_time_argument (Lisp_Object, time_t *, int *);
3053
3054 DEFUN ("set-file-times", Fset_file_times, Sset_file_times, 1, 2, 0,
3055 doc: /* Set times of file FILENAME to TIME.
3056 Set both access and modification times.
3057 Return t on success, else nil.
3058 Use the current time if TIME is nil. TIME is in the format of
3059 `current-time'. */)
3060 (Lisp_Object filename, Lisp_Object time)
3061 {
3062 Lisp_Object absname, encoded_absname;
3063 Lisp_Object handler;
3064 time_t sec;
3065 int usec;
3066
3067 if (! lisp_time_argument (time, &sec, &usec))
3068 error ("Invalid time specification");
3069
3070 absname = Fexpand_file_name (filename, current_buffer->directory);
3071
3072 /* If the file name has special constructs in it,
3073 call the corresponding file handler. */
3074 handler = Ffind_file_name_handler (absname, Qset_file_times);
3075 if (!NILP (handler))
3076 return call3 (handler, Qset_file_times, absname, time);
3077
3078 encoded_absname = ENCODE_FILE (absname);
3079
3080 {
3081 EMACS_TIME t;
3082
3083 EMACS_SET_SECS (t, sec);
3084 EMACS_SET_USECS (t, usec);
3085
3086 if (set_file_times (SDATA (encoded_absname), t, t))
3087 {
3088 #ifdef DOS_NT
3089 struct stat st;
3090
3091 /* Setting times on a directory always fails. */
3092 if (stat (SDATA (encoded_absname), &st) == 0
3093 && (st.st_mode & S_IFMT) == S_IFDIR)
3094 return Qnil;
3095 #endif
3096 report_file_error ("Setting file times", Fcons (absname, Qnil));
3097 return Qnil;
3098 }
3099 }
3100
3101 return Qt;
3102 }
3103 \f
3104 #ifdef HAVE_SYNC
3105 DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "",
3106 doc: /* Tell Unix to finish all pending disk updates. */)
3107 (void)
3108 {
3109 sync ();
3110 return Qnil;
3111 }
3112
3113 #endif /* HAVE_SYNC */
3114
3115 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, Sfile_newer_than_file_p, 2, 2, 0,
3116 doc: /* Return t if file FILE1 is newer than file FILE2.
3117 If FILE1 does not exist, the answer is nil;
3118 otherwise, if FILE2 does not exist, the answer is t. */)
3119 (Lisp_Object file1, Lisp_Object file2)
3120 {
3121 Lisp_Object absname1, absname2;
3122 struct stat st;
3123 int mtime1;
3124 Lisp_Object handler;
3125 struct gcpro gcpro1, gcpro2;
3126
3127 CHECK_STRING (file1);
3128 CHECK_STRING (file2);
3129
3130 absname1 = Qnil;
3131 GCPRO2 (absname1, file2);
3132 absname1 = expand_and_dir_to_file (file1, current_buffer->directory);
3133 absname2 = expand_and_dir_to_file (file2, current_buffer->directory);
3134 UNGCPRO;
3135
3136 /* If the file name has special constructs in it,
3137 call the corresponding file handler. */
3138 handler = Ffind_file_name_handler (absname1, Qfile_newer_than_file_p);
3139 if (NILP (handler))
3140 handler = Ffind_file_name_handler (absname2, Qfile_newer_than_file_p);
3141 if (!NILP (handler))
3142 return call3 (handler, Qfile_newer_than_file_p, absname1, absname2);
3143
3144 GCPRO2 (absname1, absname2);
3145 absname1 = ENCODE_FILE (absname1);
3146 absname2 = ENCODE_FILE (absname2);
3147 UNGCPRO;
3148
3149 if (stat (SDATA (absname1), &st) < 0)
3150 return Qnil;
3151
3152 mtime1 = st.st_mtime;
3153
3154 if (stat (SDATA (absname2), &st) < 0)
3155 return Qt;
3156
3157 return (mtime1 > st.st_mtime) ? Qt : Qnil;
3158 }
3159 \f
3160 #ifdef DOS_NT
3161 Lisp_Object Qfind_buffer_file_type;
3162 #endif /* DOS_NT */
3163
3164 #ifndef READ_BUF_SIZE
3165 #define READ_BUF_SIZE (64 << 10)
3166 #endif
3167
3168 /* This function is called after Lisp functions to decide a coding
3169 system are called, or when they cause an error. Before they are
3170 called, the current buffer is set unibyte and it contains only a
3171 newly inserted text (thus the buffer was empty before the
3172 insertion).
3173
3174 The functions may set markers, overlays, text properties, or even
3175 alter the buffer contents, change the current buffer.
3176
3177 Here, we reset all those changes by:
3178 o set back the current buffer.
3179 o move all markers and overlays to BEG.
3180 o remove all text properties.
3181 o set back the buffer multibyteness. */
3182
3183 static Lisp_Object
3184 decide_coding_unwind (Lisp_Object unwind_data)
3185 {
3186 Lisp_Object multibyte, undo_list, buffer;
3187
3188 multibyte = XCAR (unwind_data);
3189 unwind_data = XCDR (unwind_data);
3190 undo_list = XCAR (unwind_data);
3191 buffer = XCDR (unwind_data);
3192
3193 if (current_buffer != XBUFFER (buffer))
3194 set_buffer_internal (XBUFFER (buffer));
3195 adjust_markers_for_delete (BEG, BEG_BYTE, Z, Z_BYTE);
3196 adjust_overlays_for_delete (BEG, Z - BEG);
3197 BUF_INTERVALS (current_buffer) = 0;
3198 TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
3199
3200 /* Now we are safe to change the buffer's multibyteness directly. */
3201 current_buffer->enable_multibyte_characters = multibyte;
3202 current_buffer->undo_list = undo_list;
3203
3204 return Qnil;
3205 }
3206
3207
3208 /* Used to pass values from insert-file-contents to read_non_regular. */
3209
3210 static int non_regular_fd;
3211 static EMACS_INT non_regular_inserted;
3212 static EMACS_INT non_regular_nbytes;
3213
3214
3215 /* Read from a non-regular file.
3216 Read non_regular_nbytes bytes max from non_regular_fd.
3217 Non_regular_inserted specifies where to put the read bytes.
3218 Value is the number of bytes read. */
3219
3220 static Lisp_Object
3221 read_non_regular (Lisp_Object ignore)
3222 {
3223 EMACS_INT nbytes;
3224
3225 immediate_quit = 1;
3226 QUIT;
3227 nbytes = emacs_read (non_regular_fd,
3228 BEG_ADDR + PT_BYTE - BEG_BYTE + non_regular_inserted,
3229 non_regular_nbytes);
3230 immediate_quit = 0;
3231 return make_number (nbytes);
3232 }
3233
3234
3235 /* Condition-case handler used when reading from non-regular files
3236 in insert-file-contents. */
3237
3238 static Lisp_Object
3239 read_non_regular_quit (Lisp_Object ignore)
3240 {
3241 return Qnil;
3242 }
3243
3244
3245 DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents,
3246 1, 5, 0,
3247 doc: /* Insert contents of file FILENAME after point.
3248 Returns list of absolute file name and number of characters inserted.
3249 If second argument VISIT is non-nil, the buffer's visited filename and
3250 last save file modtime are set, and it is marked unmodified. If
3251 visiting and the file does not exist, visiting is completed before the
3252 error is signaled.
3253
3254 The optional third and fourth arguments BEG and END specify what portion
3255 of the file to insert. These arguments count bytes in the file, not
3256 characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
3257
3258 If optional fifth argument REPLACE is non-nil, replace the current
3259 buffer contents (in the accessible portion) with the file contents.
3260 This is better than simply deleting and inserting the whole thing
3261 because (1) it preserves some marker positions and (2) it puts less data
3262 in the undo list. When REPLACE is non-nil, the second return value is
3263 the number of characters that replace previous buffer contents.
3264
3265 This function does code conversion according to the value of
3266 `coding-system-for-read' or `file-coding-system-alist', and sets the
3267 variable `last-coding-system-used' to the coding system actually used. */)
3268 (Lisp_Object filename, Lisp_Object visit, Lisp_Object beg, Lisp_Object end, Lisp_Object replace)
3269 {
3270 struct stat st;
3271 register int fd;
3272 EMACS_INT inserted = 0;
3273 int nochange = 0;
3274 register EMACS_INT how_much;
3275 register EMACS_INT unprocessed;
3276 int count = SPECPDL_INDEX ();
3277 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
3278 Lisp_Object handler, val, insval, orig_filename, old_undo;
3279 Lisp_Object p;
3280 EMACS_INT total = 0;
3281 int not_regular = 0;
3282 unsigned char read_buf[READ_BUF_SIZE];
3283 struct coding_system coding;
3284 unsigned char buffer[1 << 14];
3285 int replace_handled = 0;
3286 int set_coding_system = 0;
3287 Lisp_Object coding_system;
3288 int read_quit = 0;
3289 Lisp_Object old_Vdeactivate_mark = Vdeactivate_mark;
3290 int we_locked_file = 0;
3291 int deferred_remove_unwind_protect = 0;
3292
3293 if (current_buffer->base_buffer && ! NILP (visit))
3294 error ("Cannot do file visiting in an indirect buffer");
3295
3296 if (!NILP (current_buffer->read_only))
3297 Fbarf_if_buffer_read_only ();
3298
3299 val = Qnil;
3300 p = Qnil;
3301 orig_filename = Qnil;
3302 old_undo = Qnil;
3303
3304 GCPRO5 (filename, val, p, orig_filename, old_undo);
3305
3306 CHECK_STRING (filename);
3307 filename = Fexpand_file_name (filename, Qnil);
3308
3309 /* The value Qnil means that the coding system is not yet
3310 decided. */
3311 coding_system = Qnil;
3312
3313 /* If the file name has special constructs in it,
3314 call the corresponding file handler. */
3315 handler = Ffind_file_name_handler (filename, Qinsert_file_contents);
3316 if (!NILP (handler))
3317 {
3318 val = call6 (handler, Qinsert_file_contents, filename,
3319 visit, beg, end, replace);
3320 if (CONSP (val) && CONSP (XCDR (val)))
3321 inserted = XINT (XCAR (XCDR (val)));
3322 goto handled;
3323 }
3324
3325 orig_filename = filename;
3326 filename = ENCODE_FILE (filename);
3327
3328 fd = -1;
3329
3330 #ifdef WINDOWSNT
3331 {
3332 Lisp_Object tem = Vw32_get_true_file_attributes;
3333
3334 /* Tell stat to use expensive method to get accurate info. */
3335 Vw32_get_true_file_attributes = Qt;
3336 total = stat (SDATA (filename), &st);
3337 Vw32_get_true_file_attributes = tem;
3338 }
3339 if (total < 0)
3340 #else
3341 if (stat (SDATA (filename), &st) < 0)
3342 #endif /* WINDOWSNT */
3343 {
3344 if (fd >= 0) emacs_close (fd);
3345 badopen:
3346 if (NILP (visit))
3347 report_file_error ("Opening input file", Fcons (orig_filename, Qnil));
3348 st.st_mtime = -1;
3349 how_much = 0;
3350 if (!NILP (Vcoding_system_for_read))
3351 Fset (Qbuffer_file_coding_system, Vcoding_system_for_read);
3352 goto notfound;
3353 }
3354
3355 #ifdef S_IFREG
3356 /* This code will need to be changed in order to work on named
3357 pipes, and it's probably just not worth it. So we should at
3358 least signal an error. */
3359 if (!S_ISREG (st.st_mode))
3360 {
3361 not_regular = 1;
3362
3363 if (! NILP (visit))
3364 goto notfound;
3365
3366 if (! NILP (replace) || ! NILP (beg) || ! NILP (end))
3367 xsignal2 (Qfile_error,
3368 build_string ("not a regular file"), orig_filename);
3369 }
3370 #endif
3371
3372 if (fd < 0)
3373 if ((fd = emacs_open (SDATA (filename), O_RDONLY, 0)) < 0)
3374 goto badopen;
3375
3376 /* Replacement should preserve point as it preserves markers. */
3377 if (!NILP (replace))
3378 record_unwind_protect (restore_point_unwind, Fpoint_marker ());
3379
3380 record_unwind_protect (close_file_unwind, make_number (fd));
3381
3382 /* Can happen on any platform that uses long as type of off_t, but allows
3383 file sizes to exceed 2Gb, so give a suitable message. */
3384 if (! not_regular && st.st_size < 0)
3385 error ("Maximum buffer size exceeded");
3386
3387 /* Prevent redisplay optimizations. */
3388 current_buffer->clip_changed = 1;
3389
3390 if (!NILP (visit))
3391 {
3392 if (!NILP (beg) || !NILP (end))
3393 error ("Attempt to visit less than an entire file");
3394 if (BEG < Z && NILP (replace))
3395 error ("Cannot do file visiting in a non-empty buffer");
3396 }
3397
3398 if (!NILP (beg))
3399 CHECK_NUMBER (beg);
3400 else
3401 XSETFASTINT (beg, 0);
3402
3403 if (!NILP (end))
3404 CHECK_NUMBER (end);
3405 else
3406 {
3407 if (! not_regular)
3408 {
3409 XSETINT (end, st.st_size);
3410
3411 /* Arithmetic overflow can occur if an Emacs integer cannot
3412 represent the file size, or if the calculations below
3413 overflow. The calculations below double the file size
3414 twice, so check that it can be multiplied by 4 safely. */
3415 if (XINT (end) != st.st_size
3416 /* Actually, it should test either INT_MAX or LONG_MAX
3417 depending on which one is used for EMACS_INT. But in
3418 any case, in practice, this test is redundant with the
3419 one above.
3420 || st.st_size > INT_MAX / 4 */)
3421 error ("Maximum buffer size exceeded");
3422
3423 /* The file size returned from stat may be zero, but data
3424 may be readable nonetheless, for example when this is a
3425 file in the /proc filesystem. */
3426 if (st.st_size == 0)
3427 XSETINT (end, READ_BUF_SIZE);
3428 }
3429 }
3430
3431 if (EQ (Vcoding_system_for_read, Qauto_save_coding))
3432 {
3433 coding_system = coding_inherit_eol_type (Qutf_8_emacs, Qunix);
3434 setup_coding_system (coding_system, &coding);
3435 /* Ensure we set Vlast_coding_system_used. */
3436 set_coding_system = 1;
3437 }
3438 else if (BEG < Z)
3439 {
3440 /* Decide the coding system to use for reading the file now
3441 because we can't use an optimized method for handling
3442 `coding:' tag if the current buffer is not empty. */
3443 if (!NILP (Vcoding_system_for_read))
3444 coding_system = Vcoding_system_for_read;
3445 else
3446 {
3447 /* Don't try looking inside a file for a coding system
3448 specification if it is not seekable. */
3449 if (! not_regular && ! NILP (Vset_auto_coding_function))
3450 {
3451 /* Find a coding system specified in the heading two
3452 lines or in the tailing several lines of the file.
3453 We assume that the 1K-byte and 3K-byte for heading
3454 and tailing respectively are sufficient for this
3455 purpose. */
3456 EMACS_INT nread;
3457
3458 if (st.st_size <= (1024 * 4))
3459 nread = emacs_read (fd, read_buf, 1024 * 4);
3460 else
3461 {
3462 nread = emacs_read (fd, read_buf, 1024);
3463 if (nread >= 0)
3464 {
3465 if (lseek (fd, st.st_size - (1024 * 3), 0) < 0)
3466 report_file_error ("Setting file position",
3467 Fcons (orig_filename, Qnil));
3468 nread += emacs_read (fd, read_buf + nread, 1024 * 3);
3469 }
3470 }
3471
3472 if (nread < 0)
3473 error ("IO error reading %s: %s",
3474 SDATA (orig_filename), emacs_strerror (errno));
3475 else if (nread > 0)
3476 {
3477 struct buffer *prev = current_buffer;
3478 Lisp_Object buffer;
3479 struct buffer *buf;
3480
3481 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
3482
3483 buffer = Fget_buffer_create (build_string (" *code-converting-work*"));
3484 buf = XBUFFER (buffer);
3485
3486 delete_all_overlays (buf);
3487 buf->directory = current_buffer->directory;
3488 buf->read_only = Qnil;
3489 buf->filename = Qnil;
3490 buf->undo_list = Qt;
3491 eassert (buf->overlays_before == NULL);
3492 eassert (buf->overlays_after == NULL);
3493
3494 set_buffer_internal (buf);
3495 Ferase_buffer ();
3496 buf->enable_multibyte_characters = Qnil;
3497
3498 insert_1_both (read_buf, nread, nread, 0, 0, 0);
3499 TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
3500 coding_system = call2 (Vset_auto_coding_function,
3501 filename, make_number (nread));
3502 set_buffer_internal (prev);
3503
3504 /* Discard the unwind protect for recovering the
3505 current buffer. */
3506 specpdl_ptr--;
3507
3508 /* Rewind the file for the actual read done later. */
3509 if (lseek (fd, 0, 0) < 0)
3510 report_file_error ("Setting file position",
3511 Fcons (orig_filename, Qnil));
3512 }
3513 }
3514
3515 if (NILP (coding_system))
3516 {
3517 /* If we have not yet decided a coding system, check
3518 file-coding-system-alist. */
3519 Lisp_Object args[6];
3520
3521 args[0] = Qinsert_file_contents, args[1] = orig_filename;
3522 args[2] = visit, args[3] = beg, args[4] = end, args[5] = replace;
3523 coding_system = Ffind_operation_coding_system (6, args);
3524 if (CONSP (coding_system))
3525 coding_system = XCAR (coding_system);
3526 }
3527 }
3528
3529 if (NILP (coding_system))
3530 coding_system = Qundecided;
3531 else
3532 CHECK_CODING_SYSTEM (coding_system);
3533
3534 if (NILP (current_buffer->enable_multibyte_characters))
3535 /* We must suppress all character code conversion except for
3536 end-of-line conversion. */
3537 coding_system = raw_text_coding_system (coding_system);
3538
3539 setup_coding_system (coding_system, &coding);
3540 /* Ensure we set Vlast_coding_system_used. */
3541 set_coding_system = 1;
3542 }
3543
3544 /* If requested, replace the accessible part of the buffer
3545 with the file contents. Avoid replacing text at the
3546 beginning or end of the buffer that matches the file contents;
3547 that preserves markers pointing to the unchanged parts.
3548
3549 Here we implement this feature in an optimized way
3550 for the case where code conversion is NOT needed.
3551 The following if-statement handles the case of conversion
3552 in a less optimal way.
3553
3554 If the code conversion is "automatic" then we try using this
3555 method and hope for the best.
3556 But if we discover the need for conversion, we give up on this method
3557 and let the following if-statement handle the replace job. */
3558 if (!NILP (replace)
3559 && BEGV < ZV
3560 && (NILP (coding_system)
3561 || ! CODING_REQUIRE_DECODING (&coding)))
3562 {
3563 /* same_at_start and same_at_end count bytes,
3564 because file access counts bytes
3565 and BEG and END count bytes. */
3566 EMACS_INT same_at_start = BEGV_BYTE;
3567 EMACS_INT same_at_end = ZV_BYTE;
3568 EMACS_INT overlap;
3569 /* There is still a possibility we will find the need to do code
3570 conversion. If that happens, we set this variable to 1 to
3571 give up on handling REPLACE in the optimized way. */
3572 int giveup_match_end = 0;
3573
3574 if (XINT (beg) != 0)
3575 {
3576 if (lseek (fd, XINT (beg), 0) < 0)
3577 report_file_error ("Setting file position",
3578 Fcons (orig_filename, Qnil));
3579 }
3580
3581 immediate_quit = 1;
3582 QUIT;
3583 /* Count how many chars at the start of the file
3584 match the text at the beginning of the buffer. */
3585 while (1)
3586 {
3587 EMACS_INT nread, bufpos;
3588
3589 nread = emacs_read (fd, buffer, sizeof buffer);
3590 if (nread < 0)
3591 error ("IO error reading %s: %s",
3592 SDATA (orig_filename), emacs_strerror (errno));
3593 else if (nread == 0)
3594 break;
3595
3596 if (CODING_REQUIRE_DETECTION (&coding))
3597 {
3598 coding_system = detect_coding_system (buffer, nread, nread, 1, 0,
3599 coding_system);
3600 setup_coding_system (coding_system, &coding);
3601 }
3602
3603 if (CODING_REQUIRE_DECODING (&coding))
3604 /* We found that the file should be decoded somehow.
3605 Let's give up here. */
3606 {
3607 giveup_match_end = 1;
3608 break;
3609 }
3610
3611 bufpos = 0;
3612 while (bufpos < nread && same_at_start < ZV_BYTE
3613 && FETCH_BYTE (same_at_start) == buffer[bufpos])
3614 same_at_start++, bufpos++;
3615 /* If we found a discrepancy, stop the scan.
3616 Otherwise loop around and scan the next bufferful. */
3617 if (bufpos != nread)
3618 break;
3619 }
3620 immediate_quit = 0;
3621 /* If the file matches the buffer completely,
3622 there's no need to replace anything. */
3623 if (same_at_start - BEGV_BYTE == XINT (end))
3624 {
3625 emacs_close (fd);
3626 specpdl_ptr--;
3627 /* Truncate the buffer to the size of the file. */
3628 del_range_1 (same_at_start, same_at_end, 0, 0);
3629 goto handled;
3630 }
3631 immediate_quit = 1;
3632 QUIT;
3633 /* Count how many chars at the end of the file
3634 match the text at the end of the buffer. But, if we have
3635 already found that decoding is necessary, don't waste time. */
3636 while (!giveup_match_end)
3637 {
3638 EMACS_INT total_read, nread, bufpos, curpos, trial;
3639
3640 /* At what file position are we now scanning? */
3641 curpos = XINT (end) - (ZV_BYTE - same_at_end);
3642 /* If the entire file matches the buffer tail, stop the scan. */
3643 if (curpos == 0)
3644 break;
3645 /* How much can we scan in the next step? */
3646 trial = min (curpos, sizeof buffer);
3647 if (lseek (fd, curpos - trial, 0) < 0)
3648 report_file_error ("Setting file position",
3649 Fcons (orig_filename, Qnil));
3650
3651 total_read = nread = 0;
3652 while (total_read < trial)
3653 {
3654 nread = emacs_read (fd, buffer + total_read, trial - total_read);
3655 if (nread < 0)
3656 error ("IO error reading %s: %s",
3657 SDATA (orig_filename), emacs_strerror (errno));
3658 else if (nread == 0)
3659 break;
3660 total_read += nread;
3661 }
3662
3663 /* Scan this bufferful from the end, comparing with
3664 the Emacs buffer. */
3665 bufpos = total_read;
3666
3667 /* Compare with same_at_start to avoid counting some buffer text
3668 as matching both at the file's beginning and at the end. */
3669 while (bufpos > 0 && same_at_end > same_at_start
3670 && FETCH_BYTE (same_at_end - 1) == buffer[bufpos - 1])
3671 same_at_end--, bufpos--;
3672
3673 /* If we found a discrepancy, stop the scan.
3674 Otherwise loop around and scan the preceding bufferful. */
3675 if (bufpos != 0)
3676 {
3677 /* If this discrepancy is because of code conversion,
3678 we cannot use this method; giveup and try the other. */
3679 if (same_at_end > same_at_start
3680 && FETCH_BYTE (same_at_end - 1) >= 0200
3681 && ! NILP (current_buffer->enable_multibyte_characters)
3682 && (CODING_MAY_REQUIRE_DECODING (&coding)))
3683 giveup_match_end = 1;
3684 break;
3685 }
3686
3687 if (nread == 0)
3688 break;
3689 }
3690 immediate_quit = 0;
3691
3692 if (! giveup_match_end)
3693 {
3694 EMACS_INT temp;
3695
3696 /* We win! We can handle REPLACE the optimized way. */
3697
3698 /* Extend the start of non-matching text area to multibyte
3699 character boundary. */
3700 if (! NILP (current_buffer->enable_multibyte_characters))
3701 while (same_at_start > BEGV_BYTE
3702 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start)))
3703 same_at_start--;
3704
3705 /* Extend the end of non-matching text area to multibyte
3706 character boundary. */
3707 if (! NILP (current_buffer->enable_multibyte_characters))
3708 while (same_at_end < ZV_BYTE
3709 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end)))
3710 same_at_end++;
3711
3712 /* Don't try to reuse the same piece of text twice. */
3713 overlap = (same_at_start - BEGV_BYTE
3714 - (same_at_end + st.st_size - ZV));
3715 if (overlap > 0)
3716 same_at_end += overlap;
3717
3718 /* Arrange to read only the nonmatching middle part of the file. */
3719 XSETFASTINT (beg, XINT (beg) + (same_at_start - BEGV_BYTE));
3720 XSETFASTINT (end, XINT (end) - (ZV_BYTE - same_at_end));
3721
3722 del_range_byte (same_at_start, same_at_end, 0);
3723 /* Insert from the file at the proper position. */
3724 temp = BYTE_TO_CHAR (same_at_start);
3725 SET_PT_BOTH (temp, same_at_start);
3726
3727 /* If display currently starts at beginning of line,
3728 keep it that way. */
3729 if (XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer)
3730 XWINDOW (selected_window)->start_at_line_beg = Fbolp ();
3731
3732 replace_handled = 1;
3733 }
3734 }
3735
3736 /* If requested, replace the accessible part of the buffer
3737 with the file contents. Avoid replacing text at the
3738 beginning or end of the buffer that matches the file contents;
3739 that preserves markers pointing to the unchanged parts.
3740
3741 Here we implement this feature for the case where code conversion
3742 is needed, in a simple way that needs a lot of memory.
3743 The preceding if-statement handles the case of no conversion
3744 in a more optimized way. */
3745 if (!NILP (replace) && ! replace_handled && BEGV < ZV)
3746 {
3747 EMACS_INT same_at_start = BEGV_BYTE;
3748 EMACS_INT same_at_end = ZV_BYTE;
3749 EMACS_INT same_at_start_charpos;
3750 EMACS_INT inserted_chars;
3751 EMACS_INT overlap;
3752 EMACS_INT bufpos;
3753 unsigned char *decoded;
3754 EMACS_INT temp;
3755 int this_count = SPECPDL_INDEX ();
3756 int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
3757 Lisp_Object conversion_buffer;
3758
3759 conversion_buffer = code_conversion_save (1, multibyte);
3760
3761 /* First read the whole file, performing code conversion into
3762 CONVERSION_BUFFER. */
3763
3764 if (lseek (fd, XINT (beg), 0) < 0)
3765 report_file_error ("Setting file position",
3766 Fcons (orig_filename, Qnil));
3767
3768 total = st.st_size; /* Total bytes in the file. */
3769 how_much = 0; /* Bytes read from file so far. */
3770 inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */
3771 unprocessed = 0; /* Bytes not processed in previous loop. */
3772
3773 GCPRO1 (conversion_buffer);
3774 while (how_much < total)
3775 {
3776 /* We read one bunch by one (READ_BUF_SIZE bytes) to allow
3777 quitting while reading a huge while. */
3778 /* try is reserved in some compilers (Microsoft C) */
3779 EMACS_INT trytry = min (total - how_much,
3780 READ_BUF_SIZE - unprocessed);
3781 EMACS_INT this;
3782
3783 /* Allow quitting out of the actual I/O. */
3784 immediate_quit = 1;
3785 QUIT;
3786 this = emacs_read (fd, read_buf + unprocessed, trytry);
3787 immediate_quit = 0;
3788
3789 if (this <= 0)
3790 {
3791 if (this < 0)
3792 how_much = this;
3793 break;
3794 }
3795
3796 how_much += this;
3797
3798 BUF_TEMP_SET_PT (XBUFFER (conversion_buffer),
3799 BUF_Z (XBUFFER (conversion_buffer)));
3800 decode_coding_c_string (&coding, read_buf, unprocessed + this,
3801 conversion_buffer);
3802 unprocessed = coding.carryover_bytes;
3803 if (coding.carryover_bytes > 0)
3804 memcpy (read_buf, coding.carryover, unprocessed);
3805 }
3806 UNGCPRO;
3807 emacs_close (fd);
3808
3809 /* We should remove the unwind_protect calling
3810 close_file_unwind, but other stuff has been added the stack,
3811 so defer the removal till we reach the `handled' label. */
3812 deferred_remove_unwind_protect = 1;
3813
3814 /* At this point, HOW_MUCH should equal TOTAL, or should be <= 0
3815 if we couldn't read the file. */
3816
3817 if (how_much < 0)
3818 error ("IO error reading %s: %s",
3819 SDATA (orig_filename), emacs_strerror (errno));
3820
3821 if (unprocessed > 0)
3822 {
3823 coding.mode |= CODING_MODE_LAST_BLOCK;
3824 decode_coding_c_string (&coding, read_buf, unprocessed,
3825 conversion_buffer);
3826 coding.mode &= ~CODING_MODE_LAST_BLOCK;
3827 }
3828
3829 coding_system = CODING_ID_NAME (coding.id);
3830 set_coding_system = 1;
3831 decoded = BUF_BEG_ADDR (XBUFFER (conversion_buffer));
3832 inserted = (BUF_Z_BYTE (XBUFFER (conversion_buffer))
3833 - BUF_BEG_BYTE (XBUFFER (conversion_buffer)));
3834
3835 /* Compare the beginning of the converted string with the buffer
3836 text. */
3837
3838 bufpos = 0;
3839 while (bufpos < inserted && same_at_start < same_at_end
3840 && FETCH_BYTE (same_at_start) == decoded[bufpos])
3841 same_at_start++, bufpos++;
3842
3843 /* If the file matches the head of buffer completely,
3844 there's no need to replace anything. */
3845
3846 if (bufpos == inserted)
3847 {
3848 /* Truncate the buffer to the size of the file. */
3849 if (same_at_start == same_at_end)
3850 nochange = 1;
3851 else
3852 del_range_byte (same_at_start, same_at_end, 0);
3853 inserted = 0;
3854
3855 unbind_to (this_count, Qnil);
3856 goto handled;
3857 }
3858
3859 /* Extend the start of non-matching text area to the previous
3860 multibyte character boundary. */
3861 if (! NILP (current_buffer->enable_multibyte_characters))
3862 while (same_at_start > BEGV_BYTE
3863 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start)))
3864 same_at_start--;
3865
3866 /* Scan this bufferful from the end, comparing with
3867 the Emacs buffer. */
3868 bufpos = inserted;
3869
3870 /* Compare with same_at_start to avoid counting some buffer text
3871 as matching both at the file's beginning and at the end. */
3872 while (bufpos > 0 && same_at_end > same_at_start
3873 && FETCH_BYTE (same_at_end - 1) == decoded[bufpos - 1])
3874 same_at_end--, bufpos--;
3875
3876 /* Extend the end of non-matching text area to the next
3877 multibyte character boundary. */
3878 if (! NILP (current_buffer->enable_multibyte_characters))
3879 while (same_at_end < ZV_BYTE
3880 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end)))
3881 same_at_end++;
3882
3883 /* Don't try to reuse the same piece of text twice. */
3884 overlap = same_at_start - BEGV_BYTE - (same_at_end + inserted - ZV_BYTE);
3885 if (overlap > 0)
3886 same_at_end += overlap;
3887
3888 /* If display currently starts at beginning of line,
3889 keep it that way. */
3890 if (XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer)
3891 XWINDOW (selected_window)->start_at_line_beg = Fbolp ();
3892
3893 /* Replace the chars that we need to replace,
3894 and update INSERTED to equal the number of bytes
3895 we are taking from the decoded string. */
3896 inserted -= (ZV_BYTE - same_at_end) + (same_at_start - BEGV_BYTE);
3897
3898 if (same_at_end != same_at_start)
3899 {
3900 del_range_byte (same_at_start, same_at_end, 0);
3901 temp = GPT;
3902 same_at_start = GPT_BYTE;
3903 }
3904 else
3905 {
3906 temp = BYTE_TO_CHAR (same_at_start);
3907 }
3908 /* Insert from the file at the proper position. */
3909 SET_PT_BOTH (temp, same_at_start);
3910 same_at_start_charpos
3911 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer),
3912 same_at_start - BEGV_BYTE
3913 + BUF_BEG_BYTE (XBUFFER (conversion_buffer)));
3914 inserted_chars
3915 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer),
3916 same_at_start + inserted - BEGV_BYTE
3917 + BUF_BEG_BYTE (XBUFFER (conversion_buffer)))
3918 - same_at_start_charpos);
3919 /* This binding is to avoid ask-user-about-supersession-threat
3920 being called in insert_from_buffer (via in
3921 prepare_to_modify_buffer). */
3922 specbind (intern ("buffer-file-name"), Qnil);
3923 insert_from_buffer (XBUFFER (conversion_buffer),
3924 same_at_start_charpos, inserted_chars, 0);
3925 /* Set `inserted' to the number of inserted characters. */
3926 inserted = PT - temp;
3927 /* Set point before the inserted characters. */
3928 SET_PT_BOTH (temp, same_at_start);
3929
3930 unbind_to (this_count, Qnil);
3931
3932 goto handled;
3933 }
3934
3935 if (! not_regular)
3936 {
3937 register Lisp_Object temp;
3938
3939 total = XINT (end) - XINT (beg);
3940
3941 /* Make sure point-max won't overflow after this insertion. */
3942 XSETINT (temp, total);
3943 if (total != XINT (temp))
3944 error ("Maximum buffer size exceeded");
3945 }
3946 else
3947 /* For a special file, all we can do is guess. */
3948 total = READ_BUF_SIZE;
3949
3950 if (NILP (visit) && inserted > 0)
3951 {
3952 #ifdef CLASH_DETECTION
3953 if (!NILP (current_buffer->file_truename)
3954 /* Make binding buffer-file-name to nil effective. */
3955 && !NILP (current_buffer->filename)
3956 && SAVE_MODIFF >= MODIFF)
3957 we_locked_file = 1;
3958 #endif /* CLASH_DETECTION */
3959 prepare_to_modify_buffer (GPT, GPT, NULL);
3960 }
3961
3962 move_gap (PT);
3963 if (GAP_SIZE < total)
3964 make_gap (total - GAP_SIZE);
3965
3966 if (XINT (beg) != 0 || !NILP (replace))
3967 {
3968 if (lseek (fd, XINT (beg), 0) < 0)
3969 report_file_error ("Setting file position",
3970 Fcons (orig_filename, Qnil));
3971 }
3972
3973 /* In the following loop, HOW_MUCH contains the total bytes read so
3974 far for a regular file, and not changed for a special file. But,
3975 before exiting the loop, it is set to a negative value if I/O
3976 error occurs. */
3977 how_much = 0;
3978
3979 /* Total bytes inserted. */
3980 inserted = 0;
3981
3982 /* Here, we don't do code conversion in the loop. It is done by
3983 decode_coding_gap after all data are read into the buffer. */
3984 {
3985 EMACS_INT gap_size = GAP_SIZE;
3986
3987 while (how_much < total)
3988 {
3989 /* try is reserved in some compilers (Microsoft C) */
3990 EMACS_INT trytry = min (total - how_much, READ_BUF_SIZE);
3991 EMACS_INT this;
3992
3993 if (not_regular)
3994 {
3995 Lisp_Object val;
3996
3997 /* Maybe make more room. */
3998 if (gap_size < trytry)
3999 {
4000 make_gap (total - gap_size);
4001 gap_size = GAP_SIZE;
4002 }
4003
4004 /* Read from the file, capturing `quit'. When an
4005 error occurs, end the loop, and arrange for a quit
4006 to be signaled after decoding the text we read. */
4007 non_regular_fd = fd;
4008 non_regular_inserted = inserted;
4009 non_regular_nbytes = trytry;
4010 val = internal_condition_case_1 (read_non_regular, Qnil, Qerror,
4011 read_non_regular_quit);
4012 if (NILP (val))
4013 {
4014 read_quit = 1;
4015 break;
4016 }
4017
4018 this = XINT (val);
4019 }
4020 else
4021 {
4022 /* Allow quitting out of the actual I/O. We don't make text
4023 part of the buffer until all the reading is done, so a C-g
4024 here doesn't do any harm. */
4025 immediate_quit = 1;
4026 QUIT;
4027 this = emacs_read (fd, BEG_ADDR + PT_BYTE - BEG_BYTE + inserted, trytry);
4028 immediate_quit = 0;
4029 }
4030
4031 if (this <= 0)
4032 {
4033 how_much = this;
4034 break;
4035 }
4036
4037 gap_size -= this;
4038
4039 /* For a regular file, where TOTAL is the real size,
4040 count HOW_MUCH to compare with it.
4041 For a special file, where TOTAL is just a buffer size,
4042 so don't bother counting in HOW_MUCH.
4043 (INSERTED is where we count the number of characters inserted.) */
4044 if (! not_regular)
4045 how_much += this;
4046 inserted += this;
4047 }
4048 }
4049
4050 /* Now we have read all the file data into the gap.
4051 If it was empty, undo marking the buffer modified. */
4052
4053 if (inserted == 0)
4054 {
4055 #ifdef CLASH_DETECTION
4056 if (we_locked_file)
4057 unlock_file (current_buffer->file_truename);
4058 #endif
4059 Vdeactivate_mark = old_Vdeactivate_mark;
4060 }
4061 else
4062 Vdeactivate_mark = Qt;
4063
4064 /* Make the text read part of the buffer. */
4065 GAP_SIZE -= inserted;
4066 GPT += inserted;
4067 GPT_BYTE += inserted;
4068 ZV += inserted;
4069 ZV_BYTE += inserted;
4070 Z += inserted;
4071 Z_BYTE += inserted;
4072
4073 if (GAP_SIZE > 0)
4074 /* Put an anchor to ensure multi-byte form ends at gap. */
4075 *GPT_ADDR = 0;
4076
4077 emacs_close (fd);
4078
4079 /* Discard the unwind protect for closing the file. */
4080 specpdl_ptr--;
4081
4082 if (how_much < 0)
4083 error ("IO error reading %s: %s",
4084 SDATA (orig_filename), emacs_strerror (errno));
4085
4086 notfound:
4087
4088 if (NILP (coding_system))
4089 {
4090 /* The coding system is not yet decided. Decide it by an
4091 optimized method for handling `coding:' tag.
4092
4093 Note that we can get here only if the buffer was empty
4094 before the insertion. */
4095
4096 if (!NILP (Vcoding_system_for_read))
4097 coding_system = Vcoding_system_for_read;
4098 else
4099 {
4100 /* Since we are sure that the current buffer was empty
4101 before the insertion, we can toggle
4102 enable-multibyte-characters directly here without taking
4103 care of marker adjustment. By this way, we can run Lisp
4104 program safely before decoding the inserted text. */
4105 Lisp_Object unwind_data;
4106 int count = SPECPDL_INDEX ();
4107
4108 unwind_data = Fcons (current_buffer->enable_multibyte_characters,
4109 Fcons (current_buffer->undo_list,
4110 Fcurrent_buffer ()));
4111 current_buffer->enable_multibyte_characters = Qnil;
4112 current_buffer->undo_list = Qt;
4113 record_unwind_protect (decide_coding_unwind, unwind_data);
4114
4115 if (inserted > 0 && ! NILP (Vset_auto_coding_function))
4116 {
4117 coding_system = call2 (Vset_auto_coding_function,
4118 filename, make_number (inserted));
4119 }
4120
4121 if (NILP (coding_system))
4122 {
4123 /* If the coding system is not yet decided, check
4124 file-coding-system-alist. */
4125 Lisp_Object args[6];
4126
4127 args[0] = Qinsert_file_contents, args[1] = orig_filename;
4128 args[2] = visit, args[3] = beg, args[4] = end, args[5] = Qnil;
4129 coding_system = Ffind_operation_coding_system (6, args);
4130 if (CONSP (coding_system))
4131 coding_system = XCAR (coding_system);
4132 }
4133 unbind_to (count, Qnil);
4134 inserted = Z_BYTE - BEG_BYTE;
4135 }
4136
4137 if (NILP (coding_system))
4138 coding_system = Qundecided;
4139 else
4140 CHECK_CODING_SYSTEM (coding_system);
4141
4142 if (NILP (current_buffer->enable_multibyte_characters))
4143 /* We must suppress all character code conversion except for
4144 end-of-line conversion. */
4145 coding_system = raw_text_coding_system (coding_system);
4146 setup_coding_system (coding_system, &coding);
4147 /* Ensure we set Vlast_coding_system_used. */
4148 set_coding_system = 1;
4149 }
4150
4151 if (!NILP (visit))
4152 {
4153 /* When we visit a file by raw-text, we change the buffer to
4154 unibyte. */
4155 if (CODING_FOR_UNIBYTE (&coding)
4156 /* Can't do this if part of the buffer might be preserved. */
4157 && NILP (replace))
4158 /* Visiting a file with these coding system makes the buffer
4159 unibyte. */
4160 current_buffer->enable_multibyte_characters = Qnil;
4161 }
4162
4163 coding.dst_multibyte = ! NILP (current_buffer->enable_multibyte_characters);
4164 if (CODING_MAY_REQUIRE_DECODING (&coding)
4165 && (inserted > 0 || CODING_REQUIRE_FLUSHING (&coding)))
4166 {
4167 move_gap_both (PT, PT_BYTE);
4168 GAP_SIZE += inserted;
4169 ZV_BYTE -= inserted;
4170 Z_BYTE -= inserted;
4171 ZV -= inserted;
4172 Z -= inserted;
4173 decode_coding_gap (&coding, inserted, inserted);
4174 inserted = coding.produced_char;
4175 coding_system = CODING_ID_NAME (coding.id);
4176 }
4177 else if (inserted > 0)
4178 adjust_after_insert (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted,
4179 inserted);
4180
4181 /* Now INSERTED is measured in characters. */
4182
4183 #ifdef DOS_NT
4184 /* Use the conversion type to determine buffer-file-type
4185 (find-buffer-file-type is now used to help determine the
4186 conversion). */
4187 if ((VECTORP (CODING_ID_EOL_TYPE (coding.id))
4188 || EQ (CODING_ID_EOL_TYPE (coding.id), Qunix))
4189 && ! CODING_REQUIRE_DECODING (&coding))
4190 current_buffer->buffer_file_type = Qt;
4191 else
4192 current_buffer->buffer_file_type = Qnil;
4193 #endif
4194
4195 handled:
4196
4197 if (deferred_remove_unwind_protect)
4198 /* If requested above, discard the unwind protect for closing the
4199 file. */
4200 specpdl_ptr--;
4201
4202 if (!NILP (visit))
4203 {
4204 if (!EQ (current_buffer->undo_list, Qt) && !nochange)
4205 current_buffer->undo_list = Qnil;
4206
4207 if (NILP (handler))
4208 {
4209 current_buffer->modtime = st.st_mtime;
4210 current_buffer->modtime_size = st.st_size;
4211 current_buffer->filename = orig_filename;
4212 }
4213
4214 SAVE_MODIFF = MODIFF;
4215 BUF_AUTOSAVE_MODIFF (current_buffer) = MODIFF;
4216 XSETFASTINT (current_buffer->save_length, Z - BEG);
4217 #ifdef CLASH_DETECTION
4218 if (NILP (handler))
4219 {
4220 if (!NILP (current_buffer->file_truename))
4221 unlock_file (current_buffer->file_truename);
4222 unlock_file (filename);
4223 }
4224 #endif /* CLASH_DETECTION */
4225 if (not_regular)
4226 xsignal2 (Qfile_error,
4227 build_string ("not a regular file"), orig_filename);
4228 }
4229
4230 if (set_coding_system)
4231 Vlast_coding_system_used = coding_system;
4232
4233 if (! NILP (Ffboundp (Qafter_insert_file_set_coding)))
4234 {
4235 insval = call2 (Qafter_insert_file_set_coding, make_number (inserted),
4236 visit);
4237 if (! NILP (insval))
4238 {
4239 CHECK_NUMBER (insval);
4240 inserted = XFASTINT (insval);
4241 }
4242 }
4243
4244 /* Decode file format. */
4245 if (inserted > 0)
4246 {
4247 /* Don't run point motion or modification hooks when decoding. */
4248 int count = SPECPDL_INDEX ();
4249 EMACS_INT old_inserted = inserted;
4250 specbind (Qinhibit_point_motion_hooks, Qt);
4251 specbind (Qinhibit_modification_hooks, Qt);
4252
4253 /* Save old undo list and don't record undo for decoding. */
4254 old_undo = current_buffer->undo_list;
4255 current_buffer->undo_list = Qt;
4256
4257 if (NILP (replace))
4258 {
4259 insval = call3 (Qformat_decode,
4260 Qnil, make_number (inserted), visit);
4261 CHECK_NUMBER (insval);
4262 inserted = XFASTINT (insval);
4263 }
4264 else
4265 {
4266 /* If REPLACE is non-nil and we succeeded in not replacing the
4267 beginning or end of the buffer text with the file's contents,
4268 call format-decode with `point' positioned at the beginning
4269 of the buffer and `inserted' equalling the number of
4270 characters in the buffer. Otherwise, format-decode might
4271 fail to correctly analyze the beginning or end of the buffer.
4272 Hence we temporarily save `point' and `inserted' here and
4273 restore `point' iff format-decode did not insert or delete
4274 any text. Otherwise we leave `point' at point-min. */
4275 EMACS_INT opoint = PT;
4276 EMACS_INT opoint_byte = PT_BYTE;
4277 EMACS_INT oinserted = ZV - BEGV;
4278 int ochars_modiff = CHARS_MODIFF;
4279
4280 TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE);
4281 insval = call3 (Qformat_decode,
4282 Qnil, make_number (oinserted), visit);
4283 CHECK_NUMBER (insval);
4284 if (ochars_modiff == CHARS_MODIFF)
4285 /* format_decode didn't modify buffer's characters => move
4286 point back to position before inserted text and leave
4287 value of inserted alone. */
4288 SET_PT_BOTH (opoint, opoint_byte);
4289 else
4290 /* format_decode modified buffer's characters => consider
4291 entire buffer changed and leave point at point-min. */
4292 inserted = XFASTINT (insval);
4293 }
4294
4295 /* For consistency with format-decode call these now iff inserted > 0
4296 (martin 2007-06-28). */
4297 p = Vafter_insert_file_functions;
4298 while (CONSP (p))
4299 {
4300 if (NILP (replace))
4301 {
4302 insval = call1 (XCAR (p), make_number (inserted));
4303 if (!NILP (insval))
4304 {
4305 CHECK_NUMBER (insval);
4306 inserted = XFASTINT (insval);
4307 }
4308 }
4309 else
4310 {
4311 /* For the rationale of this see the comment on
4312 format-decode above. */
4313 EMACS_INT opoint = PT;
4314 EMACS_INT opoint_byte = PT_BYTE;
4315 EMACS_INT oinserted = ZV - BEGV;
4316 int ochars_modiff = CHARS_MODIFF;
4317
4318 TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE);
4319 insval = call1 (XCAR (p), make_number (oinserted));
4320 if (!NILP (insval))
4321 {
4322 CHECK_NUMBER (insval);
4323 if (ochars_modiff == CHARS_MODIFF)
4324 /* after_insert_file_functions didn't modify
4325 buffer's characters => move point back to
4326 position before inserted text and leave value of
4327 inserted alone. */
4328 SET_PT_BOTH (opoint, opoint_byte);
4329 else
4330 /* after_insert_file_functions did modify buffer's
4331 characters => consider entire buffer changed and
4332 leave point at point-min. */
4333 inserted = XFASTINT (insval);
4334 }
4335 }
4336
4337 QUIT;
4338 p = XCDR (p);
4339 }
4340
4341 if (NILP (visit))
4342 {
4343 current_buffer->undo_list = old_undo;
4344 if (CONSP (old_undo) && inserted != old_inserted)
4345 {
4346 /* Adjust the last undo record for the size change during
4347 the format conversion. */
4348 Lisp_Object tem = XCAR (old_undo);
4349 if (CONSP (tem) && INTEGERP (XCAR (tem))
4350 && INTEGERP (XCDR (tem))
4351 && XFASTINT (XCDR (tem)) == PT + old_inserted)
4352 XSETCDR (tem, make_number (PT + inserted));
4353 }
4354 }
4355 else
4356 /* If undo_list was Qt before, keep it that way.
4357 Otherwise start with an empty undo_list. */
4358 current_buffer->undo_list = EQ (old_undo, Qt) ? Qt : Qnil;
4359
4360 unbind_to (count, Qnil);
4361 }
4362
4363 /* Call after-change hooks for the inserted text, aside from the case
4364 of normal visiting (not with REPLACE), which is done in a new buffer
4365 "before" the buffer is changed. */
4366 if (inserted > 0 && total > 0
4367 && (NILP (visit) || !NILP (replace)))
4368 {
4369 signal_after_change (PT, 0, inserted);
4370 update_compositions (PT, PT, CHECK_BORDER);
4371 }
4372
4373 if (!NILP (visit)
4374 && current_buffer->modtime == -1)
4375 {
4376 /* If visiting nonexistent file, return nil. */
4377 report_file_error ("Opening input file", Fcons (orig_filename, Qnil));
4378 }
4379
4380 if (read_quit)
4381 Fsignal (Qquit, Qnil);
4382
4383 /* ??? Retval needs to be dealt with in all cases consistently. */
4384 if (NILP (val))
4385 val = Fcons (orig_filename,
4386 Fcons (make_number (inserted),
4387 Qnil));
4388
4389 RETURN_UNGCPRO (unbind_to (count, val));
4390 }
4391 \f
4392 static Lisp_Object build_annotations (Lisp_Object, Lisp_Object);
4393
4394 static Lisp_Object
4395 build_annotations_unwind (Lisp_Object arg)
4396 {
4397 Vwrite_region_annotation_buffers = arg;
4398 return Qnil;
4399 }
4400
4401 /* Decide the coding-system to encode the data with. */
4402
4403 static Lisp_Object
4404 choose_write_coding_system (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
4405 Lisp_Object append, Lisp_Object visit, Lisp_Object lockname,
4406 struct coding_system *coding)
4407 {
4408 Lisp_Object val;
4409 Lisp_Object eol_parent = Qnil;
4410
4411 if (auto_saving
4412 && NILP (Fstring_equal (current_buffer->filename,
4413 current_buffer->auto_save_file_name)))
4414 {
4415 val = Qutf_8_emacs;
4416 eol_parent = Qunix;
4417 }
4418 else if (!NILP (Vcoding_system_for_write))
4419 {
4420 val = Vcoding_system_for_write;
4421 if (coding_system_require_warning
4422 && !NILP (Ffboundp (Vselect_safe_coding_system_function)))
4423 /* Confirm that VAL can surely encode the current region. */
4424 val = call5 (Vselect_safe_coding_system_function,
4425 start, end, Fcons (Qt, Fcons (val, Qnil)),
4426 Qnil, filename);
4427 }
4428 else
4429 {
4430 /* If the variable `buffer-file-coding-system' is set locally,
4431 it means that the file was read with some kind of code
4432 conversion or the variable is explicitly set by users. We
4433 had better write it out with the same coding system even if
4434 `enable-multibyte-characters' is nil.
4435
4436 If it is not set locally, we anyway have to convert EOL
4437 format if the default value of `buffer-file-coding-system'
4438 tells that it is not Unix-like (LF only) format. */
4439 int using_default_coding = 0;
4440 int force_raw_text = 0;
4441
4442 val = current_buffer->buffer_file_coding_system;
4443 if (NILP (val)
4444 || NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil)))
4445 {
4446 val = Qnil;
4447 if (NILP (current_buffer->enable_multibyte_characters))
4448 force_raw_text = 1;
4449 }
4450
4451 if (NILP (val))
4452 {
4453 /* Check file-coding-system-alist. */
4454 Lisp_Object args[7], coding_systems;
4455
4456 args[0] = Qwrite_region; args[1] = start; args[2] = end;
4457 args[3] = filename; args[4] = append; args[5] = visit;
4458 args[6] = lockname;
4459 coding_systems = Ffind_operation_coding_system (7, args);
4460 if (CONSP (coding_systems) && !NILP (XCDR (coding_systems)))
4461 val = XCDR (coding_systems);
4462 }
4463
4464 if (NILP (val))
4465 {
4466 /* If we still have not decided a coding system, use the
4467 default value of buffer-file-coding-system. */
4468 val = current_buffer->buffer_file_coding_system;
4469 using_default_coding = 1;
4470 }
4471
4472 if (! NILP (val) && ! force_raw_text)
4473 {
4474 Lisp_Object spec, attrs;
4475
4476 CHECK_CODING_SYSTEM_GET_SPEC (val, spec);
4477 attrs = AREF (spec, 0);
4478 if (EQ (CODING_ATTR_TYPE (attrs), Qraw_text))
4479 force_raw_text = 1;
4480 }
4481
4482 if (!force_raw_text
4483 && !NILP (Ffboundp (Vselect_safe_coding_system_function)))
4484 /* Confirm that VAL can surely encode the current region. */
4485 val = call5 (Vselect_safe_coding_system_function,
4486 start, end, val, Qnil, filename);
4487
4488 /* If the decided coding-system doesn't specify end-of-line
4489 format, we use that of
4490 `default-buffer-file-coding-system'. */
4491 if (! using_default_coding
4492 && ! NILP (buffer_defaults.buffer_file_coding_system))
4493 val = (coding_inherit_eol_type
4494 (val, buffer_defaults.buffer_file_coding_system));
4495
4496 /* If we decide not to encode text, use `raw-text' or one of its
4497 subsidiaries. */
4498 if (force_raw_text)
4499 val = raw_text_coding_system (val);
4500 }
4501
4502 val = coding_inherit_eol_type (val, eol_parent);
4503 setup_coding_system (val, coding);
4504
4505 if (!STRINGP (start) && !NILP (current_buffer->selective_display))
4506 coding->mode |= CODING_MODE_SELECTIVE_DISPLAY;
4507 return val;
4508 }
4509
4510 DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 7,
4511 "r\nFWrite region to file: \ni\ni\ni\np",
4512 doc: /* Write current region into specified file.
4513 When called from a program, requires three arguments:
4514 START, END and FILENAME. START and END are normally buffer positions
4515 specifying the part of the buffer to write.
4516 If START is nil, that means to use the entire buffer contents.
4517 If START is a string, then output that string to the file
4518 instead of any buffer contents; END is ignored.
4519
4520 Optional fourth argument APPEND if non-nil means
4521 append to existing file contents (if any). If it is an integer,
4522 seek to that offset in the file before writing.
4523 Optional fifth argument VISIT, if t or a string, means
4524 set the last-save-file-modtime of buffer to this file's modtime
4525 and mark buffer not modified.
4526 If VISIT is a string, it is a second file name;
4527 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4528 VISIT is also the file name to lock and unlock for clash detection.
4529 If VISIT is neither t nor nil nor a string,
4530 that means do not display the \"Wrote file\" message.
4531 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4532 use for locking and unlocking, overriding FILENAME and VISIT.
4533 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4534 for an existing file with the same name. If MUSTBENEW is `excl',
4535 that means to get an error if the file already exists; never overwrite.
4536 If MUSTBENEW is neither nil nor `excl', that means ask for
4537 confirmation before overwriting, but do go ahead and overwrite the file
4538 if the user confirms.
4539
4540 This does code conversion according to the value of
4541 `coding-system-for-write', `buffer-file-coding-system', or
4542 `file-coding-system-alist', and sets the variable
4543 `last-coding-system-used' to the coding system actually used.
4544
4545 This calls `write-region-annotate-functions' at the start, and
4546 `write-region-post-annotation-function' at the end. */)
4547 (Lisp_Object start, Lisp_Object end, Lisp_Object filename, Lisp_Object append, Lisp_Object visit, Lisp_Object lockname, Lisp_Object mustbenew)
4548 {
4549 register int desc;
4550 int failure;
4551 int save_errno = 0;
4552 const unsigned char *fn;
4553 struct stat st;
4554 int count = SPECPDL_INDEX ();
4555 int count1;
4556 Lisp_Object handler;
4557 Lisp_Object visit_file;
4558 Lisp_Object annotations;
4559 Lisp_Object encoded_filename;
4560 int visiting = (EQ (visit, Qt) || STRINGP (visit));
4561 int quietly = !NILP (visit);
4562 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
4563 struct buffer *given_buffer;
4564 #ifdef DOS_NT
4565 int buffer_file_type = O_BINARY;
4566 #endif /* DOS_NT */
4567 struct coding_system coding;
4568
4569 if (current_buffer->base_buffer && visiting)
4570 error ("Cannot do file visiting in an indirect buffer");
4571
4572 if (!NILP (start) && !STRINGP (start))
4573 validate_region (&start, &end);
4574
4575 visit_file = Qnil;
4576 GCPRO5 (start, filename, visit, visit_file, lockname);
4577
4578 filename = Fexpand_file_name (filename, Qnil);
4579
4580 if (!NILP (mustbenew) && !EQ (mustbenew, Qexcl))
4581 barf_or_query_if_file_exists (filename, "overwrite", 1, 0, 1);
4582
4583 if (STRINGP (visit))
4584 visit_file = Fexpand_file_name (visit, Qnil);
4585 else
4586 visit_file = filename;
4587
4588 if (NILP (lockname))
4589 lockname = visit_file;
4590
4591 annotations = Qnil;
4592
4593 /* If the file name has special constructs in it,
4594 call the corresponding file handler. */
4595 handler = Ffind_file_name_handler (filename, Qwrite_region);
4596 /* If FILENAME has no handler, see if VISIT has one. */
4597 if (NILP (handler) && STRINGP (visit))
4598 handler = Ffind_file_name_handler (visit, Qwrite_region);
4599
4600 if (!NILP (handler))
4601 {
4602 Lisp_Object val;
4603 val = call6 (handler, Qwrite_region, start, end,
4604 filename, append, visit);
4605
4606 if (visiting)
4607 {
4608 SAVE_MODIFF = MODIFF;
4609 XSETFASTINT (current_buffer->save_length, Z - BEG);
4610 current_buffer->filename = visit_file;
4611 }
4612 UNGCPRO;
4613 return val;
4614 }
4615
4616 record_unwind_protect (save_restriction_restore, save_restriction_save ());
4617
4618 /* Special kludge to simplify auto-saving. */
4619 if (NILP (start))
4620 {
4621 /* Do it later, so write-region-annotate-function can work differently
4622 if we save "the buffer" vs "a region".
4623 This is useful in tar-mode. --Stef
4624 XSETFASTINT (start, BEG);
4625 XSETFASTINT (end, Z); */
4626 Fwiden ();
4627 }
4628
4629 record_unwind_protect (build_annotations_unwind,
4630 Vwrite_region_annotation_buffers);
4631 Vwrite_region_annotation_buffers = Fcons (Fcurrent_buffer (), Qnil);
4632 count1 = SPECPDL_INDEX ();
4633
4634 given_buffer = current_buffer;
4635
4636 if (!STRINGP (start))
4637 {
4638 annotations = build_annotations (start, end);
4639
4640 if (current_buffer != given_buffer)
4641 {
4642 XSETFASTINT (start, BEGV);
4643 XSETFASTINT (end, ZV);
4644 }
4645 }
4646
4647 if (NILP (start))
4648 {
4649 XSETFASTINT (start, BEGV);
4650 XSETFASTINT (end, ZV);
4651 }
4652
4653 UNGCPRO;
4654
4655 GCPRO5 (start, filename, annotations, visit_file, lockname);
4656
4657 /* Decide the coding-system to encode the data with.
4658 We used to make this choice before calling build_annotations, but that
4659 leads to problems when a write-annotate-function takes care of
4660 unsavable chars (as was the case with X-Symbol). */
4661 Vlast_coding_system_used
4662 = choose_write_coding_system (start, end, filename,
4663 append, visit, lockname, &coding);
4664
4665 #ifdef CLASH_DETECTION
4666 if (!auto_saving)
4667 lock_file (lockname);
4668 #endif /* CLASH_DETECTION */
4669
4670 encoded_filename = ENCODE_FILE (filename);
4671
4672 fn = SDATA (encoded_filename);
4673 desc = -1;
4674 if (!NILP (append))
4675 #ifdef DOS_NT
4676 desc = emacs_open (fn, O_WRONLY | buffer_file_type, 0);
4677 #else /* not DOS_NT */
4678 desc = emacs_open (fn, O_WRONLY, 0);
4679 #endif /* not DOS_NT */
4680
4681 if (desc < 0 && (NILP (append) || errno == ENOENT))
4682 #ifdef DOS_NT
4683 desc = emacs_open (fn,
4684 O_WRONLY | O_CREAT | buffer_file_type
4685 | (EQ (mustbenew, Qexcl) ? O_EXCL : O_TRUNC),
4686 S_IREAD | S_IWRITE);
4687 #else /* not DOS_NT */
4688 desc = emacs_open (fn, O_WRONLY | O_TRUNC | O_CREAT
4689 | (EQ (mustbenew, Qexcl) ? O_EXCL : 0),
4690 auto_saving ? auto_save_mode_bits : 0666);
4691 #endif /* not DOS_NT */
4692
4693 if (desc < 0)
4694 {
4695 #ifdef CLASH_DETECTION
4696 save_errno = errno;
4697 if (!auto_saving) unlock_file (lockname);
4698 errno = save_errno;
4699 #endif /* CLASH_DETECTION */
4700 UNGCPRO;
4701 report_file_error ("Opening output file", Fcons (filename, Qnil));
4702 }
4703
4704 record_unwind_protect (close_file_unwind, make_number (desc));
4705
4706 if (!NILP (append) && !NILP (Ffile_regular_p (filename)))
4707 {
4708 long ret;
4709
4710 if (NUMBERP (append))
4711 ret = lseek (desc, XINT (append), 1);
4712 else
4713 ret = lseek (desc, 0, 2);
4714 if (ret < 0)
4715 {
4716 #ifdef CLASH_DETECTION
4717 if (!auto_saving) unlock_file (lockname);
4718 #endif /* CLASH_DETECTION */
4719 UNGCPRO;
4720 report_file_error ("Lseek error", Fcons (filename, Qnil));
4721 }
4722 }
4723
4724 UNGCPRO;
4725
4726 failure = 0;
4727 immediate_quit = 1;
4728
4729 if (STRINGP (start))
4730 {
4731 failure = 0 > a_write (desc, start, 0, SCHARS (start),
4732 &annotations, &coding);
4733 save_errno = errno;
4734 }
4735 else if (XINT (start) != XINT (end))
4736 {
4737 failure = 0 > a_write (desc, Qnil,
4738 XINT (start), XINT (end) - XINT (start),
4739 &annotations, &coding);
4740 save_errno = errno;
4741 }
4742 else
4743 {
4744 /* If file was empty, still need to write the annotations */
4745 coding.mode |= CODING_MODE_LAST_BLOCK;
4746 failure = 0 > a_write (desc, Qnil, XINT (end), 0, &annotations, &coding);
4747 save_errno = errno;
4748 }
4749
4750 if (CODING_REQUIRE_FLUSHING (&coding)
4751 && !(coding.mode & CODING_MODE_LAST_BLOCK)
4752 && ! failure)
4753 {
4754 /* We have to flush out a data. */
4755 coding.mode |= CODING_MODE_LAST_BLOCK;
4756 failure = 0 > e_write (desc, Qnil, 1, 1, &coding);
4757 save_errno = errno;
4758 }
4759
4760 immediate_quit = 0;
4761
4762 #ifdef HAVE_FSYNC
4763 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4764 Disk full in NFS may be reported here. */
4765 /* mib says that closing the file will try to write as fast as NFS can do
4766 it, and that means the fsync here is not crucial for autosave files. */
4767 if (!auto_saving && !write_region_inhibit_fsync && fsync (desc) < 0)
4768 {
4769 /* If fsync fails with EINTR, don't treat that as serious. Also
4770 ignore EINVAL which happens when fsync is not supported on this
4771 file. */
4772 if (errno != EINTR && errno != EINVAL)
4773 failure = 1, save_errno = errno;
4774 }
4775 #endif
4776
4777 /* NFS can report a write failure now. */
4778 if (emacs_close (desc) < 0)
4779 failure = 1, save_errno = errno;
4780
4781 stat (fn, &st);
4782
4783 /* Discard the unwind protect for close_file_unwind. */
4784 specpdl_ptr = specpdl + count1;
4785
4786 /* Call write-region-post-annotation-function. */
4787 while (CONSP (Vwrite_region_annotation_buffers))
4788 {
4789 Lisp_Object buf = XCAR (Vwrite_region_annotation_buffers);
4790 if (!NILP (Fbuffer_live_p (buf)))
4791 {
4792 Fset_buffer (buf);
4793 if (FUNCTIONP (Vwrite_region_post_annotation_function))
4794 call0 (Vwrite_region_post_annotation_function);
4795 }
4796 Vwrite_region_annotation_buffers
4797 = XCDR (Vwrite_region_annotation_buffers);
4798 }
4799
4800 unbind_to (count, Qnil);
4801
4802 #ifdef CLASH_DETECTION
4803 if (!auto_saving)
4804 unlock_file (lockname);
4805 #endif /* CLASH_DETECTION */
4806
4807 /* Do this before reporting IO error
4808 to avoid a "file has changed on disk" warning on
4809 next attempt to save. */
4810 if (visiting)
4811 {
4812 current_buffer->modtime = st.st_mtime;
4813 current_buffer->modtime_size = st.st_size;
4814 }
4815
4816 if (failure)
4817 error ("IO error writing %s: %s", SDATA (filename),
4818 emacs_strerror (save_errno));
4819
4820 if (visiting)
4821 {
4822 SAVE_MODIFF = MODIFF;
4823 XSETFASTINT (current_buffer->save_length, Z - BEG);
4824 current_buffer->filename = visit_file;
4825 update_mode_lines++;
4826 }
4827 else if (quietly)
4828 {
4829 if (auto_saving
4830 && ! NILP (Fstring_equal (current_buffer->filename,
4831 current_buffer->auto_save_file_name)))
4832 SAVE_MODIFF = MODIFF;
4833
4834 return Qnil;
4835 }
4836
4837 if (!auto_saving)
4838 message_with_string ((INTEGERP (append)
4839 ? "Updated %s"
4840 : ! NILP (append)
4841 ? "Added to %s"
4842 : "Wrote %s"),
4843 visit_file, 1);
4844
4845 return Qnil;
4846 }
4847 \f
4848 Lisp_Object merge (Lisp_Object, Lisp_Object, Lisp_Object);
4849
4850 DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0,
4851 doc: /* Return t if (car A) is numerically less than (car B). */)
4852 (Lisp_Object a, Lisp_Object b)
4853 {
4854 return Flss (Fcar (a), Fcar (b));
4855 }
4856
4857 /* Build the complete list of annotations appropriate for writing out
4858 the text between START and END, by calling all the functions in
4859 write-region-annotate-functions and merging the lists they return.
4860 If one of these functions switches to a different buffer, we assume
4861 that buffer contains altered text. Therefore, the caller must
4862 make sure to restore the current buffer in all cases,
4863 as save-excursion would do. */
4864
4865 static Lisp_Object
4866 build_annotations (Lisp_Object start, Lisp_Object end)
4867 {
4868 Lisp_Object annotations;
4869 Lisp_Object p, res;
4870 struct gcpro gcpro1, gcpro2;
4871 Lisp_Object original_buffer;
4872 int i, used_global = 0;
4873
4874 XSETBUFFER (original_buffer, current_buffer);
4875
4876 annotations = Qnil;
4877 p = Vwrite_region_annotate_functions;
4878 GCPRO2 (annotations, p);
4879 while (CONSP (p))
4880 {
4881 struct buffer *given_buffer = current_buffer;
4882 if (EQ (Qt, XCAR (p)) && !used_global)
4883 { /* Use the global value of the hook. */
4884 Lisp_Object arg[2];
4885 used_global = 1;
4886 arg[0] = Fdefault_value (Qwrite_region_annotate_functions);
4887 arg[1] = XCDR (p);
4888 p = Fappend (2, arg);
4889 continue;
4890 }
4891 Vwrite_region_annotations_so_far = annotations;
4892 res = call2 (XCAR (p), start, end);
4893 /* If the function makes a different buffer current,
4894 assume that means this buffer contains altered text to be output.
4895 Reset START and END from the buffer bounds
4896 and discard all previous annotations because they should have
4897 been dealt with by this function. */
4898 if (current_buffer != given_buffer)
4899 {
4900 Vwrite_region_annotation_buffers
4901 = Fcons (Fcurrent_buffer (),
4902 Vwrite_region_annotation_buffers);
4903 XSETFASTINT (start, BEGV);
4904 XSETFASTINT (end, ZV);
4905 annotations = Qnil;
4906 }
4907 Flength (res); /* Check basic validity of return value */
4908 annotations = merge (annotations, res, Qcar_less_than_car);
4909 p = XCDR (p);
4910 }
4911
4912 /* Now do the same for annotation functions implied by the file-format */
4913 if (auto_saving && (!EQ (current_buffer->auto_save_file_format, Qt)))
4914 p = current_buffer->auto_save_file_format;
4915 else
4916 p = current_buffer->file_format;
4917 for (i = 0; CONSP (p); p = XCDR (p), ++i)
4918 {
4919 struct buffer *given_buffer = current_buffer;
4920
4921 Vwrite_region_annotations_so_far = annotations;
4922
4923 /* Value is either a list of annotations or nil if the function
4924 has written annotations to a temporary buffer, which is now
4925 current. */
4926 res = call5 (Qformat_annotate_function, XCAR (p), start, end,
4927 original_buffer, make_number (i));
4928 if (current_buffer != given_buffer)
4929 {
4930 XSETFASTINT (start, BEGV);
4931 XSETFASTINT (end, ZV);
4932 annotations = Qnil;
4933 }
4934
4935 if (CONSP (res))
4936 annotations = merge (annotations, res, Qcar_less_than_car);
4937 }
4938
4939 UNGCPRO;
4940 return annotations;
4941 }
4942
4943 \f
4944 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
4945 If STRING is nil, POS is the character position in the current buffer.
4946 Intersperse with them the annotations from *ANNOT
4947 which fall within the range of POS to POS + NCHARS,
4948 each at its appropriate position.
4949
4950 We modify *ANNOT by discarding elements as we use them up.
4951
4952 The return value is negative in case of system call failure. */
4953
4954 static int
4955 a_write (int desc, Lisp_Object string, int pos, register int nchars, Lisp_Object *annot, struct coding_system *coding)
4956 {
4957 Lisp_Object tem;
4958 int nextpos;
4959 int lastpos = pos + nchars;
4960
4961 while (NILP (*annot) || CONSP (*annot))
4962 {
4963 tem = Fcar_safe (Fcar (*annot));
4964 nextpos = pos - 1;
4965 if (INTEGERP (tem))
4966 nextpos = XFASTINT (tem);
4967
4968 /* If there are no more annotations in this range,
4969 output the rest of the range all at once. */
4970 if (! (nextpos >= pos && nextpos <= lastpos))
4971 return e_write (desc, string, pos, lastpos, coding);
4972
4973 /* Output buffer text up to the next annotation's position. */
4974 if (nextpos > pos)
4975 {
4976 if (0 > e_write (desc, string, pos, nextpos, coding))
4977 return -1;
4978 pos = nextpos;
4979 }
4980 /* Output the annotation. */
4981 tem = Fcdr (Fcar (*annot));
4982 if (STRINGP (tem))
4983 {
4984 if (0 > e_write (desc, tem, 0, SCHARS (tem), coding))
4985 return -1;
4986 }
4987 *annot = Fcdr (*annot);
4988 }
4989 return 0;
4990 }
4991
4992
4993 /* Write text in the range START and END into descriptor DESC,
4994 encoding them with coding system CODING. If STRING is nil, START
4995 and END are character positions of the current buffer, else they
4996 are indexes to the string STRING. */
4997
4998 static int
4999 e_write (int desc, Lisp_Object string, int start, int end, struct coding_system *coding)
5000 {
5001 if (STRINGP (string))
5002 {
5003 start = 0;
5004 end = SCHARS (string);
5005 }
5006
5007 /* We used to have a code for handling selective display here. But,
5008 now it is handled within encode_coding. */
5009
5010 while (start < end)
5011 {
5012 if (STRINGP (string))
5013 {
5014 coding->src_multibyte = SCHARS (string) < SBYTES (string);
5015 if (CODING_REQUIRE_ENCODING (coding))
5016 {
5017 encode_coding_object (coding, string,
5018 start, string_char_to_byte (string, start),
5019 end, string_char_to_byte (string, end), Qt);
5020 }
5021 else
5022 {
5023 coding->dst_object = string;
5024 coding->consumed_char = SCHARS (string);
5025 coding->produced = SBYTES (string);
5026 }
5027 }
5028 else
5029 {
5030 int start_byte = CHAR_TO_BYTE (start);
5031 int end_byte = CHAR_TO_BYTE (end);
5032
5033 coding->src_multibyte = (end - start) < (end_byte - start_byte);
5034 if (CODING_REQUIRE_ENCODING (coding))
5035 {
5036 encode_coding_object (coding, Fcurrent_buffer (),
5037 start, start_byte, end, end_byte, Qt);
5038 }
5039 else
5040 {
5041 coding->dst_object = Qnil;
5042 coding->dst_pos_byte = start_byte;
5043 if (start >= GPT || end <= GPT)
5044 {
5045 coding->consumed_char = end - start;
5046 coding->produced = end_byte - start_byte;
5047 }
5048 else
5049 {
5050 coding->consumed_char = GPT - start;
5051 coding->produced = GPT_BYTE - start_byte;
5052 }
5053 }
5054 }
5055
5056 if (coding->produced > 0)
5057 {
5058 coding->produced -=
5059 emacs_write (desc,
5060 STRINGP (coding->dst_object)
5061 ? SDATA (coding->dst_object)
5062 : BYTE_POS_ADDR (coding->dst_pos_byte),
5063 coding->produced);
5064
5065 if (coding->produced)
5066 return -1;
5067 }
5068 start += coding->consumed_char;
5069 }
5070
5071 return 0;
5072 }
5073 \f
5074 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime,
5075 Sverify_visited_file_modtime, 1, 1, 0,
5076 doc: /* Return t if last mod time of BUF's visited file matches what BUF records.
5077 This means that the file has not been changed since it was visited or saved.
5078 See Info node `(elisp)Modification Time' for more details. */)
5079 (Lisp_Object buf)
5080 {
5081 struct buffer *b;
5082 struct stat st;
5083 Lisp_Object handler;
5084 Lisp_Object filename;
5085
5086 CHECK_BUFFER (buf);
5087 b = XBUFFER (buf);
5088
5089 if (!STRINGP (b->filename)) return Qt;
5090 if (b->modtime == 0) return Qt;
5091
5092 /* If the file name has special constructs in it,
5093 call the corresponding file handler. */
5094 handler = Ffind_file_name_handler (b->filename,
5095 Qverify_visited_file_modtime);
5096 if (!NILP (handler))
5097 return call2 (handler, Qverify_visited_file_modtime, buf);
5098
5099 filename = ENCODE_FILE (b->filename);
5100
5101 if (stat (SDATA (filename), &st) < 0)
5102 {
5103 /* If the file doesn't exist now and didn't exist before,
5104 we say that it isn't modified, provided the error is a tame one. */
5105 if (errno == ENOENT || errno == EACCES || errno == ENOTDIR)
5106 st.st_mtime = -1;
5107 else
5108 st.st_mtime = 0;
5109 }
5110 if ((st.st_mtime == b->modtime
5111 /* If both are positive, accept them if they are off by one second. */
5112 || (st.st_mtime > 0 && b->modtime > 0
5113 && (st.st_mtime == b->modtime + 1
5114 || st.st_mtime == b->modtime - 1)))
5115 && (st.st_size == b->modtime_size
5116 || b->modtime_size < 0))
5117 return Qt;
5118 return Qnil;
5119 }
5120
5121 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime,
5122 Sclear_visited_file_modtime, 0, 0, 0,
5123 doc: /* Clear out records of last mod time of visited file.
5124 Next attempt to save will certainly not complain of a discrepancy. */)
5125 (void)
5126 {
5127 current_buffer->modtime = 0;
5128 current_buffer->modtime_size = -1;
5129 return Qnil;
5130 }
5131
5132 DEFUN ("visited-file-modtime", Fvisited_file_modtime,
5133 Svisited_file_modtime, 0, 0, 0,
5134 doc: /* Return the current buffer's recorded visited file modification time.
5135 The value is a list of the form (HIGH LOW), like the time values
5136 that `file-attributes' returns. If the current buffer has no recorded
5137 file modification time, this function returns 0.
5138 See Info node `(elisp)Modification Time' for more details. */)
5139 (void)
5140 {
5141 if (! current_buffer->modtime)
5142 return make_number (0);
5143 return make_time ((time_t) current_buffer->modtime);
5144 }
5145
5146 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime,
5147 Sset_visited_file_modtime, 0, 1, 0,
5148 doc: /* Update buffer's recorded modification time from the visited file's time.
5149 Useful if the buffer was not read from the file normally
5150 or if the file itself has been changed for some known benign reason.
5151 An argument specifies the modification time value to use
5152 \(instead of that of the visited file), in the form of a list
5153 \(HIGH . LOW) or (HIGH LOW). */)
5154 (Lisp_Object time_list)
5155 {
5156 if (!NILP (time_list))
5157 {
5158 current_buffer->modtime = cons_to_long (time_list);
5159 current_buffer->modtime_size = -1;
5160 }
5161 else
5162 {
5163 register Lisp_Object filename;
5164 struct stat st;
5165 Lisp_Object handler;
5166
5167 filename = Fexpand_file_name (current_buffer->filename, Qnil);
5168
5169 /* If the file name has special constructs in it,
5170 call the corresponding file handler. */
5171 handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime);
5172 if (!NILP (handler))
5173 /* The handler can find the file name the same way we did. */
5174 return call2 (handler, Qset_visited_file_modtime, Qnil);
5175
5176 filename = ENCODE_FILE (filename);
5177
5178 if (stat (SDATA (filename), &st) >= 0)
5179 {
5180 current_buffer->modtime = st.st_mtime;
5181 current_buffer->modtime_size = st.st_size;
5182 }
5183 }
5184
5185 return Qnil;
5186 }
5187 \f
5188 Lisp_Object
5189 auto_save_error (Lisp_Object error)
5190 {
5191 Lisp_Object args[3], msg;
5192 int i, nbytes;
5193 struct gcpro gcpro1;
5194 char *msgbuf;
5195 USE_SAFE_ALLOCA;
5196
5197 auto_save_error_occurred = 1;
5198
5199 ring_bell (XFRAME (selected_frame));
5200
5201 args[0] = build_string ("Auto-saving %s: %s");
5202 args[1] = current_buffer->name;
5203 args[2] = Ferror_message_string (error);
5204 msg = Fformat (3, args);
5205 GCPRO1 (msg);
5206 nbytes = SBYTES (msg);
5207 SAFE_ALLOCA (msgbuf, char *, nbytes);
5208 memcpy (msgbuf, SDATA (msg), nbytes);
5209
5210 for (i = 0; i < 3; ++i)
5211 {
5212 if (i == 0)
5213 message2 (msgbuf, nbytes, STRING_MULTIBYTE (msg));
5214 else
5215 message2_nolog (msgbuf, nbytes, STRING_MULTIBYTE (msg));
5216 Fsleep_for (make_number (1), Qnil);
5217 }
5218
5219 SAFE_FREE ();
5220 UNGCPRO;
5221 return Qnil;
5222 }
5223
5224 Lisp_Object
5225 auto_save_1 (void)
5226 {
5227 struct stat st;
5228 Lisp_Object modes;
5229
5230 auto_save_mode_bits = 0666;
5231
5232 /* Get visited file's mode to become the auto save file's mode. */
5233 if (! NILP (current_buffer->filename))
5234 {
5235 if (stat (SDATA (current_buffer->filename), &st) >= 0)
5236 /* But make sure we can overwrite it later! */
5237 auto_save_mode_bits = st.st_mode | 0600;
5238 else if ((modes = Ffile_modes (current_buffer->filename),
5239 INTEGERP (modes)))
5240 /* Remote files don't cooperate with stat. */
5241 auto_save_mode_bits = XINT (modes) | 0600;
5242 }
5243
5244 return
5245 Fwrite_region (Qnil, Qnil, current_buffer->auto_save_file_name, Qnil,
5246 NILP (Vauto_save_visited_file_name) ? Qlambda : Qt,
5247 Qnil, Qnil);
5248 }
5249
5250 static Lisp_Object
5251 do_auto_save_unwind (Lisp_Object arg) /* used as unwind-protect function */
5252
5253 {
5254 FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer;
5255 auto_saving = 0;
5256 if (stream != NULL)
5257 {
5258 BLOCK_INPUT;
5259 fclose (stream);
5260 UNBLOCK_INPUT;
5261 }
5262 return Qnil;
5263 }
5264
5265 static Lisp_Object
5266 do_auto_save_unwind_1 (Lisp_Object value) /* used as unwind-protect function */
5267
5268 {
5269 minibuffer_auto_raise = XINT (value);
5270 return Qnil;
5271 }
5272
5273 static Lisp_Object
5274 do_auto_save_make_dir (Lisp_Object dir)
5275 {
5276 Lisp_Object mode;
5277
5278 call2 (Qmake_directory, dir, Qt);
5279 XSETFASTINT (mode, 0700);
5280 return Fset_file_modes (dir, mode);
5281 }
5282
5283 static Lisp_Object
5284 do_auto_save_eh (Lisp_Object ignore)
5285 {
5286 return Qnil;
5287 }
5288
5289 DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "",
5290 doc: /* Auto-save all buffers that need it.
5291 This is all buffers that have auto-saving enabled
5292 and are changed since last auto-saved.
5293 Auto-saving writes the buffer into a file
5294 so that your editing is not lost if the system crashes.
5295 This file is not the file you visited; that changes only when you save.
5296 Normally we run the normal hook `auto-save-hook' before saving.
5297
5298 A non-nil NO-MESSAGE argument means do not print any message if successful.
5299 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5300 (Lisp_Object no_message, Lisp_Object current_only)
5301 {
5302 struct buffer *old = current_buffer, *b;
5303 Lisp_Object tail, buf;
5304 int auto_saved = 0;
5305 int do_handled_files;
5306 Lisp_Object oquit;
5307 FILE *stream = NULL;
5308 int count = SPECPDL_INDEX ();
5309 int orig_minibuffer_auto_raise = minibuffer_auto_raise;
5310 int old_message_p = 0;
5311 struct gcpro gcpro1, gcpro2;
5312
5313 if (max_specpdl_size < specpdl_size + 40)
5314 max_specpdl_size = specpdl_size + 40;
5315
5316 if (minibuf_level)
5317 no_message = Qt;
5318
5319 if (NILP (no_message))
5320 {
5321 old_message_p = push_message ();
5322 record_unwind_protect (pop_message_unwind, Qnil);
5323 }
5324
5325 /* Ordinarily don't quit within this function,
5326 but don't make it impossible to quit (in case we get hung in I/O). */
5327 oquit = Vquit_flag;
5328 Vquit_flag = Qnil;
5329
5330 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5331 point to non-strings reached from Vbuffer_alist. */
5332
5333 if (!NILP (Vrun_hooks))
5334 call1 (Vrun_hooks, intern ("auto-save-hook"));
5335
5336 if (STRINGP (Vauto_save_list_file_name))
5337 {
5338 Lisp_Object listfile;
5339
5340 listfile = Fexpand_file_name (Vauto_save_list_file_name, Qnil);
5341
5342 /* Don't try to create the directory when shutting down Emacs,
5343 because creating the directory might signal an error, and
5344 that would leave Emacs in a strange state. */
5345 if (!NILP (Vrun_hooks))
5346 {
5347 Lisp_Object dir;
5348 dir = Qnil;
5349 GCPRO2 (dir, listfile);
5350 dir = Ffile_name_directory (listfile);
5351 if (NILP (Ffile_directory_p (dir)))
5352 internal_condition_case_1 (do_auto_save_make_dir,
5353 dir, Fcons (Fcons (Qfile_error, Qnil), Qnil),
5354 do_auto_save_eh);
5355 UNGCPRO;
5356 }
5357
5358 stream = fopen (SDATA (listfile), "w");
5359 }
5360
5361 record_unwind_protect (do_auto_save_unwind,
5362 make_save_value (stream, 0));
5363 record_unwind_protect (do_auto_save_unwind_1,
5364 make_number (minibuffer_auto_raise));
5365 minibuffer_auto_raise = 0;
5366 auto_saving = 1;
5367 auto_save_error_occurred = 0;
5368
5369 /* On first pass, save all files that don't have handlers.
5370 On second pass, save all files that do have handlers.
5371
5372 If Emacs is crashing, the handlers may tweak what is causing
5373 Emacs to crash in the first place, and it would be a shame if
5374 Emacs failed to autosave perfectly ordinary files because it
5375 couldn't handle some ange-ftp'd file. */
5376
5377 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
5378 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
5379 {
5380 buf = XCDR (XCAR (tail));
5381 b = XBUFFER (buf);
5382
5383 /* Record all the buffers that have auto save mode
5384 in the special file that lists them. For each of these buffers,
5385 Record visited name (if any) and auto save name. */
5386 if (STRINGP (b->auto_save_file_name)
5387 && stream != NULL && do_handled_files == 0)
5388 {
5389 BLOCK_INPUT;
5390 if (!NILP (b->filename))
5391 {
5392 fwrite (SDATA (b->filename), 1,
5393 SBYTES (b->filename), stream);
5394 }
5395 putc ('\n', stream);
5396 fwrite (SDATA (b->auto_save_file_name), 1,
5397 SBYTES (b->auto_save_file_name), stream);
5398 putc ('\n', stream);
5399 UNBLOCK_INPUT;
5400 }
5401
5402 if (!NILP (current_only)
5403 && b != current_buffer)
5404 continue;
5405
5406 /* Don't auto-save indirect buffers.
5407 The base buffer takes care of it. */
5408 if (b->base_buffer)
5409 continue;
5410
5411 /* Check for auto save enabled
5412 and file changed since last auto save
5413 and file changed since last real save. */
5414 if (STRINGP (b->auto_save_file_name)
5415 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
5416 && BUF_AUTOSAVE_MODIFF (b) < BUF_MODIFF (b)
5417 /* -1 means we've turned off autosaving for a while--see below. */
5418 && XINT (b->save_length) >= 0
5419 && (do_handled_files
5420 || NILP (Ffind_file_name_handler (b->auto_save_file_name,
5421 Qwrite_region))))
5422 {
5423 EMACS_TIME before_time, after_time;
5424
5425 EMACS_GET_TIME (before_time);
5426
5427 /* If we had a failure, don't try again for 20 minutes. */
5428 if (b->auto_save_failure_time >= 0
5429 && EMACS_SECS (before_time) - b->auto_save_failure_time < 1200)
5430 continue;
5431
5432 set_buffer_internal (b);
5433 if (NILP (Vauto_save_include_big_deletions)
5434 && (XFASTINT (b->save_length) * 10
5435 > (BUF_Z (b) - BUF_BEG (b)) * 13)
5436 /* A short file is likely to change a large fraction;
5437 spare the user annoying messages. */
5438 && XFASTINT (b->save_length) > 5000
5439 /* These messages are frequent and annoying for `*mail*'. */
5440 && !EQ (b->filename, Qnil)
5441 && NILP (no_message))
5442 {
5443 /* It has shrunk too much; turn off auto-saving here. */
5444 minibuffer_auto_raise = orig_minibuffer_auto_raise;
5445 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5446 b->name, 1);
5447 minibuffer_auto_raise = 0;
5448 /* Turn off auto-saving until there's a real save,
5449 and prevent any more warnings. */
5450 XSETINT (b->save_length, -1);
5451 Fsleep_for (make_number (1), Qnil);
5452 continue;
5453 }
5454 if (!auto_saved && NILP (no_message))
5455 message1 ("Auto-saving...");
5456 internal_condition_case (auto_save_1, Qt, auto_save_error);
5457 auto_saved++;
5458 BUF_AUTOSAVE_MODIFF (b) = BUF_MODIFF (b);
5459 XSETFASTINT (current_buffer->save_length, Z - BEG);
5460 set_buffer_internal (old);
5461
5462 EMACS_GET_TIME (after_time);
5463
5464 /* If auto-save took more than 60 seconds,
5465 assume it was an NFS failure that got a timeout. */
5466 if (EMACS_SECS (after_time) - EMACS_SECS (before_time) > 60)
5467 b->auto_save_failure_time = EMACS_SECS (after_time);
5468 }
5469 }
5470
5471 /* Prevent another auto save till enough input events come in. */
5472 record_auto_save ();
5473
5474 if (auto_saved && NILP (no_message))
5475 {
5476 if (old_message_p)
5477 {
5478 /* If we are going to restore an old message,
5479 give time to read ours. */
5480 sit_for (make_number (1), 0, 0);
5481 restore_message ();
5482 }
5483 else if (!auto_save_error_occurred)
5484 /* Don't overwrite the error message if an error occurred.
5485 If we displayed a message and then restored a state
5486 with no message, leave a "done" message on the screen. */
5487 message1 ("Auto-saving...done");
5488 }
5489
5490 Vquit_flag = oquit;
5491
5492 /* This restores the message-stack status. */
5493 unbind_to (count, Qnil);
5494 return Qnil;
5495 }
5496
5497 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved,
5498 Sset_buffer_auto_saved, 0, 0, 0,
5499 doc: /* Mark current buffer as auto-saved with its current text.
5500 No auto-save file will be written until the buffer changes again. */)
5501 (void)
5502 {
5503 /* FIXME: This should not be called in indirect buffers, since
5504 they're not autosaved. */
5505 BUF_AUTOSAVE_MODIFF (current_buffer) = MODIFF;
5506 XSETFASTINT (current_buffer->save_length, Z - BEG);
5507 current_buffer->auto_save_failure_time = -1;
5508 return Qnil;
5509 }
5510
5511 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure,
5512 Sclear_buffer_auto_save_failure, 0, 0, 0,
5513 doc: /* Clear any record of a recent auto-save failure in the current buffer. */)
5514 (void)
5515 {
5516 current_buffer->auto_save_failure_time = -1;
5517 return Qnil;
5518 }
5519
5520 DEFUN ("recent-auto-save-p", Frecent_auto_save_p, Srecent_auto_save_p,
5521 0, 0, 0,
5522 doc: /* Return t if current buffer has been auto-saved recently.
5523 More precisely, if it has been auto-saved since last read from or saved
5524 in the visited file. If the buffer has no visited file,
5525 then any auto-save counts as "recent". */)
5526 (void)
5527 {
5528 /* FIXME: maybe we should return nil for indirect buffers since
5529 they're never autosaved. */
5530 return (SAVE_MODIFF < BUF_AUTOSAVE_MODIFF (current_buffer) ? Qt : Qnil);
5531 }
5532 \f
5533 /* Reading and completing file names */
5534
5535 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p,
5536 Snext_read_file_uses_dialog_p, 0, 0, 0,
5537 doc: /* Return t if a call to `read-file-name' will use a dialog.
5538 The return value is only relevant for a call to `read-file-name' that happens
5539 before any other event (mouse or keypress) is handled. */)
5540 (void)
5541 {
5542 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
5543 if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
5544 && use_dialog_box
5545 && use_file_dialog
5546 && have_menus_p ())
5547 return Qt;
5548 #endif
5549 return Qnil;
5550 }
5551
5552 Lisp_Object
5553 Fread_file_name (Lisp_Object prompt, Lisp_Object dir, Lisp_Object default_filename, Lisp_Object mustmatch, Lisp_Object initial, Lisp_Object predicate)
5554 {
5555 struct gcpro gcpro1, gcpro2;
5556 Lisp_Object args[7];
5557
5558 GCPRO1 (default_filename);
5559 args[0] = intern ("read-file-name");
5560 args[1] = prompt;
5561 args[2] = dir;
5562 args[3] = default_filename;
5563 args[4] = mustmatch;
5564 args[5] = initial;
5565 args[6] = predicate;
5566 RETURN_UNGCPRO (Ffuncall (7, args));
5567 }
5568
5569 \f
5570 void
5571 syms_of_fileio (void)
5572 {
5573 Qoperations = intern_c_string ("operations");
5574 Qexpand_file_name = intern_c_string ("expand-file-name");
5575 Qsubstitute_in_file_name = intern_c_string ("substitute-in-file-name");
5576 Qdirectory_file_name = intern_c_string ("directory-file-name");
5577 Qfile_name_directory = intern_c_string ("file-name-directory");
5578 Qfile_name_nondirectory = intern_c_string ("file-name-nondirectory");
5579 Qunhandled_file_name_directory = intern_c_string ("unhandled-file-name-directory");
5580 Qfile_name_as_directory = intern_c_string ("file-name-as-directory");
5581 Qcopy_file = intern_c_string ("copy-file");
5582 Qmake_directory_internal = intern_c_string ("make-directory-internal");
5583 Qmake_directory = intern_c_string ("make-directory");
5584 Qdelete_directory_internal = intern_c_string ("delete-directory-internal");
5585 Qdelete_file = intern_c_string ("delete-file");
5586 Qrename_file = intern_c_string ("rename-file");
5587 Qadd_name_to_file = intern_c_string ("add-name-to-file");
5588 Qmake_symbolic_link = intern_c_string ("make-symbolic-link");
5589 Qfile_exists_p = intern_c_string ("file-exists-p");
5590 Qfile_executable_p = intern_c_string ("file-executable-p");
5591 Qfile_readable_p = intern_c_string ("file-readable-p");
5592 Qfile_writable_p = intern_c_string ("file-writable-p");
5593 Qfile_symlink_p = intern_c_string ("file-symlink-p");
5594 Qaccess_file = intern_c_string ("access-file");
5595 Qfile_directory_p = intern_c_string ("file-directory-p");
5596 Qfile_regular_p = intern_c_string ("file-regular-p");
5597 Qfile_accessible_directory_p = intern_c_string ("file-accessible-directory-p");
5598 Qfile_modes = intern_c_string ("file-modes");
5599 Qset_file_modes = intern_c_string ("set-file-modes");
5600 Qset_file_times = intern_c_string ("set-file-times");
5601 Qfile_selinux_context = intern_c_string("file-selinux-context");
5602 Qset_file_selinux_context = intern_c_string("set-file-selinux-context");
5603 Qfile_newer_than_file_p = intern_c_string ("file-newer-than-file-p");
5604 Qinsert_file_contents = intern_c_string ("insert-file-contents");
5605 Qwrite_region = intern_c_string ("write-region");
5606 Qverify_visited_file_modtime = intern_c_string ("verify-visited-file-modtime");
5607 Qset_visited_file_modtime = intern_c_string ("set-visited-file-modtime");
5608 Qauto_save_coding = intern_c_string ("auto-save-coding");
5609
5610 staticpro (&Qoperations);
5611 staticpro (&Qexpand_file_name);
5612 staticpro (&Qsubstitute_in_file_name);
5613 staticpro (&Qdirectory_file_name);
5614 staticpro (&Qfile_name_directory);
5615 staticpro (&Qfile_name_nondirectory);
5616 staticpro (&Qunhandled_file_name_directory);
5617 staticpro (&Qfile_name_as_directory);
5618 staticpro (&Qcopy_file);
5619 staticpro (&Qmake_directory_internal);
5620 staticpro (&Qmake_directory);
5621 staticpro (&Qdelete_directory_internal);
5622 staticpro (&Qdelete_file);
5623 staticpro (&Qrename_file);
5624 staticpro (&Qadd_name_to_file);
5625 staticpro (&Qmake_symbolic_link);
5626 staticpro (&Qfile_exists_p);
5627 staticpro (&Qfile_executable_p);
5628 staticpro (&Qfile_readable_p);
5629 staticpro (&Qfile_writable_p);
5630 staticpro (&Qaccess_file);
5631 staticpro (&Qfile_symlink_p);
5632 staticpro (&Qfile_directory_p);
5633 staticpro (&Qfile_regular_p);
5634 staticpro (&Qfile_accessible_directory_p);
5635 staticpro (&Qfile_modes);
5636 staticpro (&Qset_file_modes);
5637 staticpro (&Qset_file_times);
5638 staticpro (&Qfile_selinux_context);
5639 staticpro (&Qset_file_selinux_context);
5640 staticpro (&Qfile_newer_than_file_p);
5641 staticpro (&Qinsert_file_contents);
5642 staticpro (&Qwrite_region);
5643 staticpro (&Qverify_visited_file_modtime);
5644 staticpro (&Qset_visited_file_modtime);
5645 staticpro (&Qauto_save_coding);
5646
5647 Qfile_name_history = intern_c_string ("file-name-history");
5648 Fset (Qfile_name_history, Qnil);
5649 staticpro (&Qfile_name_history);
5650
5651 Qfile_error = intern_c_string ("file-error");
5652 staticpro (&Qfile_error);
5653 Qfile_already_exists = intern_c_string ("file-already-exists");
5654 staticpro (&Qfile_already_exists);
5655 Qfile_date_error = intern_c_string ("file-date-error");
5656 staticpro (&Qfile_date_error);
5657 Qexcl = intern_c_string ("excl");
5658 staticpro (&Qexcl);
5659
5660 #ifdef DOS_NT
5661 Qfind_buffer_file_type = intern_c_string ("find-buffer-file-type");
5662 staticpro (&Qfind_buffer_file_type);
5663 #endif /* DOS_NT */
5664
5665 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system,
5666 doc: /* *Coding system for encoding file names.
5667 If it is nil, `default-file-name-coding-system' (which see) is used. */);
5668 Vfile_name_coding_system = Qnil;
5669
5670 DEFVAR_LISP ("default-file-name-coding-system",
5671 &Vdefault_file_name_coding_system,
5672 doc: /* Default coding system for encoding file names.
5673 This variable is used only when `file-name-coding-system' is nil.
5674
5675 This variable is set/changed by the command `set-language-environment'.
5676 User should not set this variable manually,
5677 instead use `file-name-coding-system' to get a constant encoding
5678 of file names regardless of the current language environment. */);
5679 Vdefault_file_name_coding_system = Qnil;
5680
5681 Qformat_decode = intern_c_string ("format-decode");
5682 staticpro (&Qformat_decode);
5683 Qformat_annotate_function = intern_c_string ("format-annotate-function");
5684 staticpro (&Qformat_annotate_function);
5685 Qafter_insert_file_set_coding = intern_c_string ("after-insert-file-set-coding");
5686 staticpro (&Qafter_insert_file_set_coding);
5687
5688 Qcar_less_than_car = intern_c_string ("car-less-than-car");
5689 staticpro (&Qcar_less_than_car);
5690
5691 Fput (Qfile_error, Qerror_conditions,
5692 Fpurecopy (list2 (Qfile_error, Qerror)));
5693 Fput (Qfile_error, Qerror_message,
5694 make_pure_c_string ("File error"));
5695
5696 Fput (Qfile_already_exists, Qerror_conditions,
5697 Fpurecopy (list3 (Qfile_already_exists, Qfile_error, Qerror)));
5698 Fput (Qfile_already_exists, Qerror_message,
5699 make_pure_c_string ("File already exists"));
5700
5701 Fput (Qfile_date_error, Qerror_conditions,
5702 Fpurecopy (list3 (Qfile_date_error, Qfile_error, Qerror)));
5703 Fput (Qfile_date_error, Qerror_message,
5704 make_pure_c_string ("Cannot set file date"));
5705
5706 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist,
5707 doc: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially.
5708 If a file name matches REGEXP, then all I/O on that file is done by calling
5709 HANDLER.
5710
5711 The first argument given to HANDLER is the name of the I/O primitive
5712 to be handled; the remaining arguments are the arguments that were
5713 passed to that primitive. For example, if you do
5714 (file-exists-p FILENAME)
5715 and FILENAME is handled by HANDLER, then HANDLER is called like this:
5716 (funcall HANDLER 'file-exists-p FILENAME)
5717 The function `find-file-name-handler' checks this list for a handler
5718 for its argument. */);
5719 Vfile_name_handler_alist = Qnil;
5720
5721 DEFVAR_LISP ("set-auto-coding-function",
5722 &Vset_auto_coding_function,
5723 doc: /* If non-nil, a function to call to decide a coding system of file.
5724 Two arguments are passed to this function: the file name
5725 and the length of a file contents following the point.
5726 This function should return a coding system to decode the file contents.
5727 It should check the file name against `auto-coding-alist'.
5728 If no coding system is decided, it should check a coding system
5729 specified in the heading lines with the format:
5730 -*- ... coding: CODING-SYSTEM; ... -*-
5731 or local variable spec of the tailing lines with `coding:' tag. */);
5732 Vset_auto_coding_function = Qnil;
5733
5734 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions,
5735 doc: /* A list of functions to be called at the end of `insert-file-contents'.
5736 Each is passed one argument, the number of characters inserted,
5737 with point at the start of the inserted text. Each function
5738 should leave point the same, and return the new character count.
5739 If `insert-file-contents' is intercepted by a handler from
5740 `file-name-handler-alist', that handler is responsible for calling the
5741 functions in `after-insert-file-functions' if appropriate. */);
5742 Vafter_insert_file_functions = Qnil;
5743
5744 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions,
5745 doc: /* A list of functions to be called at the start of `write-region'.
5746 Each is passed two arguments, START and END as for `write-region'.
5747 These are usually two numbers but not always; see the documentation
5748 for `write-region'. The function should return a list of pairs
5749 of the form (POSITION . STRING), consisting of strings to be effectively
5750 inserted at the specified positions of the file being written (1 means to
5751 insert before the first byte written). The POSITIONs must be sorted into
5752 increasing order.
5753
5754 If there are several annotation functions, the lists returned by these
5755 functions are merged destructively. As each annotation function runs,
5756 the variable `write-region-annotations-so-far' contains a list of all
5757 annotations returned by previous annotation functions.
5758
5759 An annotation function can return with a different buffer current.
5760 Doing so removes the annotations returned by previous functions, and
5761 resets START and END to `point-min' and `point-max' of the new buffer.
5762
5763 After `write-region' completes, Emacs calls the function stored in
5764 `write-region-post-annotation-function', once for each buffer that was
5765 current when building the annotations (i.e., at least once), with that
5766 buffer current. */);
5767 Vwrite_region_annotate_functions = Qnil;
5768 staticpro (&Qwrite_region_annotate_functions);
5769 Qwrite_region_annotate_functions
5770 = intern_c_string ("write-region-annotate-functions");
5771
5772 DEFVAR_LISP ("write-region-post-annotation-function",
5773 &Vwrite_region_post_annotation_function,
5774 doc: /* Function to call after `write-region' completes.
5775 The function is called with no arguments. If one or more of the
5776 annotation functions in `write-region-annotate-functions' changed the
5777 current buffer, the function stored in this variable is called for
5778 each of those additional buffers as well, in addition to the original
5779 buffer. The relevant buffer is current during each function call. */);
5780 Vwrite_region_post_annotation_function = Qnil;
5781 staticpro (&Vwrite_region_annotation_buffers);
5782
5783 DEFVAR_LISP ("write-region-annotations-so-far",
5784 &Vwrite_region_annotations_so_far,
5785 doc: /* When an annotation function is called, this holds the previous annotations.
5786 These are the annotations made by other annotation functions
5787 that were already called. See also `write-region-annotate-functions'. */);
5788 Vwrite_region_annotations_so_far = Qnil;
5789
5790 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers,
5791 doc: /* A list of file name handlers that temporarily should not be used.
5792 This applies only to the operation `inhibit-file-name-operation'. */);
5793 Vinhibit_file_name_handlers = Qnil;
5794
5795 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation,
5796 doc: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
5797 Vinhibit_file_name_operation = Qnil;
5798
5799 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name,
5800 doc: /* File name in which we write a list of all auto save file names.
5801 This variable is initialized automatically from `auto-save-list-file-prefix'
5802 shortly after Emacs reads your `.emacs' file, if you have not yet given it
5803 a non-nil value. */);
5804 Vauto_save_list_file_name = Qnil;
5805
5806 DEFVAR_LISP ("auto-save-visited-file-name", &Vauto_save_visited_file_name,
5807 doc: /* Non-nil says auto-save a buffer in the file it is visiting, when practical.
5808 Normally auto-save files are written under other names. */);
5809 Vauto_save_visited_file_name = Qnil;
5810
5811 DEFVAR_LISP ("auto-save-include-big-deletions", &Vauto_save_include_big_deletions,
5812 doc: /* If non-nil, auto-save even if a large part of the text is deleted.
5813 If nil, deleting a substantial portion of the text disables auto-save
5814 in the buffer; this is the default behavior, because the auto-save
5815 file is usually more useful if it contains the deleted text. */);
5816 Vauto_save_include_big_deletions = Qnil;
5817
5818 #ifdef HAVE_FSYNC
5819 DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync,
5820 doc: /* *Non-nil means don't call fsync in `write-region'.
5821 This variable affects calls to `write-region' as well as save commands.
5822 A non-nil value may result in data loss! */);
5823 write_region_inhibit_fsync = 0;
5824 #endif
5825
5826 DEFVAR_BOOL ("delete-by-moving-to-trash", &delete_by_moving_to_trash,
5827 doc: /* Specifies whether to use the system's trash can.
5828 When non-nil, certain file deletion commands use the function
5829 `move-file-to-trash' instead of deleting files outright.
5830 This includes interactive calls to `delete-file' and
5831 `delete-directory' and the Dired deletion commands. */);
5832 delete_by_moving_to_trash = 0;
5833 Qdelete_by_moving_to_trash = intern_c_string ("delete-by-moving-to-trash");
5834 Qmove_file_to_trash = intern_c_string ("move-file-to-trash");
5835 staticpro (&Qmove_file_to_trash);
5836 Qcopy_directory = intern_c_string ("copy-directory");
5837 staticpro (&Qcopy_directory);
5838 Qdelete_directory = intern_c_string ("delete-directory");
5839 staticpro (&Qdelete_directory);
5840
5841 defsubr (&Sfind_file_name_handler);
5842 defsubr (&Sfile_name_directory);
5843 defsubr (&Sfile_name_nondirectory);
5844 defsubr (&Sunhandled_file_name_directory);
5845 defsubr (&Sfile_name_as_directory);
5846 defsubr (&Sdirectory_file_name);
5847 defsubr (&Smake_temp_name);
5848 defsubr (&Sexpand_file_name);
5849 defsubr (&Ssubstitute_in_file_name);
5850 defsubr (&Scopy_file);
5851 defsubr (&Smake_directory_internal);
5852 defsubr (&Sdelete_directory_internal);
5853 defsubr (&Sdelete_file);
5854 defsubr (&Srename_file);
5855 defsubr (&Sadd_name_to_file);
5856 defsubr (&Smake_symbolic_link);
5857 defsubr (&Sfile_name_absolute_p);
5858 defsubr (&Sfile_exists_p);
5859 defsubr (&Sfile_executable_p);
5860 defsubr (&Sfile_readable_p);
5861 defsubr (&Sfile_writable_p);
5862 defsubr (&Saccess_file);
5863 defsubr (&Sfile_symlink_p);
5864 defsubr (&Sfile_directory_p);
5865 defsubr (&Sfile_accessible_directory_p);
5866 defsubr (&Sfile_regular_p);
5867 defsubr (&Sfile_modes);
5868 defsubr (&Sset_file_modes);
5869 defsubr (&Sset_file_times);
5870 defsubr (&Sfile_selinux_context);
5871 defsubr (&Sset_file_selinux_context);
5872 defsubr (&Sset_default_file_modes);
5873 defsubr (&Sdefault_file_modes);
5874 defsubr (&Sfile_newer_than_file_p);
5875 defsubr (&Sinsert_file_contents);
5876 defsubr (&Swrite_region);
5877 defsubr (&Scar_less_than_car);
5878 defsubr (&Sverify_visited_file_modtime);
5879 defsubr (&Sclear_visited_file_modtime);
5880 defsubr (&Svisited_file_modtime);
5881 defsubr (&Sset_visited_file_modtime);
5882 defsubr (&Sdo_auto_save);
5883 defsubr (&Sset_buffer_auto_saved);
5884 defsubr (&Sclear_buffer_auto_save_failure);
5885 defsubr (&Srecent_auto_save_p);
5886
5887 defsubr (&Snext_read_file_uses_dialog_p);
5888
5889 #ifdef HAVE_SYNC
5890 defsubr (&Sunix_sync);
5891 #endif
5892 }
5893
5894 /* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
5895 (do not change this comment) */