1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
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
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 91
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 99 100
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
131 int auto_saving;
132
133 134
135 int auto_save_mode_bits;
136
137
138 int auto_save_error_occurred;
139
140 141 142 143 144
145 Lisp_Object Qauto_save_coding;
146
147
148 Lisp_Object Vfile_name_coding_system;
149
150 151
152 Lisp_Object Vdefault_file_name_coding_system;
153
154 155
156 Lisp_Object Vfile_name_handler_alist;
157
158 159
160 Lisp_Object Qoperations;
161
162
163 Lisp_Object Qformat_decode, Qformat_annotate_function;
164
165
166 Lisp_Object Vset_auto_coding_function;
167
168
169 Lisp_Object Vafter_insert_file_functions;
170
171 172
173 Lisp_Object Qafter_insert_file_set_coding;
174
175
176 Lisp_Object Vwrite_region_annotate_functions;
177 Lisp_Object Qwrite_region_annotate_functions;
178 Lisp_Object Vwrite_region_post_annotation_function;
179
180 181
182 Lisp_Object Vwrite_region_annotations_so_far;
183
184 185
186 Lisp_Object Vwrite_region_annotation_buffers;
187
188
189 Lisp_Object Vauto_save_list_file_name;
190
191
192 Lisp_Object Vauto_save_visited_file_name;
193
194
195 Lisp_Object Vauto_save_include_big_deletions;
196
197 198
199 Lisp_Object Vdirectory_sep_char;
200
201 #ifdef HAVE_FSYNC
202
203 int write_region_inhibit_fsync;
204 #endif
205
206 207
208 int delete_by_moving_to_trash;
209
210 Lisp_Object Qdelete_by_moving_to_trash;
211
212
213 Lisp_Object Qmove_file_to_trash;
214
215
216 Lisp_Object Qcopy_directory;
217
218
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 232 233 234 235 236
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
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 275 276
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
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
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: 349 350 351 352 353 354 355 356 )
357 (filename, operation)
358 Lisp_Object filename, operation;
359 {
360
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
408 DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory,
409 1, 1, 0,
410 doc: 411 412 413 )
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 428
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
445 && !(p[-1] == ':'
446
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
456 if (p[-1] == ':')
457 {
458
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
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: 486 487 488 )
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 498
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
509 && !(p[-1] == ':'
510
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: 522 523 524 525 526 527 528 529 )
530 (filename)
531 Lisp_Object filename;
532 {
533 Lisp_Object handler;
534
535 536
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
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
562 if (!IS_DIRECTORY_SEP (out[size]))
563 {
564
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: 577 578 579 580 581 )
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 593
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
604 605 606 607 608 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 620
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: 638 639 640 641 )
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 654
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 680 681 682 683 684 685 686 687 688 689 690 691 692 693
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 710 711 712
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 748 749 750 751 752 753 754
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 772
773 make_temp_name_count += 25229;
774 make_temp_name_count %= 225307;
775
776 if (stat (data, &ignored) < 0)
777 {
778
779 if (errno == ENOENT)
780 return val;
781 else
782 783 784 785 786 787 788
789 report_file_error ("Cannot create temporary name for prefix",
790 Fcons (prefix, Qnil));
791
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: 803 804 805 806 807 808 809 810 811 812 813 814 815 816 )
817 (prefix)
818 Lisp_Object prefix;
819 {
820 return make_temp_name (prefix, 0);
821 }
822
823
824
825 DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
826 doc: 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 )
843 (name, default_directory)
844 Lisp_Object name, default_directory;
845 {
846 847
848 unsigned char *nm, *newdir;
849
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
859 int length;
860 Lisp_Object handler, result;
861 int multibyte;
862 Lisp_Object hdir;
863
864 CHECK_STRING (name);
865
866 867
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
873 if (NILP (default_directory))
874 default_directory = current_buffer->directory;
875 if (! STRINGP (default_directory))
876 {
877 #ifdef DOS_NT
878 879 880 881 882 883 884 885
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 905 906 907 908 909 910 911 912 913
914 if (! NILP (default_directory) && !EQ (default_directory, name)
915 916 917
918 #ifdef DOS_NT
919
920 && ! (IS_DRIVE (o[0]) && IS_DEVICE_SEP (o[1])
921 && IS_DIRECTORY_SEP (o[2]))
922 #ifdef WINDOWSNT
923
924 && ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1]))
925 #endif
926 #else
927 928
929 && ! (IS_DIRECTORY_SEP (o[0]))
930 #endif
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
954 nm = (unsigned char *) alloca (SBYTES (name) + 1);
955 bcopy (SDATA (name), nm, SBYTES (name) + 1);
956
957 #ifdef DOS_NT
958
959 if (nm[0] == '/' && nm[1] == ':')
960 {
961 is_escaped = 1;
962 nm += 2;
963 }
964
965 966 967
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 976 977
978 if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
979 nm++;
980
981
982 if (IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
983 {
984 drive = 0;
985 }
986 #endif
987 #endif
988
989 990 991
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 1003 1004 1005 1006 1007
1008 int lose = 0;
1009 unsigned char *p = nm;
1010
1011 while (*p)
1012 {
1013 1014
1015
1016
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 1025
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 1036 1037
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
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
1058 if (strcmp (nm, SDATA (name)) == 0)
1059 return name;
1060 return make_specified_string (nm, -1, strlen (nm), multibyte);
1061 #endif
1062 }
1063 }
1064
1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079
1080
1081 newdir = 0;
1082
1083 if (nm[0] == '~')
1084 {
1085 if (IS_DIRECTORY_SEP (nm[1])
1086 || nm[1] == 0)
1087 {
1088 Lisp_Object tem;
1089
1090 if (!(newdir = (unsigned char *) egetenv ("HOME")))
1091 newdir = (unsigned char *) "";
1092 nm++;
1093 1094
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
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 1126
1127 }
1128 }
1129
1130 #ifdef DOS_NT
1131 1132
1133 if (!newdir && drive)
1134 {
1135
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
1145 newdir = alloca (4);
1146 newdir[0] = DRIVE_LETTER (drive);
1147 newdir[1] = ':';
1148 newdir[2] = '/';
1149 newdir[3] = 0;
1150 }
1151 }
1152 #endif
1153
1154 1155
1156
1157 if (1
1158 #ifndef DOS_NT
1159
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
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
1182 if (
1183
1184 ! (IS_DRIVE (newdir[0])
1185 && IS_DEVICE_SEP (newdir[1]) && IS_DIRECTORY_SEP (newdir[2]))
1186 #ifdef WINDOWSNT
1187
1188 && ! (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
1189 #endif
1190 )
1191 {
1192 1193 1194 1195 1196
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
1221 if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1]))
1222 {
1223 drive = newdir[0];
1224 newdir += 2;
1225 }
1226
1227 1228
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
1248
1249 if (newdir)
1250 {
1251 1252
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
1271 tlen += strlen (nm) + 1;
1272 #ifdef DOS_NT
1273 1274 1275
1276 target = (unsigned char *) alloca (tlen + 4);
1277 target += 4;
1278 #else
1279 target = (unsigned char *) alloca (tlen);
1280 #endif
1281 *target = 0;
1282
1283 if (newdir)
1284 {
1285 if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0]))
1286 {
1287 #ifdef DOS_NT
1288 1289 1290 1291 1292
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 1305
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 1321
1322 if (o == target && p[2] == '\0')
1323 *o++ = *p;
1324 p += 2;
1325 }
1326 else if (p[1] == '.' && p[2] == '.'
1327 1328 1329 1330 1331 1332 1333
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
1346 if (o == target + 1 && IS_DIRECTORY_SEP (*o)
1347 && IS_DIRECTORY_SEP (*target))
1348 o = prev_o;
1349 else
1350 #endif
1351
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
1358 p++;
1359 else
1360 {
1361 *o++ = *p++;
1362 }
1363 }
1364
1365 #ifdef DOS_NT
1366
1367 #ifdef WINDOWSNT
1368
1369 if (!(IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1])))
1370 #endif
1371 {
1372 if (!drive) abort ();
1373 target -= 2;
1374 target[0] = DRIVE_LETTER (drive);
1375 target[1] = ':';
1376 }
1377
1378 if (is_escaped)
1379 {
1380 target -= 2;
1381 target[0] = '/';
1382 target[1] = ':';
1383 }
1384 CORRECT_DIR_SEPS (target);
1385 #endif
1386
1387 result = make_specified_string (target, -1, o - target, multibyte);
1388 }
1389
1390 1391 1392 1393 1394
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 1404 1405 1406 1407 1408 1409 1410 1411 1412
1413
1414
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 1438
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
1465
1466 newdir = 0;
1467
1468 if (nm[0] == '~')
1469 if (nm[1] == '/' || nm[1] == 0)
1470 {
1471 if (!(newdir = (unsigned char *) egetenv ("HOME")))
1472 newdir = (unsigned char *) "";
1473 nm++;
1474 }
1475 else
1476 {
1477
1478 unsigned char *user = nm + 1;
1479
1480 unsigned char *ptr = (unsigned char *) index (user, '/');
1481 int len = ptr ? ptr - user : strlen (user);
1482
1483 o = (unsigned char *) alloca (len + 1);
1484 bcopy ((char *) user, o, len);
1485 o[len] = 0;
1486
1487
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
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
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
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
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
1565
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 1592
1593 && !(IS_DIRECTORY_SEP (p[0]) && p - 1 == nm)
1594 #endif
1595 )
1596 {
1597 for (s = p; *s && (!IS_DIRECTORY_SEP (*s)); s++);
1598 if (p[0] == '~' && s > p + 1)
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 1606 1607
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: 1624 1625 1626 1627 1628 1629 1630 1631 )
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 1650
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 1656 1657
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
1668 p = search_embedded_absfilename (nm, endp);
1669 if (p)
1670 1671 1672
1673 return Fsubstitute_in_file_name
1674 (make_specified_string (p, -1, endp - p, multibyte));
1675
1676 1677
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
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
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);
1715 #endif
1716
1717
1718 o = (unsigned char *) egetenv (target);
1719 if (o)
1720 {
1721 1722 1723 1724 1725
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
1740
1741 xnm = (unsigned char *) alloca (SBYTES (filename) + total + 1);
1742 x = xnm;
1743
1744
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
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);
1778 #endif
1779
1780
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 1799
1800 if (decoded_length != orig_length
1801 || strncmp (SDATA (decoded), o, orig_length))
1802 multibyte = 1;
1803 }
1804 }
1805
1806 *x = 0;
1807
1808
1809 while ((p = search_embedded_absfilename (xnm, x)))
1810 1811 1812
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
1825 return Qnil;
1826 }
1827
1828 1829
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 1840
1841 if (SCHARS (absname) > 1
1842 && IS_DIRECTORY_SEP (SREF (absname, SBYTES (absname) - 1))
1843 && !IS_DEVICE_SEP (SREF (absname, SBYTES (absname)-2)))
1844
1845 absname = Fdirectory_file_name (absname);
1846 return absname;
1847 }
1848
1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859
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 1876
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: 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 )
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 1960
1961 handler = Ffind_file_name_handler (file, Qcopy_file);
1962
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
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
1996 attributes = GetFileAttributes (filename);
1997 SetFileAttributes (filename, attributes & ~FILE_ATTRIBUTE_READONLY);
1998 if (set_file_times (filename, now, now))
1999 {
2000
2001 SetFileAttributes (filename, attributes);
2002 xsignal2 (Qfile_date_error,
2003 build_string ("Cannot set file date"), newname);
2004 }
2005
2006 SetFileAttributes (filename, attributes);
2007 }
2008 #else
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 2019
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
2046 errno = EISDIR;
2047 #endif
2048 report_file_error ("Non-regular file", Fcons (file, Qnil));
2049 }
2050 }
2051 #endif
2052
2053 #ifdef MSDOS
2054
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
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
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 2079
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
2087
2088 #if HAVE_LIBSELINUX
2089 if (conlength > 0)
2090 {
2091
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
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 2124 2125 2126
2127 if ((_djstat_flags & _STFAIL_WRITEBIT) == 0)
2128 chmod (SDATA (encoded_newname), st.st_mode & 07777);
2129 }
2130 #endif
2131 #endif
2132
2133
2134 specpdl_ptr = specpdl + count;
2135
2136 UNGCPRO;
2137 return Qnil;
2138 }
2139
2140 DEFUN ("make-directory-internal", Fmake_directory_internal,
2141 Smake_directory_internal, 1, 1, 0,
2142 doc: )
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: )
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: 2202 2203 2204 2205 2206 2207 )
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 2247
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
2259 DEFUN ("rename-file", Frename_file, Srename_file, 2, 3,
2260 "fRename file: \nGRename %s to file: \np",
2261 doc: 2262 2263 2264 2265 2266 )
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 2283
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 2296
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 2309 2310
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 2333
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: 2361 2362 2363 2364 )
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 2384
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 2391
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: 2416 2417 2418 2419 2420 )
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 2433 2434
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 2444
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 2451
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
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
2490 }
2491
2492
2493 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, Sfile_name_absolute_p,
2494 1, 1, 0,
2495 doc: 2496 )
2497 (filename)
2498 Lisp_Object filename;
2499 {
2500 CHECK_STRING (filename);
2501 return file_name_absolute_p (SDATA (filename)) ? Qt : Qnil;
2502 }
2503
2504
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
2518 #ifdef HAVE_EUIDACCESS
2519 return (euidaccess (filename, 1) >= 0);
2520 #else
2521 2522 2523
2524 return (access (filename, 1) >= 0);
2525 #endif
2526 #endif
2527 }
2528
2529
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
2541 #ifdef HAVE_EUIDACCESS
2542 return (euidaccess (filename, 2) >= 0);
2543 #else
2544 2545 2546 2547 2548
2549 return (access (filename, 2) >= 0);
2550 #endif
2551 #endif
2552 }
2553
2554 DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0,
2555 doc: 2556 2557 2558 )
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 2570
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: 2582 )
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 2593
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: 2605 )
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 2619
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 2628
2629 if (access (SDATA (absname), 0) == 0)
2630 return Qt;
2631 return Qnil;
2632 #else
2633 flags = O_RDONLY;
2634 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2635 2636 2637
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
2650 }
2651
2652 2653
2654 DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
2655 doc: )
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 2667
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
2682
2683 dir = ENCODE_FILE (dir);
2684 #ifdef WINDOWSNT
2685 2686 2687
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
2697 DEFUN ("access-file", Faccess_file, Saccess_file, 2, 2, 0,
2698 doc: 2699 2700 )
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 2713
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
2728 DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0,
2729 doc: 2730 2731 2732 2733 2734 )
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 2744
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
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
2792 return Qnil;
2793 #endif
2794 }
2795
2796 DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0,
2797 doc: 2798 2799 )
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 2810
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: 2824 2825 2826 2827 2828 2829 )
2830 (filename)
2831 Lisp_Object filename;
2832 {
2833 Lisp_Object handler;
2834 int tem;
2835 struct gcpro gcpro1;
2836
2837 2838
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: 2852 2853 2854 )
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 2865
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
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
2893 DEFUN ("file-selinux-context", Ffile_selinux_context,
2894 Sfile_selinux_context, 1, 1, 0,
2895 doc: 2896 2897 )
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 2913
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
2949 DEFUN ("set-file-selinux-context", Fset_file_selinux_context,
2950 Sset_file_selinux_context, 2, 2, 0,
2951 doc: 2952 2953 )
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 2972
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
2983 conlength = lgetfilecon (SDATA (encoded_absname), &con);
2984 if (conlength > 0)
2985 {
2986 parsed_con = context_new (con);
2987
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
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
3027 DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
3028 doc: 3029 )
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 3040
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: 3057 3058 3059 3060 )
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 3071
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: 3086 3087 )
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: 3100 )
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
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: 3117 3118 3119 3120 )
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 3135
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
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
3166 #ifdef HAVE_SYNC
3167 DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "",
3168 doc: )
3169 ()
3170 {
3171 sync ();
3172 return Qnil;
3173 }
3174
3175 #endif
3176
3177 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, Sfile_newer_than_file_p, 2, 2, 0,
3178 doc: 3179 3180 )
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 3200
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
3223 #ifdef DOS_NT
3224 Lisp_Object Qfind_buffer_file_type;
3225 #endif
3226
3227 #ifndef READ_BUF_SIZE
3228 #define READ_BUF_SIZE (64 << 10)
3229 #endif
3230
3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244
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
3265 current_buffer->enable_multibyte_characters = multibyte;
3266 current_buffer->undo_list = undo_list;
3267
3268 return Qnil;
3269 }
3270
3271
3272
3273
3274 static int non_regular_fd;
3275 static EMACS_INT non_regular_inserted;
3276 static EMACS_INT non_regular_nbytes;
3277
3278
3279 3280 3281 3282
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 3300
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: 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 )
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 3375
3376 coding_system = Qnil;
3377
3378 3379
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
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
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 3422 3423
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
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 3448
3449 if (! not_regular && st.st_size < 0)
3450 error ("Maximum buffer size exceeded");
3451
3452
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 3477 3478 3479
3480 if (XINT (end) != st.st_size
3481 3482 3483 3484 3485 )
3486 error ("Maximum buffer size exceeded");
3487
3488 3489 3490
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
3501 set_coding_system = 1;
3502 }
3503 else if (BEG < Z)
3504 {
3505 3506 3507
3508 if (!NILP (Vcoding_system_for_read))
3509 coding_system = Vcoding_system_for_read;
3510 else
3511 {
3512 3513
3514 if (! not_regular && ! NILP (Vset_auto_coding_function))
3515 {
3516 3517 3518 3519 3520
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 3570
3571 specpdl_ptr--;
3572
3573
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 3583
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 3601
3602 coding_system = raw_text_coding_system (coding_system);
3603
3604 setup_coding_system (coding_system, &coding);
3605
3606 set_coding_system = 1;
3607 }
3608
3609 3610 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621 3622
3623 if (!NILP (replace)
3624 && BEGV < ZV
3625 && (NILP (coding_system)
3626 || ! CODING_REQUIRE_DECODING (&coding)))
3627 {
3628 3629 3630
3631 EMACS_INT same_at_start = BEGV_BYTE;
3632 EMACS_INT same_at_end = ZV_BYTE;
3633 EMACS_INT overlap;
3634 3635 3636
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 3649
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 3670
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 3681
3682 if (bufpos != nread)
3683 break;
3684 }
3685 immediate_quit = 0;
3686 3687
3688 if (same_at_start - BEGV_BYTE == XINT (end))
3689 {
3690 emacs_close (fd);
3691 specpdl_ptr--;
3692
3693 del_range_1 (same_at_start, same_at_end, 0, 0);
3694 goto handled;
3695 }
3696 immediate_quit = 1;
3697 QUIT;
3698 3699 3700
3701 while (!giveup_match_end)
3702 {
3703 EMACS_INT total_read, nread, bufpos, curpos, trial;
3704
3705
3706 curpos = XINT (end) - (ZV_BYTE - same_at_end);
3707
3708 if (curpos == 0)
3709 break;
3710
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 3729
3730 bufpos = total_read;
3731
3732 3733
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 3739
3740 if (bufpos != 0)
3741 {
3742 3743
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
3762
3763 3764
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 3771
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
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
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
3789 temp = BYTE_TO_CHAR (same_at_start);
3790 SET_PT_BOTH (temp, same_at_start);
3791
3792 3793
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 3802 3803 3804 3805 3806 3807 3808 3809
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 3827
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;
3834 how_much = 0;
3835 inserted = 0;
3836 unprocessed = 0;
3837
3838 GCPRO1 (conversion_buffer);
3839 while (how_much < total)
3840 {
3841 3842
3843
3844 EMACS_INT trytry = min (total - how_much,
3845 READ_BUF_SIZE - unprocessed);
3846 EMACS_INT this;
3847
3848
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 3875 3876
3877 deferred_remove_unwind_protect = 1;
3878
3879 3880
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 3901
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 3909
3910
3911 if (bufpos == inserted)
3912 {
3913
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 3925
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 3932
3933 bufpos = inserted;
3934
3935 3936
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 3942
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
3949 overlap = same_at_start - BEGV_BYTE - (same_at_end + inserted - ZV_BYTE);
3950 if (overlap > 0)
3951 same_at_end += overlap;
3952
3953 3954
3955 if (XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer)
3956 XWINDOW (selected_window)->start_at_line_beg = Fbolp ();
3957
3958 3959 3960
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
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 3985 3986
3987 specbind (intern ("buffer-file-name"), Qnil);
3988 insert_from_buffer (XBUFFER (conversion_buffer),
3989 same_at_start_charpos, inserted_chars, 0);
3990
3991 inserted = PT - temp;
3992
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
4007 XSETINT (temp, total);
4008 if (total != XINT (temp))
4009 error ("Maximum buffer size exceeded");
4010 }
4011 else
4012
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
4020 && !NILP (current_buffer->filename)
4021 && SAVE_MODIFF >= MODIFF)
4022 we_locked_file = 1;
4023 #endif
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 4039 4040 4041
4042 how_much = 0;
4043
4044
4045 inserted = 0;
4046
4047 4048
4049 {
4050 EMACS_INT gap_size = GAP_SIZE;
4051
4052 while (how_much < total)
4053 {
4054
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
4063 if (gap_size < trytry)
4064 {
4065 make_gap (total - gap_size);
4066 gap_size = GAP_SIZE;
4067 }
4068
4069 4070 4071
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 4088 4089
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 4105 4106 4107 4108
4109 if (! not_regular)
4110 how_much += this;
4111 inserted += this;
4112 }
4113 }
4114
4115 4116
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
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
4140 *GPT_ADDR = 0;
4141
4142 emacs_close (fd);
4143
4144
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 4156 4157 4158 4159
4160
4161 if (!NILP (Vcoding_system_for_read))
4162 coding_system = Vcoding_system_for_read;
4163 else
4164 {
4165 4166 4167 4168 4169
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 4189
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 4209
4210 coding_system = raw_text_coding_system (coding_system);
4211 setup_coding_system (coding_system, &coding);
4212
4213 set_coding_system = 1;
4214 }
4215
4216 if (!NILP (visit))
4217 {
4218 4219
4220 if (CODING_FOR_UNIBYTE (&coding)
4221
4222 && NILP (replace))
4223 4224
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
4247
4248 #ifdef DOS_NT
4249 4250 4251
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 4264
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
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
4310 if (inserted > 0)
4311 {
4312
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
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 4332 4333 4334 4335 4336 4337 4338 4339
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 4351 4352
4353 SET_PT_BOTH (opoint, opoint_byte);
4354 else
4355 4356
4357 inserted = XFASTINT (insval);
4358 }
4359
4360 4361
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 4377
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 4390 4391 4392
4393 SET_PT_BOTH (opoint, opoint_byte);
4394 else
4395 4396 4397
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 4412
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 4422
4423 current_buffer->undo_list = EQ (old_undo, Qt) ? Qt : Qnil;
4424
4425 unbind_to (count, Qnil);
4426 }
4427
4428 4429 4430
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
4442 report_file_error ("Opening input file", Fcons (orig_filename, Qnil));
4443 }
4444
4445 if (read_quit)
4446 Fsignal (Qquit, Qnil);
4447
4448
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
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
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
4491 val = call5 (Vselect_safe_coding_system_function,
4492 start, end, Fcons (Qt, Fcons (val, Qnil)),
4493 Qnil, filename);
4494 }
4495 else
4496 {
4497 4498 4499 4500 4501 4502 4503 4504 4505
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
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 4534
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
4552 val = call5 (Vselect_safe_coding_system_function,
4553 start, end, val, Qnil, filename);
4554
4555 4556 4557
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 4564
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: 4580 4581 4582 4583 4584 4585 4586 4587 4588 4589 4590 4591 4592 4593 4594 4595 4596 4597 4598 4599 4600 4601 4602 4603 4604 4605 4606 4607 4608 4609 4610 4611 4612 4613 )
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
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 4662
4663 handler = Ffind_file_name_handler (filename, Qwrite_region);
4664
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
4687 if (NILP (start))
4688 {
4689 4690 4691 4692 4693
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 4726 4727 4728
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
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
4746 desc = emacs_open (fn, O_WRONLY, 0);
4747 #endif
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
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
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
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
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
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
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 4832
4833 4834
4835 if (!auto_saving && !write_region_inhibit_fsync && fsync (desc) < 0)
4836 {
4837 4838 4839
4840 if (errno != EINTR && errno != EINVAL)
4841 failure = 1, save_errno = errno;
4842 }
4843 #endif
4844
4845
4846 if (emacs_close (desc) < 0)
4847 failure = 1, save_errno = errno;
4848
4849 stat (fn, &st);
4850
4851
4852 specpdl_ptr = specpdl + count1;
4853
4854
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
4874
4875 4876 4877
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
4916 Lisp_Object merge ();
4917
4918 DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0,
4919 doc: )
4920 (a, b)
4921 Lisp_Object a, b;
4922 {
4923 return Flss (Fcar (a), Fcar (b));
4924 }
4925
4926 4927 4928 4929 4930 4931 4932
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 {
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 4964 4965 4966 4967
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);
4978 annotations = merge (annotations, res, Qcar_less_than_car);
4979 p = XCDR (p);
4980 }
4981
4982
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 4994 4995
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
5014 5015 5016 5017 5018 5019 5020 5021 5022
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 5045
5046 if (! (nextpos >= pos && nextpos <= lastpos))
5047 return e_write (desc, string, pos, lastpos, coding);
5048
5049
5050 if (nextpos > pos)
5051 {
5052 if (0 > e_write (desc, string, pos, nextpos, coding))
5053 return -1;
5054 pos = nextpos;
5055 }
5056
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 5070 5071 5072
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 5088
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
5154 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime,
5155 Sverify_visited_file_modtime, 1, 1, 0,
5156 doc: 5157 5158 )
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 5174
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 5185
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
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: 5205 )
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: 5216 5217 5218 5219 )
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: 5230 5231 5232 5233 5234 )
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 5252
5253 handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime);
5254 if (!NILP (handler))
5255
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
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
5316 if (! NILP (current_buffer->filename))
5317 {
5318 if (stat (SDATA (current_buffer->filename), &st) >= 0)
5319
5320 auto_save_mode_bits = st.st_mode | 0600;
5321 else if ((modes = Ffile_modes (current_buffer->filename),
5322 INTEGERP (modes)))
5323
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)
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)
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: 5376 5377 5378 5379 5380 5381 5382 5383 5384 )
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 5412
5413 oquit = Vquit_flag;
5414 Vquit_flag = Qnil;
5415
5416 5417
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 5429 5430
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 5456 5457 5458 5459 5460 5461
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 5470 5471
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 5493
5494 if (b->base_buffer)
5495 continue;
5496
5497 5498 5499
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
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
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 5523
5524 && XFASTINT (b->save_length) > 5000
5525
5526 && !EQ (b->filename, Qnil)
5527 && NILP (no_message))
5528 {
5529
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 5535
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 5551
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
5558 record_auto_save ();
5559
5560 if (auto_saved && NILP (no_message))
5561 {
5562 if (old_message_p)
5563 {
5564 5565
5566 sit_for (make_number (1), 0, 0);
5567 restore_message ();
5568 }
5569 else if (!auto_save_error_occurred)
5570 5571 5572
5573 message1 ("Auto-saving...done");
5574 }
5575
5576 Vquit_flag = oquit;
5577
5578
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: 5586 )
5587 ()
5588 {
5589 5590
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: )
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: 5609 5610 5611 )
5612 ()
5613 {
5614 5615
5616 return (SAVE_MODIFF < BUF_AUTOSAVE_MODIFF (current_buffer) ? Qt : Qnil);
5617 }
5618
5619
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: 5624 5625 )
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
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
5751
5752 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system,
5753 doc: 5754 );
5755 Vfile_name_coding_system = Qnil;
5756
5757 DEFVAR_LISP ("default-file-name-coding-system",
5758 &Vdefault_file_name_coding_system,
5759 doc: 5760 5761 5762 5763 5764 5765 );
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: 5795 );
5796 XSETFASTINT (Vdirectory_sep_char, '/');
5797
5798 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist,
5799 doc: 5800 5801 5802 5803 5804 5805 5806 5807 5808 5809 5810 );
5811 Vfile_name_handler_alist = Qnil;
5812
5813 DEFVAR_LISP ("set-auto-coding-function",
5814 &Vset_auto_coding_function,
5815 doc: 5816 5817 5818 5819 5820 5821 5822 5823 );
5824 Vset_auto_coding_function = Qnil;
5825
5826 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions,
5827 doc: 5828 5829 5830 5831 5832 5833 );
5834 Vafter_insert_file_functions = Qnil;
5835
5836 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions,
5837 doc: 5838 5839 5840 5841 5842 5843 5844 5845 5846 5847 5848 5849 5850 5851 5852 5853 5854 5855 5856 5857 5858 );
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: 5867 5868 5869 5870 5871 );
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: 5878 5879 );
5880 Vwrite_region_annotations_so_far = Qnil;
5881
5882 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers,
5883 doc: 5884 );
5885 Vinhibit_file_name_handlers = Qnil;
5886
5887 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation,
5888 doc: );
5889 Vinhibit_file_name_operation = Qnil;
5890
5891 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name,
5892 doc: 5893 5894 5895 );
5896 Vauto_save_list_file_name = Qnil;
5897
5898 DEFVAR_LISP ("auto-save-visited-file-name", &Vauto_save_visited_file_name,
5899 doc: 5900 );
5901 Vauto_save_visited_file_name = Qnil;
5902
5903 DEFVAR_LISP ("auto-save-include-big-deletions", &Vauto_save_include_big_deletions,
5904 doc: 5905 5906 5907 );
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: 5913 5914 );
5915 write_region_inhibit_fsync = 0;
5916 #endif
5917
5918 DEFVAR_BOOL ("delete-by-moving-to-trash", &delete_by_moving_to_trash,
5919 doc: 5920 5921 );
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 5985