Mercurial > hg > xemacs-beta
comparison src/fileio.c @ 412:697ef44129c6 r21-2-14
Import from CVS: tag r21-2-14
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:20:41 +0200 |
parents | de805c49cfc1 |
children | 11054d720c21 |
comparison
equal
deleted
inserted
replaced
411:12e008d41344 | 412:697ef44129c6 |
---|---|
22 /* Synched up with: Mule 2.0, FSF 19.30. */ | 22 /* Synched up with: Mule 2.0, FSF 19.30. */ |
23 /* More syncing: FSF Emacs 19.34.6 by Marc Paquette <marcpa@cam.org> */ | 23 /* More syncing: FSF Emacs 19.34.6 by Marc Paquette <marcpa@cam.org> */ |
24 | 24 |
25 #include <config.h> | 25 #include <config.h> |
26 #include "lisp.h" | 26 #include "lisp.h" |
27 #include <limits.h> | |
27 | 28 |
28 #include "buffer.h" | 29 #include "buffer.h" |
29 #include "events.h" | 30 #include "events.h" |
30 #include "frame.h" | 31 #include "frame.h" |
31 #include "insdel.h" | 32 #include "insdel.h" |
51 #ifdef HPUX_PRE_8_0 | 52 #ifdef HPUX_PRE_8_0 |
52 #include <errnet.h> | 53 #include <errnet.h> |
53 #endif /* HPUX_PRE_8_0 */ | 54 #endif /* HPUX_PRE_8_0 */ |
54 #endif /* HPUX */ | 55 #endif /* HPUX */ |
55 | 56 |
56 #ifdef WIN32_NATIVE | 57 #ifdef WINDOWSNT |
58 #define NOMINMAX 1 | |
59 #include <windows.h> | |
60 #include <direct.h> | |
61 #include <fcntl.h> | |
62 #include <stdlib.h> | |
63 #endif /* not WINDOWSNT */ | |
64 | |
65 #ifdef WINDOWSNT | |
66 #define CORRECT_DIR_SEPS(s) \ | |
67 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \ | |
68 else unixtodos_filename (s); \ | |
69 } while (0) | |
57 #define IS_DRIVE(x) isalpha (x) | 70 #define IS_DRIVE(x) isalpha (x) |
58 /* Need to lower-case the drive letter, or else expanded | 71 /* Need to lower-case the drive letter, or else expanded |
59 filenames will sometimes compare inequal, because | 72 filenames will sometimes compare inequal, because |
60 `expand-file-name' doesn't always down-case the drive letter. */ | 73 `expand-file-name' doesn't always down-case the drive letter. */ |
61 #define DRIVE_LETTER(x) tolower (x) | 74 #define DRIVE_LETTER(x) (tolower (x)) |
62 #endif /* WIN32_NATIVE */ | 75 #endif /* WINDOWSNT */ |
63 | 76 |
64 int lisp_to_time (Lisp_Object, time_t *); | 77 int lisp_to_time (Lisp_Object, time_t *); |
65 Lisp_Object time_to_lisp (time_t); | 78 Lisp_Object time_to_lisp (time_t); |
66 | 79 |
67 /* Nonzero during writing of auto-save files */ | 80 /* Nonzero during writing of auto-save files */ |
94 /* File name in which we write a list of all our auto save files. */ | 107 /* File name in which we write a list of all our auto save files. */ |
95 Lisp_Object Vauto_save_list_file_name; | 108 Lisp_Object Vauto_save_list_file_name; |
96 | 109 |
97 int disable_auto_save_when_buffer_shrinks; | 110 int disable_auto_save_when_buffer_shrinks; |
98 | 111 |
112 Lisp_Object Qfile_name_handler_alist; | |
113 | |
99 Lisp_Object Vdirectory_sep_char; | 114 Lisp_Object Vdirectory_sep_char; |
100 | 115 |
101 /* These variables describe handlers that have "already" had a chance | 116 /* These variables describe handlers that have "already" had a chance |
102 to handle the current operation. | 117 to handle the current operation. |
103 | 118 |
121 EXFUN (Frunning_temacs_p, 0); | 136 EXFUN (Frunning_temacs_p, 0); |
122 | 137 |
123 /* signal a file error when errno contains a meaningful value. */ | 138 /* signal a file error when errno contains a meaningful value. */ |
124 | 139 |
125 DOESNT_RETURN | 140 DOESNT_RETURN |
126 report_file_error (const char *string, Lisp_Object data) | 141 report_file_error (CONST char *string, Lisp_Object data) |
127 { | 142 { |
128 /* #### dmoore - This uses current_buffer, better make sure no one | 143 /* #### dmoore - This uses current_buffer, better make sure no one |
129 has GC'd the current buffer. File handlers are giving me a headache | 144 has GC'd the current buffer. File handlers are giving me a headache |
130 maybe I'll just always protect current_buffer around all of those | 145 maybe I'll just always protect current_buffer around all of those |
131 calls. */ | 146 calls. */ |
134 Fcons (build_translated_string (string), | 149 Fcons (build_translated_string (string), |
135 Fcons (lisp_strerror (errno), data))); | 150 Fcons (lisp_strerror (errno), data))); |
136 } | 151 } |
137 | 152 |
138 void | 153 void |
139 maybe_report_file_error (const char *string, Lisp_Object data, | 154 maybe_report_file_error (CONST char *string, Lisp_Object data, |
140 Lisp_Object class, Error_behavior errb) | 155 Lisp_Object class, Error_behavior errb) |
141 { | 156 { |
142 /* Optimization: */ | 157 /* Optimization: */ |
143 if (ERRB_EQ (errb, ERROR_ME_NOT)) | 158 if (ERRB_EQ (errb, ERROR_ME_NOT)) |
144 return; | 159 return; |
150 } | 165 } |
151 | 166 |
152 /* signal a file error when errno does not contain a meaningful value. */ | 167 /* signal a file error when errno does not contain a meaningful value. */ |
153 | 168 |
154 DOESNT_RETURN | 169 DOESNT_RETURN |
155 signal_file_error (const char *string, Lisp_Object data) | 170 signal_file_error (CONST char *string, Lisp_Object data) |
156 { | 171 { |
157 signal_error (Qfile_error, | 172 signal_error (Qfile_error, |
158 list2 (build_translated_string (string), data)); | 173 list2 (build_translated_string (string), data)); |
159 } | 174 } |
160 | 175 |
161 void | 176 void |
162 maybe_signal_file_error (const char *string, Lisp_Object data, | 177 maybe_signal_file_error (CONST char *string, Lisp_Object data, |
163 Lisp_Object class, Error_behavior errb) | 178 Lisp_Object class, Error_behavior errb) |
164 { | 179 { |
165 /* Optimization: */ | 180 /* Optimization: */ |
166 if (ERRB_EQ (errb, ERROR_ME_NOT)) | 181 if (ERRB_EQ (errb, ERROR_ME_NOT)) |
167 return; | 182 return; |
169 list2 (build_translated_string (string), data), | 184 list2 (build_translated_string (string), data), |
170 class, errb); | 185 class, errb); |
171 } | 186 } |
172 | 187 |
173 DOESNT_RETURN | 188 DOESNT_RETURN |
174 signal_double_file_error (const char *string1, const char *string2, | 189 signal_double_file_error (CONST char *string1, CONST char *string2, |
175 Lisp_Object data) | 190 Lisp_Object data) |
176 { | 191 { |
177 signal_error (Qfile_error, | 192 signal_error (Qfile_error, |
178 list3 (build_translated_string (string1), | 193 list3 (build_translated_string (string1), |
179 build_translated_string (string2), | 194 build_translated_string (string2), |
180 data)); | 195 data)); |
181 } | 196 } |
182 | 197 |
183 void | 198 void |
184 maybe_signal_double_file_error (const char *string1, const char *string2, | 199 maybe_signal_double_file_error (CONST char *string1, CONST char *string2, |
185 Lisp_Object data, Lisp_Object class, | 200 Lisp_Object data, Lisp_Object class, |
186 Error_behavior errb) | 201 Error_behavior errb) |
187 { | 202 { |
188 /* Optimization: */ | 203 /* Optimization: */ |
189 if (ERRB_EQ (errb, ERROR_ME_NOT)) | 204 if (ERRB_EQ (errb, ERROR_ME_NOT)) |
194 data), | 209 data), |
195 class, errb); | 210 class, errb); |
196 } | 211 } |
197 | 212 |
198 DOESNT_RETURN | 213 DOESNT_RETURN |
199 signal_double_file_error_2 (const char *string1, const char *string2, | 214 signal_double_file_error_2 (CONST char *string1, CONST char *string2, |
200 Lisp_Object data1, Lisp_Object data2) | 215 Lisp_Object data1, Lisp_Object data2) |
201 { | 216 { |
202 signal_error (Qfile_error, | 217 signal_error (Qfile_error, |
203 list4 (build_translated_string (string1), | 218 list4 (build_translated_string (string1), |
204 build_translated_string (string2), | 219 build_translated_string (string2), |
205 data1, data2)); | 220 data1, data2)); |
206 } | 221 } |
207 | 222 |
208 void | 223 void |
209 maybe_signal_double_file_error_2 (const char *string1, const char *string2, | 224 maybe_signal_double_file_error_2 (CONST char *string1, CONST char *string2, |
210 Lisp_Object data1, Lisp_Object data2, | 225 Lisp_Object data1, Lisp_Object data2, |
211 Lisp_Object class, Error_behavior errb) | 226 Lisp_Object class, Error_behavior errb) |
212 { | 227 { |
213 /* Optimization: */ | 228 /* Optimization: */ |
214 if (ERRB_EQ (errb, ERROR_ME_NOT)) | 229 if (ERRB_EQ (errb, ERROR_ME_NOT)) |
225 The string needs to be converted since it may be localized. | 240 The string needs to be converted since it may be localized. |
226 Perhaps this should use strerror-coding-system instead? */ | 241 Perhaps this should use strerror-coding-system instead? */ |
227 Lisp_Object | 242 Lisp_Object |
228 lisp_strerror (int errnum) | 243 lisp_strerror (int errnum) |
229 { | 244 { |
230 return build_ext_string (strerror (errnum), Qnative); | 245 return build_ext_string (strerror (errnum), FORMAT_NATIVE); |
231 } | 246 } |
232 | 247 |
233 static Lisp_Object | 248 static Lisp_Object |
234 close_file_unwind (Lisp_Object fd) | 249 close_file_unwind (Lisp_Object fd) |
235 { | 250 { |
265 /* Versions of read() and write() that allow quitting out of the actual | 280 /* Versions of read() and write() that allow quitting out of the actual |
266 I/O. We don't use immediate_quit (i.e. direct longjmp() out of the | 281 I/O. We don't use immediate_quit (i.e. direct longjmp() out of the |
267 signal handler) because that's way too losing. | 282 signal handler) because that's way too losing. |
268 | 283 |
269 (#### Actually, longjmp()ing out of the signal handler may not be | 284 (#### Actually, longjmp()ing out of the signal handler may not be |
270 as losing as I thought. See sys_do_signal() in sysdep.c.) */ | 285 as losing as I thought. See sys_do_signal() in sysdep.c.) |
271 | 286 |
272 ssize_t | 287 Solaris include files declare the return value as ssize_t. |
288 Is that standard? */ | |
289 int | |
273 read_allowing_quit (int fildes, void *buf, size_t size) | 290 read_allowing_quit (int fildes, void *buf, size_t size) |
274 { | 291 { |
275 QUIT; | 292 QUIT; |
276 return sys_read_1 (fildes, buf, size, 1); | 293 return sys_read_1 (fildes, buf, size, 1); |
277 } | 294 } |
278 | 295 |
279 ssize_t | 296 int |
280 write_allowing_quit (int fildes, const void *buf, size_t size) | 297 write_allowing_quit (int fildes, CONST void *buf, size_t size) |
281 { | 298 { |
282 QUIT; | 299 QUIT; |
283 return sys_write_1 (fildes, buf, size, 1); | 300 return sys_write_1 (fildes, buf, size, 1); |
284 } | 301 } |
285 | 302 |
418 #endif | 435 #endif |
419 beg = XSTRING_DATA (file); | 436 beg = XSTRING_DATA (file); |
420 p = beg + XSTRING_LENGTH (file); | 437 p = beg + XSTRING_LENGTH (file); |
421 | 438 |
422 while (p != beg && !IS_ANY_SEP (p[-1]) | 439 while (p != beg && !IS_ANY_SEP (p[-1]) |
423 #ifdef WIN32_NATIVE | 440 #ifdef WINDOWSNT |
424 /* only recognize drive specifier at beginning */ | 441 /* only recognize drive specifier at beginning */ |
425 && !(p[-1] == ':' && p == beg + 2) | 442 && !(p[-1] == ':' && p == beg + 2) |
426 #endif | 443 #endif |
427 ) p--; | 444 ) p--; |
428 | 445 |
429 if (p == beg) | 446 if (p == beg) |
430 return Qnil; | 447 return Qnil; |
431 #ifdef WIN32_NATIVE | 448 #ifdef WINDOWSNT |
432 /* Expansion of "c:" to drive and default directory. */ | 449 /* Expansion of "c:" to drive and default directory. */ |
433 /* (NT does the right thing.) */ | 450 /* (NT does the right thing.) */ |
434 if (p == beg + 2 && beg[1] == ':') | 451 if (p == beg + 2 && beg[1] == ':') |
435 { | 452 { |
436 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */ | 453 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */ |
437 Bufbyte *res = (Bufbyte*) alloca (MAXPATHLEN + 1); | 454 Bufbyte *res = alloca (MAXPATHLEN + 1); |
438 if (_getdcwd (toupper (*beg) - 'A' + 1, (char *)res, MAXPATHLEN)) | 455 if (getdefdir (toupper (*beg) - 'A' + 1, res)) |
439 { | 456 { |
440 char *c=((char *) res) + strlen ((char *) res); | 457 char *c=((char *) res) + strlen ((char *) res); |
441 if (!IS_DIRECTORY_SEP (*c)) | 458 if (!IS_DIRECTORY_SEP (*c)) |
442 { | 459 { |
443 *c++ = DIRECTORY_SEP; | 460 *c++ = DIRECTORY_SEP; |
445 } | 462 } |
446 beg = res; | 463 beg = res; |
447 p = beg + strlen ((char *) beg); | 464 p = beg + strlen ((char *) beg); |
448 } | 465 } |
449 } | 466 } |
450 #endif /* WIN32_NATIVE */ | 467 #endif /* WINDOWSNT */ |
451 return make_string (beg, p - beg); | 468 return make_string (beg, p - beg); |
452 } | 469 } |
453 | 470 |
454 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, 1, 1, 0, /* | 471 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, 1, 1, 0, /* |
455 Return file name NAME sans its directory. | 472 Return file name NAME sans its directory. |
473 | 490 |
474 beg = XSTRING_DATA (file); | 491 beg = XSTRING_DATA (file); |
475 end = p = beg + XSTRING_LENGTH (file); | 492 end = p = beg + XSTRING_LENGTH (file); |
476 | 493 |
477 while (p != beg && !IS_ANY_SEP (p[-1]) | 494 while (p != beg && !IS_ANY_SEP (p[-1]) |
478 #ifdef WIN32_NATIVE | 495 #ifdef WINDOWSNT |
479 /* only recognize drive specifier at beginning */ | 496 /* only recognize drive specifier at beginning */ |
480 && !(p[-1] == ':' && p == beg + 2) | 497 && !(p[-1] == ':' && p == beg + 2) |
481 #endif | 498 #endif |
482 ) p--; | 499 ) p--; |
483 | 500 |
567 * | 584 * |
568 * Value is nonzero if the string output is different from the input. | 585 * Value is nonzero if the string output is different from the input. |
569 */ | 586 */ |
570 | 587 |
571 static int | 588 static int |
572 directory_file_name (const char *src, char *dst) | 589 directory_file_name (CONST char *src, char *dst) |
573 { | 590 { |
574 long slen = strlen (src); | 591 long slen; |
592 | |
593 slen = strlen (src); | |
575 /* Process as Unix format: just remove any final slash. | 594 /* Process as Unix format: just remove any final slash. |
576 But leave "/" unchanged; do not change it to "". */ | 595 But leave "/" unchanged; do not change it to "". */ |
577 strcpy (dst, src); | 596 strcpy (dst, src); |
597 #ifdef APOLLO | |
598 /* Handle // as root for apollo's. */ | |
599 if ((slen > 2 && dst[slen - 1] == '/') | |
600 || (slen > 1 && dst[0] != '/' && dst[slen - 1] == '/')) | |
601 dst[slen - 1] = 0; | |
602 #else | |
578 if (slen > 1 | 603 if (slen > 1 |
579 && IS_DIRECTORY_SEP (dst[slen - 1]) | 604 && IS_DIRECTORY_SEP (dst[slen - 1]) |
580 #ifdef WIN32_NATIVE | 605 #ifdef WINDOWSNT |
581 && !IS_ANY_SEP (dst[slen - 2]) | 606 && !IS_ANY_SEP (dst[slen - 2]) |
582 #endif /* WIN32_NATIVE */ | 607 #endif /* WINDOWSNT */ |
583 ) | 608 ) |
584 dst[slen - 1] = 0; | 609 dst[slen - 1] = 0; |
610 #endif /* APOLLO */ | |
585 return 1; | 611 return 1; |
586 } | 612 } |
587 | 613 |
588 DEFUN ("directory-file-name", Fdirectory_file_name, 1, 1, 0, /* | 614 DEFUN ("directory-file-name", Fdirectory_file_name, 1, 1, 0, /* |
589 Return the file name of the directory named DIR. | 615 Return the file name of the directory named DIR. |
621 arbitrary limit broke generation of Gnus Incoming* files. | 647 arbitrary limit broke generation of Gnus Incoming* files. |
622 | 648 |
623 This implementation is better than what one usually finds in libc. | 649 This implementation is better than what one usually finds in libc. |
624 --hniksic */ | 650 --hniksic */ |
625 | 651 |
626 static unsigned int temp_name_rand; | |
627 | |
628 DEFUN ("make-temp-name", Fmake_temp_name, 1, 1, 0, /* | 652 DEFUN ("make-temp-name", Fmake_temp_name, 1, 1, 0, /* |
629 Generate a temporary file name starting with PREFIX. | 653 Generate temporary file name starting with PREFIX. |
630 The Emacs process number forms part of the result, so there is no | 654 The Emacs process number forms part of the result, so there is no |
631 danger of generating a name being used by another process. | 655 danger of generating a name being used by another process. |
632 | 656 |
633 In addition, this function makes an attempt to choose a name that | 657 In addition, this function makes an attempt to choose a name that |
634 does not specify an existing file. To make this work, PREFIX should | 658 does not specify an existing file. To make this work, PREFIX should |
635 be an absolute file name. | 659 be an absolute file name. |
636 */ | 660 */ |
637 (prefix)) | 661 (prefix)) |
638 { | 662 { |
639 static const char tbl[64] = | 663 static char tbl[64] = { |
640 { | |
641 'A','B','C','D','E','F','G','H', | 664 'A','B','C','D','E','F','G','H', |
642 'I','J','K','L','M','N','O','P', | 665 'I','J','K','L','M','N','O','P', |
643 'Q','R','S','T','U','V','W','X', | 666 'Q','R','S','T','U','V','W','X', |
644 'Y','Z','a','b','c','d','e','f', | 667 'Y','Z','a','b','c','d','e','f', |
645 'g','h','i','j','k','l','m','n', | 668 'g','h','i','j','k','l','m','n', |
646 'o','p','q','r','s','t','u','v', | 669 'o','p','q','r','s','t','u','v', |
647 'w','x','y','z','0','1','2','3', | 670 'w','x','y','z','0','1','2','3', |
648 '4','5','6','7','8','9','-','_' | 671 '4','5','6','7','8','9','-','_' }; |
649 }; | 672 static unsigned count, count_initialized_p; |
650 | 673 |
651 Lisp_Object val; | 674 Lisp_Object val; |
652 Bytecount len; | 675 Bytecount len; |
653 Bufbyte *p, *data; | 676 Bufbyte *p, *data; |
677 unsigned pid; | |
654 | 678 |
655 CHECK_STRING (prefix); | 679 CHECK_STRING (prefix); |
656 | 680 |
657 /* I was tempted to apply Fexpand_file_name on PREFIX here, but it's | 681 /* I was tempted to apply Fexpand_file_name on PREFIX here, but it's |
658 a bad idea because: | 682 a bad idea because: |
674 memcpy (data, XSTRING_DATA (prefix), len); | 698 memcpy (data, XSTRING_DATA (prefix), len); |
675 p = data + len; | 699 p = data + len; |
676 | 700 |
677 /* VAL is created by adding 6 characters to PREFIX. The first three | 701 /* VAL is created by adding 6 characters to PREFIX. The first three |
678 are the PID of this process, in base 64, and the second three are | 702 are the PID of this process, in base 64, and the second three are |
679 a pseudo-random number seeded from process startup time. This | 703 incremented if the file already exists. This ensures 262144 |
680 ensures 262144 unique file names per PID per PREFIX per machine. */ | 704 unique file names per PID per PREFIX. */ |
681 | 705 |
682 { | 706 pid = (unsigned)getpid (); |
683 unsigned int pid = (unsigned int) getpid (); | 707 *p++ = tbl[pid & 63], pid >>= 6; |
684 *p++ = tbl[(pid >> 0) & 63]; | 708 *p++ = tbl[pid & 63], pid >>= 6; |
685 *p++ = tbl[(pid >> 6) & 63]; | 709 *p++ = tbl[pid & 63], pid >>= 6; |
686 *p++ = tbl[(pid >> 12) & 63]; | |
687 } | |
688 | 710 |
689 /* Here we try to minimize useless stat'ing when this function is | 711 /* Here we try to minimize useless stat'ing when this function is |
690 invoked many times successively with the same PREFIX. We achieve | 712 invoked many times successively with the same PREFIX. We achieve |
691 this by using a very pseudo-random number generator to generate | 713 this by initializing count to a random value, and incrementing it |
692 file names unique to this process, with a very long cycle. */ | 714 afterwards. */ |
715 if (!count_initialized_p) | |
716 { | |
717 count = (unsigned)time (NULL); | |
718 /* Dumping temacs with a non-zero count_initialized_p wouldn't | |
719 make much sense. */ | |
720 if (NILP (Frunning_temacs_p ())) | |
721 count_initialized_p = 1; | |
722 } | |
693 | 723 |
694 while (1) | 724 while (1) |
695 { | 725 { |
696 struct stat ignored; | 726 struct stat ignored; |
697 | 727 unsigned num = count; |
698 p[0] = tbl[(temp_name_rand >> 0) & 63]; | 728 |
699 p[1] = tbl[(temp_name_rand >> 6) & 63]; | 729 p[0] = tbl[num & 63], num >>= 6; |
700 p[2] = tbl[(temp_name_rand >> 12) & 63]; | 730 p[1] = tbl[num & 63], num >>= 6; |
731 p[2] = tbl[num & 63], num >>= 6; | |
701 | 732 |
702 /* Poor man's congruential RN generator. Replace with ++count | 733 /* Poor man's congruential RN generator. Replace with ++count |
703 for debugging. */ | 734 for debugging. */ |
704 temp_name_rand += 25229; | 735 count += 25229; |
705 temp_name_rand %= 225307; | 736 count %= 225307; |
706 | 737 |
707 QUIT; | 738 QUIT; |
708 | 739 |
709 if (stat ((const char *) data, &ignored) < 0) | 740 if (stat ((CONST char *) data, &ignored) < 0) |
710 { | 741 { |
711 /* We want to return only if errno is ENOENT. */ | 742 /* We want to return only if errno is ENOENT. */ |
712 if (errno == ENOENT) | 743 if (errno == ENOENT) |
713 return val; | 744 return val; |
714 | 745 |
744 Bufbyte *nm; | 775 Bufbyte *nm; |
745 | 776 |
746 Bufbyte *newdir, *p, *o; | 777 Bufbyte *newdir, *p, *o; |
747 int tlen; | 778 int tlen; |
748 Bufbyte *target; | 779 Bufbyte *target; |
749 #ifdef WIN32_NATIVE | 780 #ifdef WINDOWSNT |
750 int drive = 0; | 781 int drive = 0; |
751 int collapse_newdir = 1; | 782 int collapse_newdir = 1; |
752 #else | 783 #else |
753 struct passwd *pw; | 784 struct passwd *pw; |
754 #endif /* WIN32_NATIVE */ | 785 #endif /* WINDOWSNT */ |
755 int length; | 786 int length; |
756 Lisp_Object handler; | 787 Lisp_Object handler; |
757 #ifdef CYGWIN | 788 #ifdef __CYGWIN32__ |
758 char *user; | 789 char *user; |
759 #endif | 790 #endif |
760 | 791 |
761 CHECK_STRING (name); | 792 CHECK_STRING (name); |
762 | 793 |
794 The EQ test avoids infinite recursion. */ | 825 The EQ test avoids infinite recursion. */ |
795 if (! NILP (default_directory) && !EQ (default_directory, name) | 826 if (! NILP (default_directory) && !EQ (default_directory, name) |
796 /* Save time in some common cases - as long as default_directory | 827 /* Save time in some common cases - as long as default_directory |
797 is not relative, it can be canonicalized with name below (if it | 828 is not relative, it can be canonicalized with name below (if it |
798 is needed at all) without requiring it to be expanded now. */ | 829 is needed at all) without requiring it to be expanded now. */ |
799 #ifdef WIN32_NATIVE | 830 #ifdef WINDOWSNT |
800 /* Detect Windows file names with drive specifiers. */ | 831 /* Detect MSDOS file names with drive specifiers. */ |
801 && ! (IS_DRIVE (o[0]) && (IS_DEVICE_SEP (o[1]) && IS_DIRECTORY_SEP (o[2]))) | 832 && ! (IS_DRIVE (o[0]) && (IS_DEVICE_SEP (o[1]) && IS_DIRECTORY_SEP (o[2]))) |
802 /* Detect Windows file names in UNC format. */ | 833 /* Detect Windows file names in UNC format. */ |
803 && ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1])) | 834 && ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1])) |
804 | 835 |
805 #else /* not WIN32_NATIVE */ | 836 #else /* not WINDOWSNT */ |
806 | 837 |
807 /* Detect Unix absolute file names (/... alone is not absolute on | 838 /* Detect Unix absolute file names (/... alone is not absolute on |
808 Windows). */ | 839 DOS or Windows). */ |
809 && ! (IS_DIRECTORY_SEP (o[0])) | 840 && ! (IS_DIRECTORY_SEP (o[0])) |
810 #endif /* not WIN32_NATIVE */ | 841 #endif /* not WINDOWSNT */ |
811 ) | 842 ) |
812 { | 843 { |
813 struct gcpro gcpro1; | 844 struct gcpro gcpro1; |
814 | 845 |
815 GCPRO1 (name); | 846 GCPRO1 (name); |
823 | 854 |
824 /* #### dmoore - this is ugly, clean this up. Looks like nm pointing | 855 /* #### dmoore - this is ugly, clean this up. Looks like nm pointing |
825 into name should be safe during all of this, though. */ | 856 into name should be safe during all of this, though. */ |
826 nm = XSTRING_DATA (name); | 857 nm = XSTRING_DATA (name); |
827 | 858 |
828 #ifdef WIN32_NATIVE | 859 #ifdef WINDOWSNT |
829 /* We will force directory separators to be either all \ or /, so make | 860 /* We will force directory separators to be either all \ or /, so make |
830 a local copy to modify, even if there ends up being no change. */ | 861 a local copy to modify, even if there ends up being no change. */ |
831 nm = strcpy ((char *)alloca (strlen ((char *)nm) + 1), (char *)nm); | 862 nm = strcpy (alloca (strlen (nm) + 1), nm); |
832 | 863 |
833 /* Find and remove drive specifier if present; this makes nm absolute | 864 /* Find and remove drive specifier if present; this makes nm absolute |
834 even if the rest of the name appears to be relative. */ | 865 even if the rest of the name appears to be relative. */ |
835 { | 866 { |
836 Bufbyte *colon = (Bufbyte *) strrchr ((char *)nm, ':'); | 867 Bufbyte *colon = strrchr (nm, ':'); |
837 | 868 |
838 if (colon) | 869 if (colon) |
839 /* Only recognize colon as part of drive specifier if there is a | 870 /* Only recognize colon as part of drive specifier if there is a |
840 single alphabetic character preceding the colon (and if the | 871 single alphabetic character preceding the colon (and if the |
841 character before the drive letter, if present, is a directory | 872 character before the drive letter, if present, is a directory |
861 /* If we see "c://somedir", we want to strip the first slash after the | 892 /* If we see "c://somedir", we want to strip the first slash after the |
862 colon when stripping the drive letter. Otherwise, this expands to | 893 colon when stripping the drive letter. Otherwise, this expands to |
863 "//somedir". */ | 894 "//somedir". */ |
864 if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1])) | 895 if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1])) |
865 nm++; | 896 nm++; |
866 #endif /* WIN32_NATIVE */ | 897 #endif /* WINDOWSNT */ |
867 | 898 |
868 /* If nm is absolute, look for /./ or /../ sequences; if none are | 899 /* If nm is absolute, look for /./ or /../ sequences; if none are |
869 found, we can probably return right away. We will avoid allocating | 900 found, we can probably return right away. We will avoid allocating |
870 a new string if name is already fully expanded. */ | 901 a new string if name is already fully expanded. */ |
871 if ( | 902 if ( |
872 IS_DIRECTORY_SEP (nm[0]) | 903 IS_DIRECTORY_SEP (nm[0]) |
873 #ifdef WIN32_NATIVE | 904 #ifdef WINDOWSNT |
874 && (drive || IS_DIRECTORY_SEP (nm[1])) | 905 && (drive || IS_DIRECTORY_SEP (nm[1])) |
875 #endif | 906 #endif |
876 ) | 907 ) |
877 { | 908 { |
878 /* If it turns out that the filename we want to return is just a | 909 /* If it turns out that the filename we want to return is just a |
899 lose = 1; | 930 lose = 1; |
900 p++; | 931 p++; |
901 } | 932 } |
902 if (!lose) | 933 if (!lose) |
903 { | 934 { |
904 #ifdef WIN32_NATIVE | 935 #ifdef WINDOWSNT |
905 /* Make sure directories are all separated with / or \ as | 936 /* Make sure directories are all separated with / or \ as |
906 desired, but avoid allocation of a new string when not | 937 desired, but avoid allocation of a new string when not |
907 required. */ | 938 required. */ |
908 CORRECT_DIR_SEPS (nm); | 939 CORRECT_DIR_SEPS (nm); |
909 if (IS_DIRECTORY_SEP (nm[1])) | 940 if (IS_DIRECTORY_SEP (nm[1])) |
917 name = make_string (nm - 2, p - nm + 2); | 948 name = make_string (nm - 2, p - nm + 2); |
918 XSTRING_DATA (name)[0] = DRIVE_LETTER (drive); | 949 XSTRING_DATA (name)[0] = DRIVE_LETTER (drive); |
919 XSTRING_DATA (name)[1] = ':'; | 950 XSTRING_DATA (name)[1] = ':'; |
920 } | 951 } |
921 return name; | 952 return name; |
922 #else /* not WIN32_NATIVE */ | 953 #else /* not WINDOWSNT */ |
923 if (nm == XSTRING_DATA (name)) | 954 if (nm == XSTRING_DATA (name)) |
924 return name; | 955 return name; |
925 return build_string ((char *) nm); | 956 return build_string ((char *) nm); |
926 #endif /* not WIN32_NATIVE */ | 957 #endif /* not WINDOWSNT */ |
927 } | 958 } |
928 } | 959 } |
929 | 960 |
930 /* At this point, nm might or might not be an absolute file name. We | 961 /* At this point, nm might or might not be an absolute file name. We |
931 need to expand ~ or ~user if present, otherwise prefix nm with | 962 need to expand ~ or ~user if present, otherwise prefix nm with |
948 if (nm[0] == '~') /* prefix ~ */ | 979 if (nm[0] == '~') /* prefix ~ */ |
949 { | 980 { |
950 if (IS_DIRECTORY_SEP (nm[1]) | 981 if (IS_DIRECTORY_SEP (nm[1]) |
951 || nm[1] == 0) /* ~ by itself */ | 982 || nm[1] == 0) /* ~ by itself */ |
952 { | 983 { |
953 Extbyte *newdir_external = get_home_directory (); | 984 char * newdir_external = get_home_directory (); |
954 | 985 |
955 if (newdir_external == NULL) | 986 if (newdir_external == NULL) |
956 newdir = (Bufbyte *) ""; | 987 newdir = (Bufbyte *) ""; |
957 else | 988 else |
958 TO_INTERNAL_FORMAT (C_STRING, newdir_external, | 989 GET_C_CHARPTR_INT_FILENAME_DATA_ALLOCA (newdir_external, newdir); |
959 C_STRING_ALLOCA, (* ((char **) &newdir)), | |
960 Qfile_name); | |
961 | 990 |
962 nm++; | 991 nm++; |
963 #ifdef WIN32_NATIVE | 992 #ifdef WINDOWSNT |
964 collapse_newdir = 0; | 993 collapse_newdir = 0; |
965 #endif | 994 #endif |
966 } | 995 } |
967 else /* ~user/filename */ | 996 else /* ~user/filename */ |
968 { | 997 { |
977 names the user who runs this instance of XEmacs. While | 1006 names the user who runs this instance of XEmacs. While |
978 NT is single-user (for the moment) you still can have | 1007 NT is single-user (for the moment) you still can have |
979 multiple user profiles users defined, each with its HOME. | 1008 multiple user profiles users defined, each with its HOME. |
980 Therefore, the following should be reworked to handle | 1009 Therefore, the following should be reworked to handle |
981 this case. */ | 1010 this case. */ |
982 #ifdef WIN32_NATIVE | 1011 #ifdef WINDOWSNT |
983 /* Now if the file given is "~foo/file" and HOME="c:/", then | 1012 /* Now if the file given is "~foo/file" and HOME="c:/", then |
984 we want the file to be named "c:/file" ("~foo" becomes | 1013 we want the file to be named "c:/file" ("~foo" becomes |
985 "c:/"). The variable o has "~foo", so we can use the | 1014 "c:/"). The variable o has "~foo", so we can use the |
986 length of that string to offset nm. August Hill, 31 Aug | 1015 length of that string to offset nm. August Hill, 31 Aug |
987 1998. */ | 1016 1998. */ |
988 newdir = (Bufbyte *) get_home_directory(); | 1017 newdir = (Bufbyte *) get_home_directory(); |
989 dostounix_filename (newdir); | 1018 dostounix_filename (newdir); |
990 nm += strlen(o) + 1; | 1019 nm += strlen(o) + 1; |
991 #else /* not WIN32_NATIVE */ | 1020 #else /* not WINDOWSNT */ |
992 #ifdef CYGWIN | 1021 #ifdef __CYGWIN32__ |
993 if ((user = user_login_name (NULL)) != NULL) | 1022 if ((user = user_login_name (NULL)) != NULL) |
994 { | 1023 { |
995 /* Does the user login name match the ~name? */ | 1024 /* Does the user login name match the ~name? */ |
996 if (strcmp (user, (char *) o + 1) == 0) | 1025 if (strcmp(user,((char *) o + 1)) == 0) |
997 { | 1026 { |
998 newdir = (Bufbyte *) get_home_directory(); | 1027 newdir = (Bufbyte *) get_home_directory(); |
999 nm = p; | 1028 nm = p; |
1000 } | 1029 } |
1001 } | 1030 } |
1002 if (! newdir) | 1031 if (! newdir) |
1003 { | 1032 { |
1004 #endif /* CYGWIN */ | 1033 #endif /* __CYGWIN32__ */ |
1005 /* Jamie reports that getpwnam() can get wedged by SIGIO/SIGALARM | 1034 /* Jamie reports that getpwnam() can get wedged by SIGIO/SIGALARM |
1006 occurring in it. (It can call select()). */ | 1035 occurring in it. (It can call select()). */ |
1007 slow_down_interrupts (); | 1036 slow_down_interrupts (); |
1008 pw = (struct passwd *) getpwnam ((char *) o + 1); | 1037 pw = (struct passwd *) getpwnam ((char *) o + 1); |
1009 speed_up_interrupts (); | 1038 speed_up_interrupts (); |
1010 if (pw) | 1039 if (pw) |
1011 { | 1040 { |
1012 newdir = (Bufbyte *) pw -> pw_dir; | 1041 newdir = (Bufbyte *) pw -> pw_dir; |
1013 nm = p; | 1042 nm = p; |
1014 } | 1043 } |
1015 #ifdef CYGWIN | 1044 #ifdef __CYGWIN32__ |
1016 } | 1045 } |
1017 #endif | 1046 #endif |
1018 #endif /* not WIN32_NATIVE */ | 1047 #endif /* not WINDOWSNT */ |
1019 | 1048 |
1020 /* If we don't find a user of that name, leave the name | 1049 /* If we don't find a user of that name, leave the name |
1021 unchanged; don't move nm forward to p. */ | 1050 unchanged; don't move nm forward to p. */ |
1022 } | 1051 } |
1023 } | 1052 } |
1024 | 1053 |
1025 #ifdef WIN32_NATIVE | 1054 #ifdef WINDOWSNT |
1026 /* On DOS and Windows, nm is absolute if a drive name was specified; | 1055 /* On DOS and Windows, nm is absolute if a drive name was specified; |
1027 use the drive's current directory as the prefix if needed. */ | 1056 use the drive's current directory as the prefix if needed. */ |
1028 if (!newdir && drive) | 1057 if (!newdir && drive) |
1029 { | 1058 { |
1030 /* Get default directory if needed to make nm absolute. */ | 1059 /* Get default directory if needed to make nm absolute. */ |
1031 if (!IS_DIRECTORY_SEP (nm[0])) | 1060 if (!IS_DIRECTORY_SEP (nm[0])) |
1032 { | 1061 { |
1033 newdir = alloca (MAXPATHLEN + 1); | 1062 newdir = alloca (MAXPATHLEN + 1); |
1034 if (!_getdcwd (toupper (drive) - 'A' + 1, newdir, MAXPATHLEN)) | 1063 if (!getdefdir (toupper (drive) - 'A' + 1, newdir)) |
1035 newdir = NULL; | 1064 newdir = NULL; |
1036 } | 1065 } |
1037 if (!newdir) | 1066 if (!newdir) |
1038 { | 1067 { |
1039 /* Either nm starts with /, or drive isn't mounted. */ | 1068 /* Either nm starts with /, or drive isn't mounted. */ |
1042 newdir[1] = ':'; | 1071 newdir[1] = ':'; |
1043 newdir[2] = '/'; | 1072 newdir[2] = '/'; |
1044 newdir[3] = 0; | 1073 newdir[3] = 0; |
1045 } | 1074 } |
1046 } | 1075 } |
1047 #endif /* WIN32_NATIVE */ | 1076 #endif /* WINDOWSNT */ |
1048 | 1077 |
1049 /* Finally, if no prefix has been specified and nm is not absolute, | 1078 /* Finally, if no prefix has been specified and nm is not absolute, |
1050 then it must be expanded relative to default_directory. */ | 1079 then it must be expanded relative to default_directory. */ |
1051 | 1080 |
1052 if (1 | 1081 if (1 |
1053 #ifndef WIN32_NATIVE | 1082 #ifndef WINDOWSNT |
1054 /* /... alone is not absolute on DOS and Windows. */ | 1083 /* /... alone is not absolute on DOS and Windows. */ |
1055 && !IS_DIRECTORY_SEP (nm[0]) | 1084 && !IS_DIRECTORY_SEP (nm[0]) |
1056 #else | 1085 #else |
1057 && !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1])) | 1086 && !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1])) |
1058 #endif | 1087 #endif |
1059 && !newdir) | 1088 && !newdir) |
1060 { | 1089 { |
1061 newdir = XSTRING_DATA (default_directory); | 1090 newdir = XSTRING_DATA (default_directory); |
1062 } | 1091 } |
1063 | 1092 |
1064 #ifdef WIN32_NATIVE | 1093 #ifdef WINDOWSNT |
1065 if (newdir) | 1094 if (newdir) |
1066 { | 1095 { |
1067 /* First ensure newdir is an absolute name. */ | 1096 /* First ensure newdir is an absolute name. */ |
1068 if ( | 1097 if ( |
1069 /* Detect Windows file names with drive specifiers. */ | 1098 /* Detect MSDOS file names with drive specifiers. */ |
1070 ! (IS_DRIVE (newdir[0]) | 1099 ! (IS_DRIVE (newdir[0]) |
1071 && IS_DEVICE_SEP (newdir[1]) && IS_DIRECTORY_SEP (newdir[2])) | 1100 && IS_DEVICE_SEP (newdir[1]) && IS_DIRECTORY_SEP (newdir[2])) |
1072 /* Detect Windows file names in UNC format. */ | 1101 /* Detect Windows file names in UNC format. */ |
1073 && ! (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1])) | 1102 && ! (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1])) |
1074 /* Detect drive spec by itself */ | 1103 /* Detect drive spec by itself */ |
1094 nm = tmp; | 1123 nm = tmp; |
1095 } | 1124 } |
1096 newdir = alloca (MAXPATHLEN + 1); | 1125 newdir = alloca (MAXPATHLEN + 1); |
1097 if (drive) | 1126 if (drive) |
1098 { | 1127 { |
1099 if (!_getdcwd (toupper (drive) - 'A' + 1, newdir, MAXPATHLEN)) | 1128 if (!getdefdir (toupper (drive) - 'A' + 1, newdir)) |
1100 newdir = "/"; | 1129 newdir = "/"; |
1101 } | 1130 } |
1102 else | 1131 else |
1103 getwd (newdir); | 1132 getwd (newdir); |
1104 } | 1133 } |
1125 } | 1154 } |
1126 else | 1155 else |
1127 newdir = ""; | 1156 newdir = ""; |
1128 } | 1157 } |
1129 } | 1158 } |
1130 #endif /* WIN32_NATIVE */ | 1159 #endif /* WINDOWSNT */ |
1131 | 1160 |
1132 if (newdir) | 1161 if (newdir) |
1133 { | 1162 { |
1134 /* Get rid of any slash at the end of newdir, unless newdir is | 1163 /* Get rid of any slash at the end of newdir, unless newdir is |
1135 just // (an incomplete UNC name). */ | 1164 just // (an incomplete UNC name). */ |
1136 length = strlen ((char *) newdir); | 1165 length = strlen ((char *) newdir); |
1137 if (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1]) | 1166 if (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1]) |
1138 #ifdef WIN32_NATIVE | 1167 #ifdef WINDOWSNT |
1139 && !(length == 2 && IS_DIRECTORY_SEP (newdir[0])) | 1168 && !(length == 2 && IS_DIRECTORY_SEP (newdir[0])) |
1140 #endif | 1169 #endif |
1141 ) | 1170 ) |
1142 { | 1171 { |
1143 Bufbyte *temp = (Bufbyte *) alloca (length); | 1172 Bufbyte *temp = (Bufbyte *) alloca (length); |
1150 else | 1179 else |
1151 tlen = 0; | 1180 tlen = 0; |
1152 | 1181 |
1153 /* Now concatenate the directory and name to new space in the stack frame */ | 1182 /* Now concatenate the directory and name to new space in the stack frame */ |
1154 tlen += strlen ((char *) nm) + 1; | 1183 tlen += strlen ((char *) nm) + 1; |
1155 #ifdef WIN32_NATIVE | 1184 #ifdef WINDOWSNT |
1156 /* Add reserved space for drive name. (The Microsoft x86 compiler | 1185 /* Add reserved space for drive name. (The Microsoft x86 compiler |
1157 produces incorrect code if the following two lines are combined.) */ | 1186 produces incorrect code if the following two lines are combined.) */ |
1158 target = (Bufbyte *) alloca (tlen + 2); | 1187 target = (Bufbyte *) alloca (tlen + 2); |
1159 target += 2; | 1188 target += 2; |
1160 #else /* not WIN32_NATIVE */ | 1189 #else /* not WINDOWSNT */ |
1161 target = (Bufbyte *) alloca (tlen); | 1190 target = (Bufbyte *) alloca (tlen); |
1162 #endif /* not WIN32_NATIVE */ | 1191 #endif /* not WINDOWSNT */ |
1163 *target = 0; | 1192 *target = 0; |
1164 | 1193 |
1165 if (newdir) | 1194 if (newdir) |
1166 { | 1195 { |
1167 if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0])) | 1196 if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0])) |
1206 /* Keep initial / only if this is the whole name. */ | 1235 /* Keep initial / only if this is the whole name. */ |
1207 if (o == target && IS_ANY_SEP (*o) && p[3] == 0) | 1236 if (o == target && IS_ANY_SEP (*o) && p[3] == 0) |
1208 ++o; | 1237 ++o; |
1209 p += 3; | 1238 p += 3; |
1210 } | 1239 } |
1211 #ifdef WIN32_NATIVE | 1240 #ifdef WINDOWSNT |
1212 /* if drive is set, we're not dealing with an UNC, so | 1241 /* if drive is set, we're not dealing with an UNC, so |
1213 multiple dir-seps are redundant (and reportedly cause trouble | 1242 multiple dir-seps are redundant (and reportedly cause trouble |
1214 under win95) */ | 1243 under win95) */ |
1215 else if (drive && IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1])) | 1244 else if (drive && IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1])) |
1216 ++p; | 1245 ++p; |
1219 { | 1248 { |
1220 *o++ = *p++; | 1249 *o++ = *p++; |
1221 } | 1250 } |
1222 } | 1251 } |
1223 | 1252 |
1224 #ifdef WIN32_NATIVE | 1253 #ifdef WINDOWSNT |
1225 /* At last, set drive name, except for network file name. */ | 1254 /* At last, set drive name, except for network file name. */ |
1226 if (drive) | 1255 if (drive) |
1227 { | 1256 { |
1228 target -= 2; | 1257 target -= 2; |
1229 target[0] = DRIVE_LETTER (drive); | 1258 target[0] = DRIVE_LETTER (drive); |
1232 else | 1261 else |
1233 { | 1262 { |
1234 assert (IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1])); | 1263 assert (IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1])); |
1235 } | 1264 } |
1236 CORRECT_DIR_SEPS (target); | 1265 CORRECT_DIR_SEPS (target); |
1237 #endif /* WIN32_NATIVE */ | 1266 #endif /* WINDOWSNT */ |
1238 | 1267 |
1239 return make_string (target, o - target); | 1268 return make_string (target, o - target); |
1240 } | 1269 } |
1270 | |
1271 #if 0 /* FSFmacs */ | |
1272 /* another older version of expand-file-name; */ | |
1273 #endif | |
1241 | 1274 |
1242 DEFUN ("file-truename", Ffile_truename, 1, 2, 0, /* | 1275 DEFUN ("file-truename", Ffile_truename, 1, 2, 0, /* |
1243 Return the canonical name of the given FILE. | 1276 Return the canonical name of the given FILE. |
1244 Second arg DEFAULT is directory to start with if FILE is relative | 1277 Second arg DEFAULT is directory to start with if FILE is relative |
1245 (does not start with slash); if DEFAULT is nil or missing, | 1278 (does not start with slash); if DEFAULT is nil or missing, |
1247 No component of the resulting pathname will be a symbolic link, as | 1280 No component of the resulting pathname will be a symbolic link, as |
1248 in the realpath() function. | 1281 in the realpath() function. |
1249 */ | 1282 */ |
1250 (filename, default_)) | 1283 (filename, default_)) |
1251 { | 1284 { |
1252 /* This function can GC. */ | 1285 /* This function can GC. GC checked 1997.04.06. */ |
1253 Lisp_Object expanded_name; | 1286 Lisp_Object expanded_name; |
1287 Lisp_Object handler; | |
1254 struct gcpro gcpro1; | 1288 struct gcpro gcpro1; |
1255 | 1289 |
1256 CHECK_STRING (filename); | 1290 CHECK_STRING (filename); |
1257 | 1291 |
1258 expanded_name = Fexpand_file_name (filename, default_); | 1292 expanded_name = Fexpand_file_name (filename, default_); |
1259 | |
1260 GCPRO1 (expanded_name); | |
1261 | 1293 |
1262 if (!STRINGP (expanded_name)) | 1294 if (!STRINGP (expanded_name)) |
1263 return Qnil; | 1295 return Qnil; |
1264 | 1296 |
1265 { | 1297 GCPRO1 (expanded_name); |
1266 Lisp_Object handler = | 1298 handler = Ffind_file_name_handler (expanded_name, Qfile_truename); |
1267 Ffind_file_name_handler (expanded_name, Qfile_truename); | 1299 UNGCPRO; |
1268 | 1300 |
1269 if (!NILP (handler)) | 1301 if (!NILP (handler)) |
1270 RETURN_UNGCPRO | 1302 return call2_check_string (handler, Qfile_truename, expanded_name); |
1271 (call2_check_string (handler, Qfile_truename, expanded_name)); | |
1272 } | |
1273 | 1303 |
1274 { | 1304 { |
1275 char resolved_path[MAXPATHLEN]; | 1305 char resolved_path[MAXPATHLEN]; |
1276 Extbyte *path; | 1306 char path[MAXPATHLEN]; |
1277 Extbyte *p; | 1307 char *p = path; |
1278 Extcount elen; | 1308 int elen = XSTRING_LENGTH (expanded_name); |
1279 | 1309 |
1280 TO_EXTERNAL_FORMAT (LISP_STRING, expanded_name, | 1310 if (elen >= countof (path)) |
1281 ALLOCA, (path, elen), | |
1282 Qfile_name); | |
1283 p = path; | |
1284 if (elen > MAXPATHLEN) | |
1285 goto toolong; | 1311 goto toolong; |
1286 | 1312 |
1313 memcpy (path, XSTRING_DATA (expanded_name), elen + 1); | |
1314 /* memset (resolved_path, 0, sizeof (resolved_path)); */ | |
1315 | |
1287 /* Try doing it all at once. */ | 1316 /* Try doing it all at once. */ |
1288 /* !! Does realpath() Mule-encapsulate? | 1317 /* !!#### Does realpath() Mule-encapsulate? */ |
1289 Answer: Nope! So we do it above */ | 1318 if (!xrealpath (path, resolved_path)) |
1290 if (!xrealpath ((char *) path, resolved_path)) | |
1291 { | 1319 { |
1292 /* Didn't resolve it -- have to do it one component at a time. */ | 1320 /* Didn't resolve it -- have to do it one component at a time. */ |
1293 /* "realpath" is a typically useless, stupid un*x piece of crap. | 1321 /* "realpath" is a typically useless, stupid un*x piece of crap. |
1294 It claims to return a useful value in the "error" case, but since | 1322 It claims to return a useful value in the "error" case, but since |
1295 there is no indication provided of how far along the pathname | 1323 there is no indication provided of how far along the pathname |
1296 the function went before erring, there is no way to use the | 1324 the function went before erring, there is no way to use the |
1297 partial result returned. What a piece of junk. | 1325 partial result returned. What a piece of junk. */ |
1298 | |
1299 The above comment refers to historical versions of | |
1300 realpath(). The Unix98 specs state: | |
1301 | |
1302 "On successful completion, realpath() returns a | |
1303 pointer to the resolved name. Otherwise, realpath() | |
1304 returns a null pointer and sets errno to indicate the | |
1305 error, and the contents of the buffer pointed to by | |
1306 resolved_name are undefined." | |
1307 | |
1308 Since we depend on undocumented semantics of various system realpath()s, | |
1309 we just use our own version in realpath.c. */ | |
1310 for (;;) | 1326 for (;;) |
1311 { | 1327 { |
1312 p = (Extbyte *) memchr (p + 1, '/', elen - (p + 1 - path)); | 1328 p = (char *) memchr (p + 1, '/', elen - (p + 1 - path)); |
1313 if (p) | 1329 if (p) |
1314 *p = 0; | 1330 *p = 0; |
1315 | 1331 |
1316 if (xrealpath ((char *) path, resolved_path)) | 1332 /* memset (resolved_path, 0, sizeof (resolved_path)); */ |
1333 if (xrealpath (path, resolved_path)) | |
1317 { | 1334 { |
1318 if (p) | 1335 if (p) |
1319 *p = '/'; | 1336 *p = '/'; |
1320 else | 1337 else |
1321 break; | 1338 break; |
1328 int rlen = strlen (resolved_path); | 1345 int rlen = strlen (resolved_path); |
1329 | 1346 |
1330 /* "On failure, it returns NULL, sets errno to indicate | 1347 /* "On failure, it returns NULL, sets errno to indicate |
1331 the error, and places in resolved_path the absolute pathname | 1348 the error, and places in resolved_path the absolute pathname |
1332 of the path component which could not be resolved." */ | 1349 of the path component which could not be resolved." */ |
1333 | 1350 if (p) |
1334 if (p) | |
1335 { | 1351 { |
1336 int plen = elen - (p - path); | 1352 int plen = elen - (p - path); |
1337 | 1353 |
1338 if (rlen > 1 && resolved_path[rlen - 1] == '/') | 1354 if (rlen > 1 && resolved_path[rlen - 1] == '/') |
1339 rlen = rlen - 1; | 1355 rlen = rlen - 1; |
1350 goto lose; | 1366 goto lose; |
1351 } | 1367 } |
1352 } | 1368 } |
1353 | 1369 |
1354 { | 1370 { |
1355 Lisp_Object resolved_name; | |
1356 int rlen = strlen (resolved_path); | 1371 int rlen = strlen (resolved_path); |
1357 if (elen > 0 && XSTRING_BYTE (expanded_name, elen - 1) == '/' | 1372 if (elen > 0 && XSTRING_BYTE (expanded_name, elen - 1) == '/' |
1358 && !(rlen > 0 && resolved_path[rlen - 1] == '/')) | 1373 && !(rlen > 0 && resolved_path[rlen - 1] == '/')) |
1359 { | 1374 { |
1360 if (rlen + 1 > countof (resolved_path)) | 1375 if (rlen + 1 > countof (resolved_path)) |
1361 goto toolong; | 1376 goto toolong; |
1362 resolved_path[rlen++] = '/'; | 1377 resolved_path[rlen] = '/'; |
1363 resolved_path[rlen] = '\0'; | 1378 resolved_path[rlen + 1] = 0; |
1379 rlen = rlen + 1; | |
1364 } | 1380 } |
1365 TO_INTERNAL_FORMAT (DATA, (resolved_path, rlen), | 1381 return make_ext_string ((Bufbyte *) resolved_path, rlen, FORMAT_BINARY); |
1366 LISP_STRING, resolved_name, | |
1367 Qfile_name); | |
1368 RETURN_UNGCPRO (resolved_name); | |
1369 } | 1382 } |
1370 | 1383 |
1371 toolong: | 1384 toolong: |
1372 errno = ENAMETOOLONG; | 1385 errno = ENAMETOOLONG; |
1373 goto lose; | 1386 goto lose; |
1374 lose: | 1387 lose: |
1375 report_file_error ("Finding truename", list1 (expanded_name)); | 1388 report_file_error ("Finding truename", list1 (expanded_name)); |
1376 } | 1389 } |
1377 RETURN_UNGCPRO (Qnil); | 1390 return Qnil; /* suppress compiler warning */ |
1378 } | 1391 } |
1379 | 1392 |
1380 | 1393 |
1381 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name, 1, 1, 0, /* | 1394 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name, 1, 1, 0, /* |
1382 Substitute environment variables referred to in FILENAME. | 1395 Substitute environment variables referred to in FILENAME. |
1414 /* If /~ or // appears, discard everything through first slash. */ | 1427 /* If /~ or // appears, discard everything through first slash. */ |
1415 | 1428 |
1416 for (p = nm; p != endp; p++) | 1429 for (p = nm; p != endp; p++) |
1417 { | 1430 { |
1418 if ((p[0] == '~' | 1431 if ((p[0] == '~' |
1419 #if defined (WIN32_NATIVE) || defined (CYGWIN) | 1432 #if defined (APOLLO) || defined (WINDOWSNT) || defined (__CYGWIN32__) |
1420 /* // at start of file name is meaningful in WindowsNT systems */ | 1433 /* // at start of file name is meaningful in Apollo and |
1434 WindowsNT systems */ | |
1421 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm) | 1435 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm) |
1422 #else /* not (WIN32_NATIVE || CYGWIN) */ | 1436 #else /* not (APOLLO || WINDOWSNT || __CYGWIN32__) */ |
1423 || IS_DIRECTORY_SEP (p[0]) | 1437 || IS_DIRECTORY_SEP (p[0]) |
1424 #endif /* not (WIN32_NATIVE || CYGWIN) */ | 1438 #endif /* not (APOLLO || WINDOWSNT || __CYGWIN32__) */ |
1425 ) | 1439 ) |
1426 && p != nm | 1440 && p != nm |
1427 && (IS_DIRECTORY_SEP (p[-1]))) | 1441 && (IS_DIRECTORY_SEP (p[-1]))) |
1428 { | 1442 { |
1429 nm = p; | 1443 nm = p; |
1430 substituted = 1; | 1444 substituted = 1; |
1431 } | 1445 } |
1432 #ifdef WIN32_NATIVE | 1446 #ifdef WINDOWSNT |
1433 /* see comment in expand-file-name about drive specifiers */ | 1447 /* see comment in expand-file-name about drive specifiers */ |
1434 else if (IS_DRIVE (p[0]) && p[1] == ':' | 1448 else if (IS_DRIVE (p[0]) && p[1] == ':' |
1435 && p > nm && IS_DIRECTORY_SEP (p[-1])) | 1449 && p > nm && IS_DIRECTORY_SEP (p[-1])) |
1436 { | 1450 { |
1437 nm = p; | 1451 nm = p; |
1438 substituted = 1; | 1452 substituted = 1; |
1439 } | 1453 } |
1440 #endif /* WIN32_NATIVE */ | 1454 #endif /* WINDOWSNT */ |
1441 } | 1455 } |
1442 | 1456 |
1443 /* See if any variables are substituted into the string | 1457 /* See if any variables are substituted into the string |
1444 and find the total length of their values in `total' */ | 1458 and find the total length of their values in `total' */ |
1445 | 1459 |
1475 | 1489 |
1476 /* Copy out the variable name */ | 1490 /* Copy out the variable name */ |
1477 target = (Bufbyte *) alloca (s - o + 1); | 1491 target = (Bufbyte *) alloca (s - o + 1); |
1478 strncpy ((char *) target, (char *) o, s - o); | 1492 strncpy ((char *) target, (char *) o, s - o); |
1479 target[s - o] = 0; | 1493 target[s - o] = 0; |
1480 #ifdef WIN32_NATIVE | 1494 #ifdef WINDOWSNT |
1481 strupr (target); /* $home == $HOME etc. */ | 1495 strupr (target); /* $home == $HOME etc. */ |
1482 #endif /* WIN32_NATIVE */ | 1496 #endif /* WINDOWSNT */ |
1483 | 1497 |
1484 /* Get variable value */ | 1498 /* Get variable value */ |
1485 o = (Bufbyte *) egetenv ((char *) target); | 1499 o = (Bufbyte *) egetenv ((char *) target); |
1486 if (!o) goto badvar; | 1500 if (!o) goto badvar; |
1487 total += strlen ((char *) o); | 1501 total += strlen ((char *) o); |
1526 | 1540 |
1527 /* Copy out the variable name */ | 1541 /* Copy out the variable name */ |
1528 target = (Bufbyte *) alloca (s - o + 1); | 1542 target = (Bufbyte *) alloca (s - o + 1); |
1529 strncpy ((char *) target, (char *) o, s - o); | 1543 strncpy ((char *) target, (char *) o, s - o); |
1530 target[s - o] = 0; | 1544 target[s - o] = 0; |
1531 #ifdef WIN32_NATIVE | 1545 #ifdef WINDOWSNT |
1532 strupr (target); /* $home == $HOME etc. */ | 1546 strupr (target); /* $home == $HOME etc. */ |
1533 #endif /* WIN32_NATIVE */ | 1547 #endif /* WINDOWSNT */ |
1534 | 1548 |
1535 /* Get variable value */ | 1549 /* Get variable value */ |
1536 o = (Bufbyte *) egetenv ((char *) target); | 1550 o = (Bufbyte *) egetenv ((char *) target); |
1537 if (!o) | 1551 if (!o) |
1538 goto badvar; | 1552 goto badvar; |
1545 | 1559 |
1546 /* If /~ or // appears, discard everything through first slash. */ | 1560 /* If /~ or // appears, discard everything through first slash. */ |
1547 | 1561 |
1548 for (p = xnm; p != x; p++) | 1562 for (p = xnm; p != x; p++) |
1549 if ((p[0] == '~' | 1563 if ((p[0] == '~' |
1550 #if defined (WIN32_NATIVE) | 1564 #if defined (APOLLO) || defined (WINDOWSNT) |
1551 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm) | 1565 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm) |
1552 #else /* not WIN32_NATIVE */ | 1566 #else /* not (APOLLO || WINDOWSNT) */ |
1553 || IS_DIRECTORY_SEP (p[0]) | 1567 || IS_DIRECTORY_SEP (p[0]) |
1554 #endif /* not WIN32_NATIVE */ | 1568 #endif /* APOLLO || WINDOWSNT */ |
1555 ) | 1569 ) |
1556 /* don't do p[-1] if that would go off the beginning --jwz */ | 1570 /* don't do p[-1] if that would go off the beginning --jwz */ |
1557 && p != nm && p > xnm && IS_DIRECTORY_SEP (p[-1])) | 1571 && p != nm && p > xnm && IS_DIRECTORY_SEP (p[-1])) |
1558 xnm = p; | 1572 xnm = p; |
1559 #ifdef WIN32_NATIVE | 1573 #ifdef WINDOWSNT |
1560 else if (IS_DRIVE (p[0]) && p[1] == ':' | 1574 else if (IS_DRIVE (p[0]) && p[1] == ':' |
1561 && p > nm && IS_DIRECTORY_SEP (p[-1])) | 1575 && p > nm && IS_DIRECTORY_SEP (p[-1])) |
1562 xnm = p; | 1576 xnm = p; |
1563 #endif | 1577 #endif |
1564 | 1578 |
1606 to alter the file. | 1620 to alter the file. |
1607 *STATPTR is used to store the stat information if the file exists. | 1621 *STATPTR is used to store the stat information if the file exists. |
1608 If the file does not exist, STATPTR->st_mode is set to 0. */ | 1622 If the file does not exist, STATPTR->st_mode is set to 0. */ |
1609 | 1623 |
1610 static void | 1624 static void |
1611 barf_or_query_if_file_exists (Lisp_Object absname, const char *querystring, | 1625 barf_or_query_if_file_exists (Lisp_Object absname, CONST char *querystring, |
1612 int interactive, struct stat *statptr) | 1626 int interactive, struct stat *statptr) |
1613 { | 1627 { |
1614 /* This function can GC. GC checked 1997.04.06. */ | 1628 /* This function can GC. GC checked 1997.04.06. */ |
1615 struct stat statbuf; | 1629 struct stat statbuf; |
1616 | 1630 |
1624 { | 1638 { |
1625 Lisp_Object prompt; | 1639 Lisp_Object prompt; |
1626 struct gcpro gcpro1; | 1640 struct gcpro gcpro1; |
1627 | 1641 |
1628 prompt = emacs_doprnt_string_c | 1642 prompt = emacs_doprnt_string_c |
1629 ((const Bufbyte *) GETTEXT ("File %s already exists; %s anyway? "), | 1643 ((CONST Bufbyte *) GETTEXT ("File %s already exists; %s anyway? "), |
1630 Qnil, -1, XSTRING_DATA (absname), | 1644 Qnil, -1, XSTRING_DATA (absname), |
1631 GETTEXT (querystring)); | 1645 GETTEXT (querystring)); |
1632 | 1646 |
1633 GCPRO1 (prompt); | 1647 GCPRO1 (prompt); |
1634 tem = call1 (Qyes_or_no_p, prompt); | 1648 tem = call1 (Qyes_or_no_p, prompt); |
1716 | 1730 |
1717 if (NILP (ok_if_already_exists) | 1731 if (NILP (ok_if_already_exists) |
1718 || INTP (ok_if_already_exists)) | 1732 || INTP (ok_if_already_exists)) |
1719 barf_or_query_if_file_exists (newname, "copy to it", | 1733 barf_or_query_if_file_exists (newname, "copy to it", |
1720 INTP (ok_if_already_exists), &out_st); | 1734 INTP (ok_if_already_exists), &out_st); |
1721 else if (stat ((const char *) XSTRING_DATA (newname), &out_st) < 0) | 1735 else if (stat ((CONST char *) XSTRING_DATA (newname), &out_st) < 0) |
1722 out_st.st_mode = 0; | 1736 out_st.st_mode = 0; |
1723 | 1737 |
1724 ifd = interruptible_open ((char *) XSTRING_DATA (filename), O_RDONLY | OPEN_BINARY, 0); | 1738 ifd = interruptible_open ((char *) XSTRING_DATA (filename), O_RDONLY | OPEN_BINARY, 0); |
1725 if (ifd < 0) | 1739 if (ifd < 0) |
1726 report_file_error ("Opening input file", list1 (filename)); | 1740 report_file_error ("Opening input file", list1 (filename)); |
1729 | 1743 |
1730 /* We can only copy regular files and symbolic links. Other files are not | 1744 /* We can only copy regular files and symbolic links. Other files are not |
1731 copyable by us. */ | 1745 copyable by us. */ |
1732 input_file_statable_p = (fstat (ifd, &st) >= 0); | 1746 input_file_statable_p = (fstat (ifd, &st) >= 0); |
1733 | 1747 |
1734 #ifndef WIN32_NATIVE | 1748 #ifndef WINDOWSNT |
1735 if (out_st.st_mode != 0 | 1749 if (out_st.st_mode != 0 |
1736 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino) | 1750 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino) |
1737 { | 1751 { |
1738 errno = 0; | 1752 errno = 0; |
1739 report_file_error ("Input and output files are the same", | 1753 report_file_error ("Input and output files are the same", |
1789 EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0); | 1803 EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0); |
1790 if (set_file_times ((char *) XSTRING_DATA (newname), atime, | 1804 if (set_file_times ((char *) XSTRING_DATA (newname), atime, |
1791 mtime)) | 1805 mtime)) |
1792 report_file_error ("I/O error", list1 (newname)); | 1806 report_file_error ("I/O error", list1 (newname)); |
1793 } | 1807 } |
1794 chmod ((const char *) XSTRING_DATA (newname), | 1808 chmod ((CONST char *) XSTRING_DATA (newname), |
1795 st.st_mode & 07777); | 1809 st.st_mode & 07777); |
1796 } | 1810 } |
1797 | 1811 |
1798 /* We'll close it by hand */ | 1812 /* We'll close it by hand */ |
1799 XCAR (ofd_locative) = Qnil; | 1813 XCAR (ofd_locative) = Qnil; |
1827 | 1841 |
1828 if (XSTRING_LENGTH (dirname_) > (Bytecount) (sizeof (dir) - 1)) | 1842 if (XSTRING_LENGTH (dirname_) > (Bytecount) (sizeof (dir) - 1)) |
1829 { | 1843 { |
1830 return Fsignal (Qfile_error, | 1844 return Fsignal (Qfile_error, |
1831 list3 (build_translated_string ("Creating directory"), | 1845 list3 (build_translated_string ("Creating directory"), |
1832 build_translated_string ("pathname too long"), | 1846 build_translated_string ("pathame too long"), |
1833 dirname_)); | 1847 dirname_)); |
1834 } | 1848 } |
1835 strncpy (dir, (char *) XSTRING_DATA (dirname_), | 1849 strncpy (dir, (char *) XSTRING_DATA (dirname_), |
1836 XSTRING_LENGTH (dirname_) + 1); | 1850 XSTRING_LENGTH (dirname_) + 1); |
1837 | 1851 |
1869 | 1883 |
1870 return Qnil; | 1884 return Qnil; |
1871 } | 1885 } |
1872 | 1886 |
1873 DEFUN ("delete-file", Fdelete_file, 1, 1, "fDelete file: ", /* | 1887 DEFUN ("delete-file", Fdelete_file, 1, 1, "fDelete file: ", /* |
1874 Delete the file named FILENAME (a string). | 1888 Delete specified file. One argument, a file name string. |
1875 If FILENAME has multiple names, it continues to exist with the other names. | 1889 If file has multiple names, it continues to exist with the other names. |
1876 */ | 1890 */ |
1877 (filename)) | 1891 (filename)) |
1878 { | 1892 { |
1879 /* This function can GC. GC checked 1997.04.06. */ | 1893 /* This function can GC. GC checked 1997.04.06. */ |
1880 Lisp_Object handler; | 1894 Lisp_Object handler; |
1967 || INTP (ok_if_already_exists)) | 1981 || INTP (ok_if_already_exists)) |
1968 barf_or_query_if_file_exists (newname, "rename to it", | 1982 barf_or_query_if_file_exists (newname, "rename to it", |
1969 INTP (ok_if_already_exists), 0); | 1983 INTP (ok_if_already_exists), 0); |
1970 | 1984 |
1971 /* Syncing with FSF 19.34.6 note: FSF does not have conditional code for | 1985 /* Syncing with FSF 19.34.6 note: FSF does not have conditional code for |
1972 WIN32_NATIVE here; I've removed it. --marcpa */ | 1986 WINDOWSNT here; I've removed it. --marcpa */ |
1973 | 1987 |
1974 /* We have configure check for rename() and emulate using | 1988 /* FSFmacs only calls rename() here under BSD 4.1, and calls |
1975 link()/unlink() if necessary. */ | 1989 link() and unlink() otherwise, but that's bogus. Sometimes |
1990 rename() succeeds where link()/unlink() fail, and we have | |
1991 configure check for rename() and emulate using link()/unlink() | |
1992 if necessary. */ | |
1976 if (0 > rename ((char *) XSTRING_DATA (filename), | 1993 if (0 > rename ((char *) XSTRING_DATA (filename), |
1977 (char *) XSTRING_DATA (newname))) | 1994 (char *) XSTRING_DATA (newname))) |
1978 { | 1995 { |
1979 if (errno == EXDEV) | 1996 if (errno == EXDEV) |
1980 { | 1997 { |
1981 Fcopy_file (filename, newname, | 1998 Fcopy_file (filename, newname, |
1982 /* We have already prompted if it was an integer, | 1999 /* We have already prompted if it was an integer, |
1983 so don't have copy-file prompt again. */ | 2000 so don't have copy-file prompt again. */ |
1984 (NILP (ok_if_already_exists) ? Qnil : Qt), | 2001 ((NILP (ok_if_already_exists)) ? Qnil : Qt), |
1985 Qt); | 2002 Qt); |
1986 Fdelete_file (filename); | 2003 Fdelete_file (filename); |
1987 } | 2004 } |
1988 else | 2005 else |
1989 { | 2006 { |
2035 /* Syncing with FSF 19.34.6 note: FSF does not report a file error | 2052 /* Syncing with FSF 19.34.6 note: FSF does not report a file error |
2036 on NT here. --marcpa */ | 2053 on NT here. --marcpa */ |
2037 /* But FSF #defines link as sys_link which is supplied in nt.c. We can't do | 2054 /* But FSF #defines link as sys_link which is supplied in nt.c. We can't do |
2038 that because sysfile.h defines sys_link depending on ENCAPSULATE_LINK. | 2055 that because sysfile.h defines sys_link depending on ENCAPSULATE_LINK. |
2039 Reverted to previous behavior pending a working fix. (jhar) */ | 2056 Reverted to previous behavior pending a working fix. (jhar) */ |
2040 #if defined(WIN32_NATIVE) | 2057 #if defined(WINDOWSNT) |
2041 /* Windows does not support this operation. */ | 2058 /* Windows does not support this operation. */ |
2042 report_file_error ("Adding new name", Flist (2, &filename)); | 2059 report_file_error ("Adding new name", Flist (2, &filename)); |
2043 #else /* not defined(WIN32_NATIVE) */ | 2060 #else /* not defined(WINDOWSNT) */ |
2044 | 2061 |
2045 unlink ((char *) XSTRING_DATA (newname)); | 2062 unlink ((char *) XSTRING_DATA (newname)); |
2046 if (0 > link ((char *) XSTRING_DATA (filename), | 2063 if (0 > link ((char *) XSTRING_DATA (filename), |
2047 (char *) XSTRING_DATA (newname))) | 2064 (char *) XSTRING_DATA (newname))) |
2048 { | 2065 { |
2049 report_file_error ("Adding new name", | 2066 report_file_error ("Adding new name", |
2050 list2 (filename, newname)); | 2067 list2 (filename, newname)); |
2051 } | 2068 } |
2052 #endif /* defined(WIN32_NATIVE) */ | 2069 #endif /* defined(WINDOWSNT) */ |
2053 | 2070 |
2054 UNGCPRO; | 2071 UNGCPRO; |
2055 return Qnil; | 2072 return Qnil; |
2056 } | 2073 } |
2057 | 2074 |
2075 #ifdef S_IFLNK | |
2058 DEFUN ("make-symbolic-link", Fmake_symbolic_link, 2, 3, | 2076 DEFUN ("make-symbolic-link", Fmake_symbolic_link, 2, 3, |
2059 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", /* | 2077 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", /* |
2060 Make a symbolic link to FILENAME, named LINKNAME. Both args strings. | 2078 Make a symbolic link to FILENAME, named LINKNAME. Both args strings. |
2061 Signals a `file-already-exists' error if a file LINKNAME already exists | 2079 Signals a `file-already-exists' error if a file LINKNAME already exists |
2062 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil. | 2080 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil. |
2064 This happens for interactive use with M-x. | 2082 This happens for interactive use with M-x. |
2065 */ | 2083 */ |
2066 (filename, linkname, ok_if_already_exists)) | 2084 (filename, linkname, ok_if_already_exists)) |
2067 { | 2085 { |
2068 /* This function can GC. GC checked 1997.06.04. */ | 2086 /* This function can GC. GC checked 1997.06.04. */ |
2069 /* XEmacs change: run handlers even if local machine doesn't have symlinks */ | |
2070 Lisp_Object handler; | 2087 Lisp_Object handler; |
2071 struct gcpro gcpro1, gcpro2; | 2088 struct gcpro gcpro1, gcpro2; |
2072 | 2089 |
2073 GCPRO2 (filename, linkname); | 2090 GCPRO2 (filename, linkname); |
2074 CHECK_STRING (filename); | 2091 CHECK_STRING (filename); |
2092 handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link); | 2109 handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link); |
2093 if (!NILP (handler)) | 2110 if (!NILP (handler)) |
2094 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename, | 2111 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename, |
2095 linkname, ok_if_already_exists)); | 2112 linkname, ok_if_already_exists)); |
2096 | 2113 |
2097 #ifdef S_IFLNK | |
2098 if (NILP (ok_if_already_exists) | 2114 if (NILP (ok_if_already_exists) |
2099 || INTP (ok_if_already_exists)) | 2115 || INTP (ok_if_already_exists)) |
2100 barf_or_query_if_file_exists (linkname, "make it a link", | 2116 barf_or_query_if_file_exists (linkname, "make it a link", |
2101 INTP (ok_if_already_exists), 0); | 2117 INTP (ok_if_already_exists), 0); |
2102 | 2118 |
2105 (char *) XSTRING_DATA (linkname))) | 2121 (char *) XSTRING_DATA (linkname))) |
2106 { | 2122 { |
2107 report_file_error ("Making symbolic link", | 2123 report_file_error ("Making symbolic link", |
2108 list2 (filename, linkname)); | 2124 list2 (filename, linkname)); |
2109 } | 2125 } |
2110 #endif /* S_IFLNK */ | |
2111 | |
2112 UNGCPRO; | 2126 UNGCPRO; |
2113 return Qnil; | 2127 return Qnil; |
2114 } | 2128 } |
2129 #endif /* S_IFLNK */ | |
2115 | 2130 |
2116 #ifdef HPUX_NET | 2131 #ifdef HPUX_NET |
2117 | 2132 |
2118 DEFUN ("sysnetunam", Fsysnetunam, 2, 2, 0, /* | 2133 DEFUN ("sysnetunam", Fsysnetunam, 2, 2, 0, /* |
2119 Open a network connection to PATH using LOGIN as the login string. | 2134 Open a network connection to PATH using LOGIN as the login string. |
2120 */ | 2135 */ |
2121 (path, login)) | 2136 (path, login)) |
2122 { | 2137 { |
2123 int netresult; | 2138 int netresult; |
2124 const char *path_ext; | |
2125 const char *login_ext; | |
2126 | 2139 |
2127 CHECK_STRING (path); | 2140 CHECK_STRING (path); |
2128 CHECK_STRING (login); | 2141 CHECK_STRING (login); |
2129 | 2142 |
2130 /* netunam, being a strange-o system call only used once, is not | 2143 /* netunam, being a strange-o system call only used once, is not |
2131 encapsulated. */ | 2144 encapsulated. */ |
2132 | 2145 { |
2133 TO_EXTERNAL_FORMAT (LISP_STRING, path, C_STRING_ALLOCA, path_ext, Qfile_name); | 2146 char *path_ext; |
2134 TO_EXTERNAL_FORMAT (LISP_STRING, login, C_STRING_ALLOCA, login_ext, Qnative); | 2147 char *login_ext; |
2135 | 2148 |
2136 netresult = netunam (path_ext, login_ext); | 2149 GET_C_STRING_FILENAME_DATA_ALLOCA (path, path_ext); |
2137 | 2150 GET_C_STRING_EXT_DATA_ALLOCA (login, FORMAT_OS, login_ext); |
2138 return netresult == -1 ? Qnil : Qt; | 2151 |
2152 netresult = netunam (path_ext, login_ext); | |
2153 } | |
2154 | |
2155 if (netresult == -1) | |
2156 return Qnil; | |
2157 else | |
2158 return Qt; | |
2139 } | 2159 } |
2140 #endif /* HPUX_NET */ | 2160 #endif /* HPUX_NET */ |
2141 | 2161 |
2142 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, 1, 1, 0, /* | 2162 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, 1, 1, 0, /* |
2143 Return t if file FILENAME specifies an absolute path name. | 2163 Return t if file FILENAME specifies an absolute path name. |
2149 Bufbyte *ptr; | 2169 Bufbyte *ptr; |
2150 | 2170 |
2151 CHECK_STRING (filename); | 2171 CHECK_STRING (filename); |
2152 ptr = XSTRING_DATA (filename); | 2172 ptr = XSTRING_DATA (filename); |
2153 return (IS_DIRECTORY_SEP (*ptr) || *ptr == '~' | 2173 return (IS_DIRECTORY_SEP (*ptr) || *ptr == '~' |
2154 #ifdef WIN32_NATIVE | 2174 #ifdef WINDOWSNT |
2155 || (IS_DRIVE (*ptr) && ptr[1] == ':' && IS_DIRECTORY_SEP (ptr[2])) | 2175 || (IS_DRIVE (*ptr) && ptr[1] == ':' && IS_DIRECTORY_SEP (ptr[2])) |
2156 #endif | 2176 #endif |
2157 ) ? Qt : Qnil; | 2177 ) ? Qt : Qnil; |
2158 } | 2178 } |
2159 | 2179 |
2160 /* Return nonzero if file FILENAME exists and can be executed. */ | 2180 /* Return nonzero if file FILENAME exists and can be executed. */ |
2161 | 2181 |
2162 static int | 2182 static int |
2163 check_executable (char *filename) | 2183 check_executable (char *filename) |
2164 { | 2184 { |
2165 #ifdef WIN32_NATIVE | 2185 #ifdef WINDOWSNT |
2166 struct stat st; | 2186 struct stat st; |
2167 if (stat (filename, &st) < 0) | 2187 if (stat (filename, &st) < 0) |
2168 return 0; | 2188 return 0; |
2169 return ((st.st_mode & S_IEXEC) != 0); | 2189 return ((st.st_mode & S_IEXEC) != 0); |
2170 #else /* not WIN32_NATIVE */ | 2190 #else /* not WINDOWSNT */ |
2171 #ifdef HAVE_EACCESS | 2191 #ifdef HAVE_EACCESS |
2172 return eaccess (filename, 1) >= 0; | 2192 return eaccess (filename, 1) >= 0; |
2173 #else | 2193 #else |
2174 /* Access isn't quite right because it uses the real uid | 2194 /* Access isn't quite right because it uses the real uid |
2175 and we really want to test with the effective uid. | 2195 and we really want to test with the effective uid. |
2176 But Unix doesn't give us a right way to do it. */ | 2196 But Unix doesn't give us a right way to do it. */ |
2177 return access (filename, 1) >= 0; | 2197 return access (filename, 1) >= 0; |
2178 #endif /* HAVE_EACCESS */ | 2198 #endif /* HAVE_EACCESS */ |
2179 #endif /* not WIN32_NATIVE */ | 2199 #endif /* not WINDOWSNT */ |
2180 } | 2200 } |
2181 | 2201 |
2182 /* Return nonzero if file FILENAME exists and can be written. */ | 2202 /* Return nonzero if file FILENAME exists and can be written. */ |
2183 | 2203 |
2184 static int | 2204 static int |
2185 check_writable (const char *filename) | 2205 check_writable (CONST char *filename) |
2186 { | 2206 { |
2187 #ifdef HAVE_EACCESS | 2207 #ifdef HAVE_EACCESS |
2188 return (eaccess (filename, 2) >= 0); | 2208 return (eaccess (filename, 2) >= 0); |
2189 #else | 2209 #else |
2190 /* Access isn't quite right because it uses the real uid | 2210 /* Access isn't quite right because it uses the real uid |
2267 call the corresponding file handler. */ | 2287 call the corresponding file handler. */ |
2268 handler = Ffind_file_name_handler (abspath, Qfile_readable_p); | 2288 handler = Ffind_file_name_handler (abspath, Qfile_readable_p); |
2269 if (!NILP (handler)) | 2289 if (!NILP (handler)) |
2270 RETURN_UNGCPRO (call2 (handler, Qfile_readable_p, abspath)); | 2290 RETURN_UNGCPRO (call2 (handler, Qfile_readable_p, abspath)); |
2271 | 2291 |
2272 #if defined(WIN32_NATIVE) || defined(CYGWIN) | 2292 #if defined(WINDOWSNT) || defined(__CYGWIN32__) |
2273 /* Under MS-DOS and Windows, open does not work for directories. */ | 2293 /* Under MS-DOS and Windows, open does not work for directories. */ |
2274 UNGCPRO; | 2294 UNGCPRO; |
2275 if (access (XSTRING_DATA (abspath), 0) == 0) | 2295 if (access (XSTRING_DATA (abspath), 0) == 0) |
2276 return Qt; | 2296 return Qt; |
2277 else | 2297 else |
2278 return Qnil; | 2298 return Qnil; |
2279 #else /* not WIN32_NATIVE */ | 2299 #else /* not WINDOWSNT */ |
2280 { | 2300 { |
2281 int desc = interruptible_open ((char *) XSTRING_DATA (abspath), O_RDONLY | OPEN_BINARY, 0); | 2301 int desc = interruptible_open ((char *) XSTRING_DATA (abspath), O_RDONLY | OPEN_BINARY, 0); |
2282 UNGCPRO; | 2302 UNGCPRO; |
2283 if (desc < 0) | 2303 if (desc < 0) |
2284 return Qnil; | 2304 return Qnil; |
2285 close (desc); | 2305 close (desc); |
2286 return Qt; | 2306 return Qt; |
2287 } | 2307 } |
2288 #endif /* not WIN32_NATIVE */ | 2308 #endif /* not WINDOWSNT */ |
2289 } | 2309 } |
2290 | 2310 |
2291 /* Having this before file-symlink-p mysteriously caused it to be forgotten | 2311 /* Having this before file-symlink-p mysteriously caused it to be forgotten |
2292 on the RT/PC. */ | 2312 on the RT/PC. */ |
2293 DEFUN ("file-writable-p", Ffile_writable_p, 1, 1, 0, /* | 2313 DEFUN ("file-writable-p", Ffile_writable_p, 1, 1, 0, /* |
2331 Otherwise returns nil. | 2351 Otherwise returns nil. |
2332 */ | 2352 */ |
2333 (filename)) | 2353 (filename)) |
2334 { | 2354 { |
2335 /* This function can GC. GC checked 1997.04.10. */ | 2355 /* This function can GC. GC checked 1997.04.10. */ |
2336 /* XEmacs change: run handlers even if local machine doesn't have symlinks */ | |
2337 #ifdef S_IFLNK | 2356 #ifdef S_IFLNK |
2338 char *buf; | 2357 char *buf; |
2339 int bufsize; | 2358 int bufsize; |
2340 int valsize; | 2359 int valsize; |
2341 Lisp_Object val; | 2360 Lisp_Object val; |
2342 #endif | |
2343 Lisp_Object handler; | 2361 Lisp_Object handler; |
2344 struct gcpro gcpro1; | 2362 struct gcpro gcpro1; |
2345 | 2363 |
2346 CHECK_STRING (filename); | 2364 CHECK_STRING (filename); |
2347 filename = Fexpand_file_name (filename, Qnil); | 2365 filename = Fexpand_file_name (filename, Qnil); |
2352 handler = Ffind_file_name_handler (filename, Qfile_symlink_p); | 2370 handler = Ffind_file_name_handler (filename, Qfile_symlink_p); |
2353 UNGCPRO; | 2371 UNGCPRO; |
2354 if (!NILP (handler)) | 2372 if (!NILP (handler)) |
2355 return call2 (handler, Qfile_symlink_p, filename); | 2373 return call2 (handler, Qfile_symlink_p, filename); |
2356 | 2374 |
2357 #ifdef S_IFLNK | |
2358 bufsize = 100; | 2375 bufsize = 100; |
2359 while (1) | 2376 while (1) |
2360 { | 2377 { |
2361 buf = xnew_array_and_zero (char, bufsize); | 2378 buf = xnew_array_and_zero (char, bufsize); |
2362 valsize = readlink ((char *) XSTRING_DATA (filename), | 2379 valsize = readlink ((char *) XSTRING_DATA (filename), |
2428 handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p); | 2445 handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p); |
2429 if (!NILP (handler)) | 2446 if (!NILP (handler)) |
2430 return call2 (handler, Qfile_accessible_directory_p, | 2447 return call2 (handler, Qfile_accessible_directory_p, |
2431 filename); | 2448 filename); |
2432 | 2449 |
2433 #if !defined(WIN32_NATIVE) | 2450 #if !defined(WINDOWSNT) |
2434 if (NILP (Ffile_directory_p (filename))) | 2451 if (NILP (Ffile_directory_p (filename))) |
2435 return (Qnil); | 2452 return (Qnil); |
2436 else | 2453 else |
2437 return Ffile_executable_p (filename); | 2454 return Ffile_executable_p (filename); |
2438 #else | 2455 #else |
2449 tem = (NILP (Ffile_directory_p (filename)) | 2466 tem = (NILP (Ffile_directory_p (filename)) |
2450 || NILP (Ffile_executable_p (filename))); | 2467 || NILP (Ffile_executable_p (filename))); |
2451 UNGCPRO; | 2468 UNGCPRO; |
2452 return tem ? Qnil : Qt; | 2469 return tem ? Qnil : Qt; |
2453 } | 2470 } |
2454 #endif /* !defined(WIN32_NATIVE) */ | 2471 #endif /* !defined(WINDOWSNT) */ |
2455 } | 2472 } |
2456 | 2473 |
2457 DEFUN ("file-regular-p", Ffile_regular_p, 1, 1, 0, /* | 2474 DEFUN ("file-regular-p", Ffile_regular_p, 1, 1, 0, /* |
2458 Return t if file FILENAME is the name of a regular file. | 2475 Return t if file FILENAME is the name of a regular file. |
2459 This is the sort of file that holds an ordinary stream of data bytes. | 2476 This is the sort of file that holds an ordinary stream of data bytes. |
2509 | 2526 |
2510 if (stat ((char *) XSTRING_DATA (abspath), &st) < 0) | 2527 if (stat ((char *) XSTRING_DATA (abspath), &st) < 0) |
2511 return Qnil; | 2528 return Qnil; |
2512 /* Syncing with FSF 19.34.6 note: not in FSF, #if 0'ed out here. */ | 2529 /* Syncing with FSF 19.34.6 note: not in FSF, #if 0'ed out here. */ |
2513 #if 0 | 2530 #if 0 |
2514 #ifdef WIN32_NATIVE | 2531 #ifdef DOS_NT |
2515 if (check_executable (XSTRING_DATA (abspath))) | 2532 if (check_executable (XSTRING_DATA (abspath))) |
2516 st.st_mode |= S_IEXEC; | 2533 st.st_mode |= S_IEXEC; |
2517 #endif /* WIN32_NATIVE */ | 2534 #endif /* DOS_NT */ |
2518 #endif /* 0 */ | 2535 #endif /* 0 */ |
2519 | 2536 |
2520 return make_int (st.st_mode & 07777); | 2537 return make_int (st.st_mode & 07777); |
2521 } | 2538 } |
2522 | 2539 |
2586 DEFUN ("unix-sync", Funix_sync, 0, 0, "", /* | 2603 DEFUN ("unix-sync", Funix_sync, 0, 0, "", /* |
2587 Tell Unix to finish all pending disk updates. | 2604 Tell Unix to finish all pending disk updates. |
2588 */ | 2605 */ |
2589 ()) | 2606 ()) |
2590 { | 2607 { |
2591 #ifndef WIN32_NATIVE | 2608 #ifndef WINDOWSNT |
2592 sync (); | 2609 sync (); |
2593 #endif | 2610 #endif |
2594 return Qnil; | 2611 return Qnil; |
2595 } | 2612 } |
2596 | 2613 |
2722 if ( (!NILP (beg) || !NILP (end)) && !NILP (visit) ) | 2739 if ( (!NILP (beg) || !NILP (end)) && !NILP (visit) ) |
2723 error ("Attempt to visit less than an entire file"); | 2740 error ("Attempt to visit less than an entire file"); |
2724 | 2741 |
2725 fd = -1; | 2742 fd = -1; |
2726 | 2743 |
2727 if (stat ((char *) XSTRING_DATA (filename), &st) < 0) | 2744 if ( |
2745 #ifndef APOLLO | |
2746 (stat ((char *) XSTRING_DATA (filename), &st) < 0) | |
2747 #else /* APOLLO */ | |
2748 /* Don't even bother with interruptible_open. APOLLO sucks. */ | |
2749 ((fd = open ((char *) XSTRING_DATA (filename), O_RDONLY | OPEN_BINARY, 0)) < 0 | |
2750 || fstat (fd, &st) < 0) | |
2751 #endif /* APOLLO */ | |
2752 ) | |
2728 { | 2753 { |
2729 if (fd >= 0) close (fd); | 2754 if (fd >= 0) close (fd); |
2730 badopen: | 2755 badopen: |
2731 if (NILP (visit)) | 2756 if (NILP (visit)) |
2732 report_file_error ("Opening input file", list1 (filename)); | 2757 report_file_error ("Opening input file", list1 (filename)); |
2957 /* No need to limit the amount of stuff we attempt to read. (It would | 2982 /* No need to limit the amount of stuff we attempt to read. (It would |
2958 be incorrect, anyway, when Mule is enabled.) Instead, the limiting | 2983 be incorrect, anyway, when Mule is enabled.) Instead, the limiting |
2959 occurs inside of the filedesc stream. */ | 2984 occurs inside of the filedesc stream. */ |
2960 while (1) | 2985 while (1) |
2961 { | 2986 { |
2962 ssize_t this_len; | 2987 Bytecount this_len; |
2963 Charcount cc_inserted; | 2988 Charcount cc_inserted; |
2964 | 2989 |
2965 QUIT; | 2990 QUIT; |
2966 this_len = Lstream_read (XLSTREAM (stream), read_buf, | 2991 this_len = Lstream_read (XLSTREAM (stream), read_buf, |
2967 sizeof (read_buf)); | 2992 sizeof (read_buf)); |
3006 | 3031 |
3007 if (!NILP (visit)) | 3032 if (!NILP (visit)) |
3008 { | 3033 { |
3009 if (!EQ (buf->undo_list, Qt)) | 3034 if (!EQ (buf->undo_list, Qt)) |
3010 buf->undo_list = Qnil; | 3035 buf->undo_list = Qnil; |
3036 #ifdef APOLLO | |
3037 stat ((char *) XSTRING_DATA (filename), &st); | |
3038 #endif | |
3011 if (NILP (handler)) | 3039 if (NILP (handler)) |
3012 { | 3040 { |
3013 buf->modtime = st.st_mtime; | 3041 buf->modtime = st.st_mtime; |
3014 buf->filename = filename; | 3042 buf->filename = filename; |
3015 /* XEmacs addition: */ | 3043 /* XEmacs addition: */ |
3218 desc = open ((char *) XSTRING_DATA (fn), O_WRONLY | OPEN_BINARY, 0); | 3246 desc = open ((char *) XSTRING_DATA (fn), O_WRONLY | OPEN_BINARY, 0); |
3219 } | 3247 } |
3220 if (desc < 0) | 3248 if (desc < 0) |
3221 { | 3249 { |
3222 desc = open ((char *) XSTRING_DATA (fn), | 3250 desc = open ((char *) XSTRING_DATA (fn), |
3223 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY, | 3251 (O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY), |
3224 auto_saving ? auto_save_mode_bits : CREAT_MODE); | 3252 ((auto_saving) ? auto_save_mode_bits : CREAT_MODE)); |
3225 } | 3253 } |
3226 | 3254 |
3227 if (desc < 0) | 3255 if (desc < 0) |
3228 { | 3256 { |
3229 #ifdef CLASH_DETECTION | 3257 #ifdef CLASH_DETECTION |
3311 failure = 1; | 3339 failure = 1; |
3312 save_errno = errno; | 3340 save_errno = errno; |
3313 } | 3341 } |
3314 #endif /* HAVE_FSYNC */ | 3342 #endif /* HAVE_FSYNC */ |
3315 | 3343 |
3316 /* Spurious "file has changed on disk" warnings used to be seen on | 3344 /* Spurious "file has changed on disk" warnings have been |
3317 systems where close() can change the modtime. This is known to | 3345 observed on Suns as well. |
3318 happen on various NFS file systems, on Windows, and on Linux. | 3346 It seems that `close' can change the modtime, under nfs. |
3319 Rather than handling this on a per-system basis, we | 3347 |
3320 unconditionally do the stat() after the close(). */ | 3348 (This has supposedly been fixed in Sunos 4, |
3349 but who knows about all the other machines with NFS?) */ | |
3350 /* On VMS and APOLLO, must do the stat after the close | |
3351 since closing changes the modtime. */ | |
3352 /* As it does on Windows too - kkm */ | |
3353 /* The spurious warnings appear on Linux too. Rather than handling | |
3354 this on a per-system basis, unconditionally do the stat after the close - cgw */ | |
3355 | |
3356 #if 0 /* !defined (WINDOWSNT) */ /* !defined (VMS) && !defined (APOLLO) */ | |
3357 fstat (desc, &st); | |
3358 #endif | |
3321 | 3359 |
3322 /* NFS can report a write failure now. */ | 3360 /* NFS can report a write failure now. */ |
3323 if (close (desc) < 0) | 3361 if (close (desc) < 0) |
3324 { | 3362 { |
3325 failure = 1; | 3363 failure = 1; |
3331 as necessary). */ | 3369 as necessary). */ |
3332 XCAR (desc_locative) = Qnil; | 3370 XCAR (desc_locative) = Qnil; |
3333 unbind_to (speccount, Qnil); | 3371 unbind_to (speccount, Qnil); |
3334 } | 3372 } |
3335 | 3373 |
3374 /* # if defined (WINDOWSNT) */ /* defined (VMS) || defined (APOLLO) */ | |
3336 stat ((char *) XSTRING_DATA (fn), &st); | 3375 stat ((char *) XSTRING_DATA (fn), &st); |
3376 /* #endif */ | |
3337 | 3377 |
3338 #ifdef CLASH_DETECTION | 3378 #ifdef CLASH_DETECTION |
3339 if (!auto_saving) | 3379 if (!auto_saving) |
3340 unlock_file (lockname); | 3380 unlock_file (lockname); |
3341 #endif /* CLASH_DETECTION */ | 3381 #endif /* CLASH_DETECTION */ |
3867 if (minibuf_level != 0 || preparing_for_armageddon) | 3907 if (minibuf_level != 0 || preparing_for_armageddon) |
3868 no_message = Qt; | 3908 no_message = Qt; |
3869 | 3909 |
3870 run_hook (Qauto_save_hook); | 3910 run_hook (Qauto_save_hook); |
3871 | 3911 |
3872 if (STRINGP (Vauto_save_list_file_name)) | 3912 if (GC_STRINGP (Vauto_save_list_file_name)) |
3873 listfile = condition_case_1 (Qt, | 3913 listfile = condition_case_1 (Qt, |
3874 auto_save_expand_name, | 3914 auto_save_expand_name, |
3875 Vauto_save_list_file_name, | 3915 Vauto_save_list_file_name, |
3876 auto_save_expand_name_error, Qnil); | 3916 auto_save_expand_name_error, Qnil); |
3877 | 3917 |
3886 autosave perfectly ordinary files because it couldn't handle some | 3926 autosave perfectly ordinary files because it couldn't handle some |
3887 ange-ftp'd file. */ | 3927 ange-ftp'd file. */ |
3888 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++) | 3928 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++) |
3889 { | 3929 { |
3890 for (tail = Vbuffer_alist; | 3930 for (tail = Vbuffer_alist; |
3891 CONSP (tail); | 3931 GC_CONSP (tail); |
3892 tail = XCDR (tail)) | 3932 tail = XCDR (tail)) |
3893 { | 3933 { |
3894 buf = XCDR (XCAR (tail)); | 3934 buf = XCDR (XCAR (tail)); |
3895 b = XBUFFER (buf); | 3935 b = XBUFFER (buf); |
3896 | 3936 |
3897 if (!NILP (current_only) | 3937 if (!GC_NILP (current_only) |
3898 && b != current_buffer) | 3938 && b != current_buffer) |
3899 continue; | 3939 continue; |
3900 | 3940 |
3901 /* Don't auto-save indirect buffers. | 3941 /* Don't auto-save indirect buffers. |
3902 The base buffer takes care of it. */ | 3942 The base buffer takes care of it. */ |
3904 continue; | 3944 continue; |
3905 | 3945 |
3906 /* Check for auto save enabled | 3946 /* Check for auto save enabled |
3907 and file changed since last auto save | 3947 and file changed since last auto save |
3908 and file changed since last real save. */ | 3948 and file changed since last real save. */ |
3909 if (STRINGP (b->auto_save_file_name) | 3949 if (GC_STRINGP (b->auto_save_file_name) |
3910 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b) | 3950 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b) |
3911 && b->auto_save_modified < BUF_MODIFF (b) | 3951 && b->auto_save_modified < BUF_MODIFF (b) |
3912 /* -1 means we've turned off autosaving for a while--see below. */ | 3952 /* -1 means we've turned off autosaving for a while--see below. */ |
3913 && XINT (b->saved_size) >= 0 | 3953 && XINT (b->saved_size) >= 0 |
3914 && (do_handled_files | 3954 && (do_handled_files |
3949 if (!gc_in_progress) | 3989 if (!gc_in_progress) |
3950 Fsleep_for (make_int (1)); | 3990 Fsleep_for (make_int (1)); |
3951 continue; | 3991 continue; |
3952 } | 3992 } |
3953 set_buffer_internal (b); | 3993 set_buffer_internal (b); |
3954 if (!auto_saved && NILP (no_message)) | 3994 if (!auto_saved && GC_NILP (no_message)) |
3955 { | 3995 { |
3956 static const unsigned char *msg | 3996 static CONST unsigned char *msg |
3957 = (const unsigned char *) "Auto-saving..."; | 3997 = (CONST unsigned char *) "Auto-saving..."; |
3958 echo_area_message (selected_frame (), msg, Qnil, | 3998 echo_area_message (selected_frame (), msg, Qnil, |
3959 0, strlen ((const char *) msg), | 3999 0, strlen ((CONST char *) msg), |
3960 Qauto_saving); | 4000 Qauto_saving); |
3961 } | 4001 } |
3962 | 4002 |
3963 /* Open the auto-save list file, if necessary. | 4003 /* Open the auto-save list file, if necessary. |
3964 We only do this now so that the file only exists | 4004 We only do this now so that the file only exists |
3965 if we actually auto-saved any files. */ | 4005 if we actually auto-saved any files. */ |
3966 if (!auto_saved && STRINGP (listfile) && listdesc < 0) | 4006 if (!auto_saved && GC_STRINGP (listfile) && listdesc < 0) |
3967 { | 4007 { |
3968 listdesc = open ((char *) XSTRING_DATA (listfile), | 4008 listdesc = open ((char *) XSTRING_DATA (listfile), |
3969 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY, | 4009 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY, |
3970 CREAT_MODE); | 4010 CREAT_MODE); |
3971 | 4011 |
3980 the special file that lists them. For each of | 4020 the special file that lists them. For each of |
3981 these buffers, record visited name (if any) and | 4021 these buffers, record visited name (if any) and |
3982 auto save name. */ | 4022 auto save name. */ |
3983 if (listdesc >= 0) | 4023 if (listdesc >= 0) |
3984 { | 4024 { |
3985 const Extbyte *auto_save_file_name_ext; | 4025 CONST Extbyte *auto_save_file_name_ext; |
3986 Extcount auto_save_file_name_ext_len; | 4026 Extcount auto_save_file_name_ext_len; |
3987 | 4027 |
3988 TO_EXTERNAL_FORMAT (LISP_STRING, b->auto_save_file_name, | 4028 GET_STRING_FILENAME_DATA_ALLOCA |
3989 ALLOCA, (auto_save_file_name_ext, | 4029 (b->auto_save_file_name, |
3990 auto_save_file_name_ext_len), | 4030 auto_save_file_name_ext, |
3991 Qfile_name); | 4031 auto_save_file_name_ext_len); |
3992 if (!NILP (b->filename)) | 4032 if (!NILP (b->filename)) |
3993 { | 4033 { |
3994 const Extbyte *filename_ext; | 4034 CONST Extbyte *filename_ext; |
3995 Extcount filename_ext_len; | 4035 Extcount filename_ext_len; |
3996 | 4036 |
3997 TO_EXTERNAL_FORMAT (LISP_STRING, b->filename, | 4037 GET_STRING_FILENAME_DATA_ALLOCA (b->filename, |
3998 ALLOCA, (filename_ext, | 4038 filename_ext, |
3999 filename_ext_len), | 4039 filename_ext_len); |
4000 Qfile_name); | |
4001 write (listdesc, filename_ext, filename_ext_len); | 4040 write (listdesc, filename_ext, filename_ext_len); |
4002 } | 4041 } |
4003 write (listdesc, "\n", 1); | 4042 write (listdesc, "\n", 1); |
4004 write (listdesc, auto_save_file_name_ext, | 4043 write (listdesc, auto_save_file_name_ext, |
4005 auto_save_file_name_ext_len); | 4044 auto_save_file_name_ext_len); |
4051 | 4090 |
4052 /* If we didn't save anything into the listfile, remove the old | 4091 /* If we didn't save anything into the listfile, remove the old |
4053 one because nothing needed to be auto-saved. Do this afterwards | 4092 one because nothing needed to be auto-saved. Do this afterwards |
4054 rather than before in case we get a crash attempting to autosave | 4093 rather than before in case we get a crash attempting to autosave |
4055 (in that case we'd still want the old one around). */ | 4094 (in that case we'd still want the old one around). */ |
4056 if (listdesc < 0 && !auto_saved && STRINGP (listfile)) | 4095 if (listdesc < 0 && !auto_saved && GC_STRINGP (listfile)) |
4057 unlink ((char *) XSTRING_DATA (listfile)); | 4096 unlink ((char *) XSTRING_DATA (listfile)); |
4058 | 4097 |
4059 /* Show "...done" only if the echo area would otherwise be empty. */ | 4098 /* Show "...done" only if the echo area would otherwise be empty. */ |
4060 if (auto_saved && NILP (no_message) | 4099 if (auto_saved && NILP (no_message) |
4061 && NILP (clear_echo_area (selected_frame (), Qauto_saving, 0))) | 4100 && NILP (clear_echo_area (selected_frame (), Qauto_saving, 0))) |
4062 { | 4101 { |
4063 static const unsigned char *msg | 4102 static CONST unsigned char *msg |
4064 = (const unsigned char *)"Auto-saving...done"; | 4103 = (CONST unsigned char *)"Auto-saving...done"; |
4065 echo_area_message (selected_frame (), msg, Qnil, 0, | 4104 echo_area_message (selected_frame (), msg, Qnil, 0, |
4066 strlen ((const char *) msg), Qauto_saving); | 4105 strlen ((CONST char *) msg), Qauto_saving); |
4067 } | 4106 } |
4068 | 4107 |
4069 Vquit_flag = oquit; | 4108 Vquit_flag = oquit; |
4070 | 4109 |
4071 RETURN_UNGCPRO (unbind_to (speccount, Qnil)); | 4110 RETURN_UNGCPRO (unbind_to (speccount, Qnil)); |
4139 defsymbol (&Qwrite_region, "write-region"); | 4178 defsymbol (&Qwrite_region, "write-region"); |
4140 defsymbol (&Qverify_visited_file_modtime, "verify-visited-file-modtime"); | 4179 defsymbol (&Qverify_visited_file_modtime, "verify-visited-file-modtime"); |
4141 defsymbol (&Qset_visited_file_modtime, "set-visited-file-modtime"); | 4180 defsymbol (&Qset_visited_file_modtime, "set-visited-file-modtime"); |
4142 defsymbol (&Qcar_less_than_car, "car-less-than-car"); /* Vomitous! */ | 4181 defsymbol (&Qcar_less_than_car, "car-less-than-car"); /* Vomitous! */ |
4143 | 4182 |
4183 defsymbol (&Qfile_name_handler_alist, "file-name-handler-alist"); | |
4144 defsymbol (&Qauto_save_hook, "auto-save-hook"); | 4184 defsymbol (&Qauto_save_hook, "auto-save-hook"); |
4145 defsymbol (&Qauto_save_error, "auto-save-error"); | 4185 defsymbol (&Qauto_save_error, "auto-save-error"); |
4146 defsymbol (&Qauto_saving, "auto-saving"); | 4186 defsymbol (&Qauto_saving, "auto-saving"); |
4147 | 4187 |
4148 defsymbol (&Qformat_decode, "format-decode"); | 4188 defsymbol (&Qformat_decode, "format-decode"); |
4168 DEFSUBR (Fmake_directory_internal); | 4208 DEFSUBR (Fmake_directory_internal); |
4169 DEFSUBR (Fdelete_directory); | 4209 DEFSUBR (Fdelete_directory); |
4170 DEFSUBR (Fdelete_file); | 4210 DEFSUBR (Fdelete_file); |
4171 DEFSUBR (Frename_file); | 4211 DEFSUBR (Frename_file); |
4172 DEFSUBR (Fadd_name_to_file); | 4212 DEFSUBR (Fadd_name_to_file); |
4213 #ifdef S_IFLNK | |
4173 DEFSUBR (Fmake_symbolic_link); | 4214 DEFSUBR (Fmake_symbolic_link); |
4215 #endif /* S_IFLNK */ | |
4174 #ifdef HPUX_NET | 4216 #ifdef HPUX_NET |
4175 DEFSUBR (Fsysnetunam); | 4217 DEFSUBR (Fsysnetunam); |
4176 #endif /* HPUX_NET */ | 4218 #endif /* HPUX_NET */ |
4177 DEFSUBR (Ffile_name_absolute_p); | 4219 DEFSUBR (Ffile_name_absolute_p); |
4178 DEFSUBR (Ffile_exists_p); | 4220 DEFSUBR (Ffile_exists_p); |
4294 The value should be either ?/ or ?\\ (any other value is treated as ?\\). | 4336 The value should be either ?/ or ?\\ (any other value is treated as ?\\). |
4295 This variable affects the built-in functions only on Windows, | 4337 This variable affects the built-in functions only on Windows, |
4296 on other platforms, it is initialized so that Lisp code can find out | 4338 on other platforms, it is initialized so that Lisp code can find out |
4297 what the normal separator is. | 4339 what the normal separator is. |
4298 */ ); | 4340 */ ); |
4299 #ifdef WIN32_NATIVE | |
4300 Vdirectory_sep_char = make_char ('\\'); | |
4301 #else | |
4302 Vdirectory_sep_char = make_char ('/'); | 4341 Vdirectory_sep_char = make_char ('/'); |
4303 #endif | 4342 } |
4304 | |
4305 reinit_vars_of_fileio (); | |
4306 } | |
4307 | |
4308 void | |
4309 reinit_vars_of_fileio (void) | |
4310 { | |
4311 /* We want temp_name_rand to be initialized to a value likely to be | |
4312 unique to the process, not to the executable. The danger is that | |
4313 two different XEmacs processes using the same binary on different | |
4314 machines creating temp files in the same directory will be | |
4315 unlucky enough to have the same pid. If we randomize using | |
4316 process startup time, then in practice they will be unlikely to | |
4317 collide. We use the microseconds field so that scripts that start | |
4318 simultaneous XEmacs processes on multiple machines will have less | |
4319 chance of collision. */ | |
4320 { | |
4321 EMACS_TIME thyme; | |
4322 | |
4323 EMACS_GET_TIME (thyme); | |
4324 temp_name_rand = (unsigned int) (EMACS_SECS (thyme) ^ EMACS_USECS (thyme)); | |
4325 } | |
4326 } |