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