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