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