1 /* File IO for GNU Emacs.
2 Copyright (C) 1985,86,87,88,93,94,95,96,1997 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
23 #if defined (USG5) || defined (BSD_SYSTEM) || defined (LINUX)
28 #include <sys/types.h>
35 #if !defined (S_ISLNK) && defined (S_IFLNK)
36 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
39 #if !defined (S_ISFIFO) && defined (S_IFIFO)
40 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
43 #if !defined (S_ISREG) && defined (S_IFREG)
44 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
55 #include <sys/param.h>
77 extern char *strerror ();
94 #include "intervals.h"
105 #endif /* not WINDOWSNT */
108 #define CORRECT_DIR_SEPS(s) \
109 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
110 else unixtodos_filename (s); \
112 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
113 redirector allows the six letters between 'Z' and 'a' as well. */
115 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
118 #define IS_DRIVE(x) isalpha (x)
120 /* Need to lower-case the drive letter, or else expanded
121 filenames will sometimes compare inequal, because
122 `expand-file-name' doesn't always down-case the drive letter. */
123 #define DRIVE_LETTER(x) (tolower (x))
152 #define min(a, b) ((a) < (b) ? (a) : (b))
153 #define max(a, b) ((a) > (b) ? (a) : (b))
155 /* Nonzero during writing of auto-save files */
158 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
159 a new file with the same mode as the original */
160 int auto_save_mode_bits
;
162 /* Alist of elements (REGEXP . HANDLER) for file names
163 whose I/O is done with a special handler. */
164 Lisp_Object Vfile_name_handler_alist
;
166 /* Format for auto-save files */
167 Lisp_Object Vauto_save_file_format
;
169 /* Lisp functions for translating file formats */
170 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
172 /* Functions to be called to process text properties in inserted file. */
173 Lisp_Object Vafter_insert_file_functions
;
175 /* Functions to be called to create text property annotations for file. */
176 Lisp_Object Vwrite_region_annotate_functions
;
178 /* During build_annotations, each time an annotation function is called,
179 this holds the annotations made by the previous functions. */
180 Lisp_Object Vwrite_region_annotations_so_far
;
182 /* File name in which we write a list of all our auto save files. */
183 Lisp_Object Vauto_save_list_file_name
;
185 /* Nonzero means, when reading a filename in the minibuffer,
186 start out by inserting the default directory into the minibuffer. */
187 int insert_default_directory
;
189 /* On VMS, nonzero means write new files with record format stmlf.
190 Zero means use var format. */
193 /* On NT, specifies the directory separator character, used (eg.) when
194 expanding file names. This can be bound to / or \. */
195 Lisp_Object Vdirectory_sep_char
;
197 extern Lisp_Object Vuser_login_name
;
199 extern int minibuf_level
;
201 extern int minibuffer_auto_raise
;
203 /* These variables describe handlers that have "already" had a chance
204 to handle the current operation.
206 Vinhibit_file_name_handlers is a list of file name handlers.
207 Vinhibit_file_name_operation is the operation being handled.
208 If we try to handle that operation, we ignore those handlers. */
210 static Lisp_Object Vinhibit_file_name_handlers
;
211 static Lisp_Object Vinhibit_file_name_operation
;
213 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
215 Lisp_Object Qfile_name_history
;
217 Lisp_Object Qcar_less_than_car
;
219 report_file_error (string
, data
)
223 Lisp_Object errstring
;
225 errstring
= build_string (strerror (errno
));
227 /* System error messages are capitalized. Downcase the initial
228 unless it is followed by a slash. */
229 if (XSTRING (errstring
)->data
[1] != '/')
230 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
233 Fsignal (Qfile_error
,
234 Fcons (build_string (string
), Fcons (errstring
, data
)));
237 close_file_unwind (fd
)
240 close (XFASTINT (fd
));
243 /* Restore point, having saved it as a marker. */
245 restore_point_unwind (location
)
246 Lisp_Object location
;
248 SET_PT (marker_position (location
));
249 Fset_marker (location
, Qnil
, Qnil
);
252 Lisp_Object Qexpand_file_name
;
253 Lisp_Object Qsubstitute_in_file_name
;
254 Lisp_Object Qdirectory_file_name
;
255 Lisp_Object Qfile_name_directory
;
256 Lisp_Object Qfile_name_nondirectory
;
257 Lisp_Object Qunhandled_file_name_directory
;
258 Lisp_Object Qfile_name_as_directory
;
259 Lisp_Object Qcopy_file
;
260 Lisp_Object Qmake_directory_internal
;
261 Lisp_Object Qdelete_directory
;
262 Lisp_Object Qdelete_file
;
263 Lisp_Object Qrename_file
;
264 Lisp_Object Qadd_name_to_file
;
265 Lisp_Object Qmake_symbolic_link
;
266 Lisp_Object Qfile_exists_p
;
267 Lisp_Object Qfile_executable_p
;
268 Lisp_Object Qfile_readable_p
;
269 Lisp_Object Qfile_writable_p
;
270 Lisp_Object Qfile_symlink_p
;
271 Lisp_Object Qaccess_file
;
272 Lisp_Object Qfile_directory_p
;
273 Lisp_Object Qfile_regular_p
;
274 Lisp_Object Qfile_accessible_directory_p
;
275 Lisp_Object Qfile_modes
;
276 Lisp_Object Qset_file_modes
;
277 Lisp_Object Qfile_newer_than_file_p
;
278 Lisp_Object Qinsert_file_contents
;
279 Lisp_Object Qwrite_region
;
280 Lisp_Object Qverify_visited_file_modtime
;
281 Lisp_Object Qset_visited_file_modtime
;
283 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
284 "Return FILENAME's handler function for OPERATION, if it has one.\n\
285 Otherwise, return nil.\n\
286 A file name is handled if one of the regular expressions in\n\
287 `file-name-handler-alist' matches it.\n\n\
288 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
289 any handlers that are members of `inhibit-file-name-handlers',\n\
290 but we still do run any other handlers. This lets handlers\n\
291 use the standard functions without calling themselves recursively.")
292 (filename
, operation
)
293 Lisp_Object filename
, operation
;
295 /* This function must not munge the match data. */
296 Lisp_Object chain
, inhibited_handlers
;
298 CHECK_STRING (filename
, 0);
300 if (EQ (operation
, Vinhibit_file_name_operation
))
301 inhibited_handlers
= Vinhibit_file_name_handlers
;
303 inhibited_handlers
= Qnil
;
305 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
306 chain
= XCONS (chain
)->cdr
)
309 elt
= XCONS (chain
)->car
;
313 string
= XCONS (elt
)->car
;
314 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
316 Lisp_Object handler
, tem
;
318 handler
= XCONS (elt
)->cdr
;
319 tem
= Fmemq (handler
, inhibited_handlers
);
330 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
332 "Return the directory component in file name FILENAME.\n\
333 Return nil if FILENAME does not include a directory.\n\
334 Otherwise return a directory spec.\n\
335 Given a Unix syntax file name, returns a string ending in slash;\n\
336 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
338 Lisp_Object filename
;
340 register unsigned char *beg
;
341 register unsigned char *p
;
344 CHECK_STRING (filename
, 0);
346 /* If the file name has special constructs in it,
347 call the corresponding file handler. */
348 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
350 return call2 (handler
, Qfile_name_directory
, filename
);
352 #ifdef FILE_SYSTEM_CASE
353 filename
= FILE_SYSTEM_CASE (filename
);
355 beg
= XSTRING (filename
)->data
;
357 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
359 p
= beg
+ XSTRING (filename
)->size
;
361 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
363 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
366 /* only recognise drive specifier at beginning */
367 && !(p
[-1] == ':' && p
== beg
+ 2)
374 /* Expansion of "c:" to drive and default directory. */
375 if (p
== beg
+ 2 && beg
[1] == ':')
377 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
378 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
379 if (getdefdir (toupper (*beg
) - 'A' + 1, res
))
381 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
384 p
= beg
+ strlen (beg
);
387 CORRECT_DIR_SEPS (beg
);
389 return make_string (beg
, p
- beg
);
392 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
394 "Return file name FILENAME sans its directory.\n\
395 For example, in a Unix-syntax file name,\n\
396 this is everything after the last slash,\n\
397 or the entire name if it contains no slash.")
399 Lisp_Object filename
;
401 register unsigned char *beg
, *p
, *end
;
404 CHECK_STRING (filename
, 0);
406 /* If the file name has special constructs in it,
407 call the corresponding file handler. */
408 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
410 return call2 (handler
, Qfile_name_nondirectory
, filename
);
412 beg
= XSTRING (filename
)->data
;
413 end
= p
= beg
+ XSTRING (filename
)->size
;
415 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
417 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
420 /* only recognise drive specifier at beginning */
421 && !(p
[-1] == ':' && p
== beg
+ 2)
425 return make_string (p
, end
- p
);
428 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
, Sunhandled_file_name_directory
, 1, 1, 0,
429 "Return a directly usable directory name somehow associated with FILENAME.\n\
430 A `directly usable' directory name is one that may be used without the\n\
431 intervention of any file handler.\n\
432 If FILENAME is a directly usable file itself, return\n\
433 (file-name-directory FILENAME).\n\
434 The `call-process' and `start-process' functions use this function to\n\
435 get a current directory to run processes in.")
437 Lisp_Object filename
;
441 /* If the file name has special constructs in it,
442 call the corresponding file handler. */
443 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
445 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
447 return Ffile_name_directory (filename
);
452 file_name_as_directory (out
, in
)
455 int size
= strlen (in
) - 1;
460 /* Is it already a directory string? */
461 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
463 /* Is it a VMS directory file name? If so, hack VMS syntax. */
464 else if (! index (in
, '/')
465 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
466 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
467 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
468 || ! strncmp (&in
[size
- 5], ".dir", 4))
469 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
470 && in
[size
] == '1')))
472 register char *p
, *dot
;
476 dir:x.dir --> dir:[x]
477 dir:[x]y.dir --> dir:[x.y] */
479 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
482 strncpy (out
, in
, p
- in
);
501 dot
= index (p
, '.');
504 /* blindly remove any extension */
505 size
= strlen (out
) + (dot
- p
);
506 strncat (out
, p
, dot
- p
);
517 /* For Unix syntax, Append a slash if necessary */
518 if (!IS_DIRECTORY_SEP (out
[size
]))
520 out
[size
+ 1] = DIRECTORY_SEP
;
521 out
[size
+ 2] = '\0';
524 CORRECT_DIR_SEPS (out
);
530 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
531 Sfile_name_as_directory
, 1, 1, 0,
532 "Return a string representing file FILENAME interpreted as a directory.\n\
533 This operation exists because a directory is also a file, but its name as\n\
534 a directory is different from its name as a file.\n\
535 The result can be used as the value of `default-directory'\n\
536 or passed as second argument to `expand-file-name'.\n\
537 For a Unix-syntax file name, just appends a slash.\n\
538 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
545 CHECK_STRING (file
, 0);
549 /* If the file name has special constructs in it,
550 call the corresponding file handler. */
551 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
553 return call2 (handler
, Qfile_name_as_directory
, file
);
555 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
556 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
560 * Convert from directory name to filename.
562 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
563 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
564 * On UNIX, it's simple: just make sure there isn't a terminating /
566 * Value is nonzero if the string output is different from the input.
569 directory_file_name (src
, dst
)
577 struct FAB fab
= cc$rms_fab
;
578 struct NAM nam
= cc$rms_nam
;
579 char esa
[NAM$C_MAXRSS
];
584 if (! index (src
, '/')
585 && (src
[slen
- 1] == ']'
586 || src
[slen
- 1] == ':'
587 || src
[slen
- 1] == '>'))
589 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
591 fab
.fab$b_fns
= slen
;
592 fab
.fab$l_nam
= &nam
;
593 fab
.fab$l_fop
= FAB$M_NAM
;
596 nam
.nam$b_ess
= sizeof esa
;
597 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
599 /* We call SYS$PARSE to handle such things as [--] for us. */
600 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
602 slen
= nam
.nam$b_esl
;
603 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
608 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
610 /* what about when we have logical_name:???? */
611 if (src
[slen
- 1] == ':')
612 { /* Xlate logical name and see what we get */
613 ptr
= strcpy (dst
, src
); /* upper case for getenv */
616 if ('a' <= *ptr
&& *ptr
<= 'z')
620 dst
[slen
- 1] = 0; /* remove colon */
621 if (!(src
= egetenv (dst
)))
623 /* should we jump to the beginning of this procedure?
624 Good points: allows us to use logical names that xlate
626 Bad points: can be a problem if we just translated to a device
628 For now, I'll punt and always expect VMS names, and hope for
631 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
632 { /* no recursion here! */
638 { /* not a directory spec */
643 bracket
= src
[slen
- 1];
645 /* If bracket is ']' or '>', bracket - 2 is the corresponding
647 ptr
= index (src
, bracket
- 2);
649 { /* no opening bracket */
653 if (!(rptr
= rindex (src
, '.')))
656 strncpy (dst
, src
, slen
);
660 dst
[slen
++] = bracket
;
665 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
666 then translate the device and recurse. */
667 if (dst
[slen
- 1] == ':'
668 && dst
[slen
- 2] != ':' /* skip decnet nodes */
669 && strcmp (src
+ slen
, "[000000]") == 0)
671 dst
[slen
- 1] = '\0';
672 if ((ptr
= egetenv (dst
))
673 && (rlen
= strlen (ptr
) - 1) > 0
674 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
675 && ptr
[rlen
- 1] == '.')
677 char * buf
= (char *) alloca (strlen (ptr
) + 1);
681 return directory_file_name (buf
, dst
);
686 strcat (dst
, "[000000]");
690 rlen
= strlen (rptr
) - 1;
691 strncat (dst
, rptr
, rlen
);
692 dst
[slen
+ rlen
] = '\0';
693 strcat (dst
, ".DIR.1");
697 /* Process as Unix format: just remove any final slash.
698 But leave "/" unchanged; do not change it to "". */
701 /* Handle // as root for apollo's. */
702 if ((slen
> 2 && dst
[slen
- 1] == '/')
703 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
707 && IS_DIRECTORY_SEP (dst
[slen
- 1])
709 && !IS_ANY_SEP (dst
[slen
- 2])
715 CORRECT_DIR_SEPS (dst
);
720 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
722 "Returns the file name of the directory named DIRECTORY.\n\
723 This is the name of the file that holds the data for the directory DIRECTORY.\n\
724 This operation exists because a directory is also a file, but its name as\n\
725 a directory is different from its name as a file.\n\
726 In Unix-syntax, this function just removes the final slash.\n\
727 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
728 it returns a file name such as \"[X]Y.DIR.1\".")
730 Lisp_Object directory
;
735 CHECK_STRING (directory
, 0);
737 if (NILP (directory
))
740 /* If the file name has special constructs in it,
741 call the corresponding file handler. */
742 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
744 return call2 (handler
, Qdirectory_file_name
, directory
);
747 /* 20 extra chars is insufficient for VMS, since we might perform a
748 logical name translation. an equivalence string can be up to 255
749 chars long, so grab that much extra space... - sss */
750 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
752 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
754 directory_file_name (XSTRING (directory
)->data
, buf
);
755 return build_string (buf
);
758 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
759 "Generate temporary file name (string) starting with PREFIX (a string).\n\
760 The Emacs process number forms part of the result,\n\
761 so there is no danger of generating a name being used by another process.")
767 /* Don't use too many characters of the restricted 8+3 DOS
769 val
= concat2 (prefix
, build_string ("a.XXX"));
771 val
= concat2 (prefix
, build_string ("XXXXXX"));
773 mktemp (XSTRING (val
)->data
);
775 CORRECT_DIR_SEPS (XSTRING (val
)->data
);
780 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
781 "Convert filename NAME to absolute, and canonicalize it.\n\
782 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative\n\
783 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,\n\
784 the current buffer's value of default-directory is used.\n\
785 File name components that are `.' are removed, and \n\
786 so are file name components followed by `..', along with the `..' itself;\n\
787 note that these simplifications are done without checking the resulting\n\
788 file names in the file system.\n\
789 An initial `~/' expands to your home directory.\n\
790 An initial `~USER/' expands to USER's home directory.\n\
791 See also the function `substitute-in-file-name'.")
792 (name
, default_directory
)
793 Lisp_Object name
, default_directory
;
797 register unsigned char *newdir
, *p
, *o
;
799 unsigned char *target
;
802 unsigned char * colon
= 0;
803 unsigned char * close
= 0;
804 unsigned char * slash
= 0;
805 unsigned char * brack
= 0;
806 int lbrack
= 0, rbrack
= 0;
811 int collapse_newdir
= 1;
816 CHECK_STRING (name
, 0);
818 /* If the file name has special constructs in it,
819 call the corresponding file handler. */
820 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
822 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
824 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
825 if (NILP (default_directory
))
826 default_directory
= current_buffer
->directory
;
827 CHECK_STRING (default_directory
, 1);
829 if (!NILP (default_directory
))
831 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
833 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
836 o
= XSTRING (default_directory
)->data
;
838 /* Make sure DEFAULT_DIRECTORY is properly expanded.
839 It would be better to do this down below where we actually use
840 default_directory. Unfortunately, calling Fexpand_file_name recursively
841 could invoke GC, and the strings might be relocated. This would
842 be annoying because we have pointers into strings lying around
843 that would need adjusting, and people would add new pointers to
844 the code and forget to adjust them, resulting in intermittent bugs.
845 Putting this call here avoids all that crud.
847 The EQ test avoids infinite recursion. */
848 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
849 /* Save time in some common cases - as long as default_directory
850 is not relative, it can be canonicalized with name below (if it
851 is needed at all) without requiring it to be expanded now. */
853 /* Detect MSDOS file names with drive specifiers. */
854 && ! (IS_DRIVE (o
[0]) && (IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2])))
856 /* Detect Windows file names in UNC format. */
857 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
859 #else /* not DOS_NT */
860 /* Detect Unix absolute file names (/... alone is not absolute on
862 && ! (IS_DIRECTORY_SEP (o
[0]))
863 #endif /* not DOS_NT */
869 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
874 /* Filenames on VMS are always upper case. */
875 name
= Fupcase (name
);
877 #ifdef FILE_SYSTEM_CASE
878 name
= FILE_SYSTEM_CASE (name
);
881 nm
= XSTRING (name
)->data
;
884 /* We will force directory separators to be either all \ or /, so make
885 a local copy to modify, even if there ends up being no change. */
886 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
888 /* Find and remove drive specifier if present; this makes nm absolute
889 even if the rest of the name appears to be relative. */
891 unsigned char *colon
= rindex (nm
, ':');
894 /* Only recognize colon as part of drive specifier if there is a
895 single alphabetic character preceeding the colon (and if the
896 character before the drive letter, if present, is a directory
897 separator); this is to support the remote system syntax used by
898 ange-ftp, and the "po:username" syntax for POP mailboxes. */
902 else if (IS_DRIVE (colon
[-1])
903 && (colon
== nm
+ 1 || IS_DIRECTORY_SEP (colon
[-2])))
910 while (--colon
>= nm
)
918 /* Discard any previous drive specifier if nm is now in UNC format. */
919 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
925 /* If nm is absolute, look for /./ or /../ sequences; if none are
926 found, we can probably return right away. We will avoid allocating
927 a new string if name is already fully expanded. */
929 IS_DIRECTORY_SEP (nm
[0])
934 && (drive
|| IS_DIRECTORY_SEP (nm
[1]))
941 /* If it turns out that the filename we want to return is just a
942 suffix of FILENAME, we don't need to go through and edit
943 things; we just need to construct a new string using data
944 starting at the middle of FILENAME. If we set lose to a
945 non-zero value, that means we've discovered that we can't do
952 /* Since we know the name is absolute, we can assume that each
953 element starts with a "/". */
955 /* "." and ".." are hairy. */
956 if (IS_DIRECTORY_SEP (p
[0])
958 && (IS_DIRECTORY_SEP (p
[2])
960 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
967 /* if dev:[dir]/, move nm to / */
968 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
969 nm
= (brack
? brack
+ 1 : colon
+ 1);
978 /* VMS pre V4.4,convert '-'s in filenames. */
979 if (lbrack
== rbrack
)
981 if (dots
< 2) /* this is to allow negative version numbers */
986 if (lbrack
> rbrack
&&
987 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
988 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
994 /* count open brackets, reset close bracket pointer */
995 if (p
[0] == '[' || p
[0] == '<')
997 /* count close brackets, set close bracket pointer */
998 if (p
[0] == ']' || p
[0] == '>')
1000 /* detect ][ or >< */
1001 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1003 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1004 nm
= p
+ 1, lose
= 1;
1005 if (p
[0] == ':' && (colon
|| slash
))
1006 /* if dev1:[dir]dev2:, move nm to dev2: */
1012 /* if /name/dev:, move nm to dev: */
1015 /* if node::dev:, move colon following dev */
1016 else if (colon
&& colon
[-1] == ':')
1018 /* if dev1:dev2:, move nm to dev2: */
1019 else if (colon
&& colon
[-1] != ':')
1024 if (p
[0] == ':' && !colon
)
1030 if (lbrack
== rbrack
)
1033 else if (p
[0] == '.')
1041 if (index (nm
, '/'))
1042 return build_string (sys_translate_unix (nm
));
1045 /* Make sure directories are all separated with / or \ as
1046 desired, but avoid allocation of a new string when not
1048 CORRECT_DIR_SEPS (nm
);
1050 if (IS_DIRECTORY_SEP (nm
[1]))
1052 if (strcmp (nm
, XSTRING (name
)->data
) != 0)
1053 name
= build_string (nm
);
1057 /* drive must be set, so this is okay */
1058 if (strcmp (nm
- 2, XSTRING (name
)->data
) != 0)
1060 name
= make_string (nm
- 2, p
- nm
+ 2);
1061 XSTRING (name
)->data
[0] = DRIVE_LETTER (drive
);
1062 XSTRING (name
)->data
[1] = ':';
1065 #else /* not DOS_NT */
1066 if (nm
== XSTRING (name
)->data
)
1068 return build_string (nm
);
1069 #endif /* not DOS_NT */
1073 /* At this point, nm might or might not be an absolute file name. We
1074 need to expand ~ or ~user if present, otherwise prefix nm with
1075 default_directory if nm is not absolute, and finally collapse /./
1076 and /foo/../ sequences.
1078 We set newdir to be the appropriate prefix if one is needed:
1079 - the relevant user directory if nm starts with ~ or ~user
1080 - the specified drive's working dir (DOS/NT only) if nm does not
1082 - the value of default_directory.
1084 Note that these prefixes are not guaranteed to be absolute (except
1085 for the working dir of a drive). Therefore, to ensure we always
1086 return an absolute name, if the final prefix is not absolute we
1087 append it to the current working directory. */
1091 if (nm
[0] == '~') /* prefix ~ */
1093 if (IS_DIRECTORY_SEP (nm
[1])
1097 || nm
[1] == 0) /* ~ by itself */
1099 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1100 newdir
= (unsigned char *) "";
1103 collapse_newdir
= 0;
1106 nm
++; /* Don't leave the slash in nm. */
1109 else /* ~user/filename */
1111 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1116 o
= (unsigned char *) alloca (p
- nm
+ 1);
1117 bcopy ((char *) nm
, o
, p
- nm
);
1120 pw
= (struct passwd
*) getpwnam (o
+ 1);
1123 newdir
= (unsigned char *) pw
-> pw_dir
;
1125 nm
= p
+ 1; /* skip the terminator */
1129 collapse_newdir
= 0;
1134 /* If we don't find a user of that name, leave the name
1135 unchanged; don't move nm forward to p. */
1140 /* On DOS and Windows, nm is absolute if a drive name was specified;
1141 use the drive's current directory as the prefix if needed. */
1142 if (!newdir
&& drive
)
1144 /* Get default directory if needed to make nm absolute. */
1145 if (!IS_DIRECTORY_SEP (nm
[0]))
1147 newdir
= alloca (MAXPATHLEN
+ 1);
1148 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1153 /* Either nm starts with /, or drive isn't mounted. */
1154 newdir
= alloca (4);
1155 newdir
[0] = DRIVE_LETTER (drive
);
1163 /* Finally, if no prefix has been specified and nm is not absolute,
1164 then it must be expanded relative to default_directory. */
1168 /* /... alone is not absolute on DOS and Windows. */
1169 && !IS_DIRECTORY_SEP (nm
[0])
1172 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1179 newdir
= XSTRING (default_directory
)->data
;
1185 /* First ensure newdir is an absolute name. */
1187 /* Detect MSDOS file names with drive specifiers. */
1188 ! (IS_DRIVE (newdir
[0])
1189 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1191 /* Detect Windows file names in UNC format. */
1192 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1196 /* Effectively, let newdir be (expand-file-name newdir cwd).
1197 Because of the admonition against calling expand-file-name
1198 when we have pointers into lisp strings, we accomplish this
1199 indirectly by prepending newdir to nm if necessary, and using
1200 cwd (or the wd of newdir's drive) as the new newdir. */
1202 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1207 if (!IS_DIRECTORY_SEP (nm
[0]))
1209 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1210 file_name_as_directory (tmp
, newdir
);
1214 newdir
= alloca (MAXPATHLEN
+ 1);
1217 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1224 /* Strip off drive name from prefix, if present. */
1225 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1231 /* Keep only a prefix from newdir if nm starts with slash
1232 (//server/share for UNC, nothing otherwise). */
1233 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1236 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1238 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1240 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1242 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1254 /* Get rid of any slash at the end of newdir, unless newdir is
1255 just // (an incomplete UNC name). */
1256 length
= strlen (newdir
);
1257 if (length
> 0 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1259 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1263 unsigned char *temp
= (unsigned char *) alloca (length
);
1264 bcopy (newdir
, temp
, length
- 1);
1265 temp
[length
- 1] = 0;
1273 /* Now concatenate the directory and name to new space in the stack frame */
1274 tlen
+= strlen (nm
) + 1;
1276 /* Add reserved space for drive name. (The Microsoft x86 compiler
1277 produces incorrect code if the following two lines are combined.) */
1278 target
= (unsigned char *) alloca (tlen
+ 2);
1280 #else /* not DOS_NT */
1281 target
= (unsigned char *) alloca (tlen
);
1282 #endif /* not DOS_NT */
1288 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1289 strcpy (target
, newdir
);
1292 file_name_as_directory (target
, newdir
);
1295 strcat (target
, nm
);
1297 if (index (target
, '/'))
1298 strcpy (target
, sys_translate_unix (target
));
1301 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1303 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1311 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1317 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1318 /* brackets are offset from each other by 2 */
1321 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1322 /* convert [foo][bar] to [bar] */
1323 while (o
[-1] != '[' && o
[-1] != '<')
1325 else if (*p
== '-' && *o
!= '.')
1328 else if (p
[0] == '-' && o
[-1] == '.' &&
1329 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1330 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1334 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1335 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1337 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1339 /* else [foo.-] ==> [-] */
1345 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1346 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1352 if (!IS_DIRECTORY_SEP (*p
))
1356 else if (IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1])
1357 #if defined (APOLLO) || defined (WINDOWSNT)
1358 /* // at start of filename is meaningful in Apollo
1359 and WindowsNT systems */
1361 #endif /* APOLLO || WINDOWSNT */
1367 else if (IS_DIRECTORY_SEP (p
[0])
1369 && (IS_DIRECTORY_SEP (p
[2])
1372 /* If "/." is the entire filename, keep the "/". Otherwise,
1373 just delete the whole "/.". */
1374 if (o
== target
&& p
[2] == '\0')
1378 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1379 /* `/../' is the "superroot" on certain file systems. */
1381 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1383 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1385 /* Keep initial / only if this is the whole name. */
1386 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1394 #endif /* not VMS */
1398 /* At last, set drive name. */
1400 /* Except for network file name. */
1401 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1402 #endif /* WINDOWSNT */
1404 if (!drive
) abort ();
1406 target
[0] = DRIVE_LETTER (drive
);
1409 CORRECT_DIR_SEPS (target
);
1412 return make_string (target
, o
- target
);
1416 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1417 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1418 "Convert FILENAME to absolute, and canonicalize it.\n\
1419 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1420 (does not start with slash); if DEFAULT is nil or missing,\n\
1421 the current buffer's value of default-directory is used.\n\
1422 Filenames containing `.' or `..' as components are simplified;\n\
1423 initial `~/' expands to your home directory.\n\
1424 See also the function `substitute-in-file-name'.")
1426 Lisp_Object name
, defalt
;
1430 register unsigned char *newdir
, *p
, *o
;
1432 unsigned char *target
;
1436 unsigned char * colon
= 0;
1437 unsigned char * close
= 0;
1438 unsigned char * slash
= 0;
1439 unsigned char * brack
= 0;
1440 int lbrack
= 0, rbrack
= 0;
1444 CHECK_STRING (name
, 0);
1447 /* Filenames on VMS are always upper case. */
1448 name
= Fupcase (name
);
1451 nm
= XSTRING (name
)->data
;
1453 /* If nm is absolute, flush ...// and detect /./ and /../.
1454 If no /./ or /../ we can return right away. */
1466 if (p
[0] == '/' && p
[1] == '/'
1468 /* // at start of filename is meaningful on Apollo system */
1473 if (p
[0] == '/' && p
[1] == '~')
1474 nm
= p
+ 1, lose
= 1;
1475 if (p
[0] == '/' && p
[1] == '.'
1476 && (p
[2] == '/' || p
[2] == 0
1477 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1483 /* if dev:[dir]/, move nm to / */
1484 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1485 nm
= (brack
? brack
+ 1 : colon
+ 1);
1486 lbrack
= rbrack
= 0;
1494 /* VMS pre V4.4,convert '-'s in filenames. */
1495 if (lbrack
== rbrack
)
1497 if (dots
< 2) /* this is to allow negative version numbers */
1502 if (lbrack
> rbrack
&&
1503 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1504 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1510 /* count open brackets, reset close bracket pointer */
1511 if (p
[0] == '[' || p
[0] == '<')
1512 lbrack
++, brack
= 0;
1513 /* count close brackets, set close bracket pointer */
1514 if (p
[0] == ']' || p
[0] == '>')
1515 rbrack
++, brack
= p
;
1516 /* detect ][ or >< */
1517 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1519 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1520 nm
= p
+ 1, lose
= 1;
1521 if (p
[0] == ':' && (colon
|| slash
))
1522 /* if dev1:[dir]dev2:, move nm to dev2: */
1528 /* If /name/dev:, move nm to dev: */
1531 /* If node::dev:, move colon following dev */
1532 else if (colon
&& colon
[-1] == ':')
1534 /* If dev1:dev2:, move nm to dev2: */
1535 else if (colon
&& colon
[-1] != ':')
1540 if (p
[0] == ':' && !colon
)
1546 if (lbrack
== rbrack
)
1549 else if (p
[0] == '.')
1557 if (index (nm
, '/'))
1558 return build_string (sys_translate_unix (nm
));
1560 if (nm
== XSTRING (name
)->data
)
1562 return build_string (nm
);
1566 /* Now determine directory to start with and put it in NEWDIR */
1570 if (nm
[0] == '~') /* prefix ~ */
1575 || nm
[1] == 0)/* ~/filename */
1577 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1578 newdir
= (unsigned char *) "";
1581 nm
++; /* Don't leave the slash in nm. */
1584 else /* ~user/filename */
1586 /* Get past ~ to user */
1587 unsigned char *user
= nm
+ 1;
1588 /* Find end of name. */
1589 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1590 int len
= ptr
? ptr
- user
: strlen (user
);
1592 unsigned char *ptr1
= index (user
, ':');
1593 if (ptr1
!= 0 && ptr1
- user
< len
)
1596 /* Copy the user name into temp storage. */
1597 o
= (unsigned char *) alloca (len
+ 1);
1598 bcopy ((char *) user
, o
, len
);
1601 /* Look up the user name. */
1602 pw
= (struct passwd
*) getpwnam (o
+ 1);
1604 error ("\"%s\" isn't a registered user", o
+ 1);
1606 newdir
= (unsigned char *) pw
->pw_dir
;
1608 /* Discard the user name from NM. */
1615 #endif /* not VMS */
1619 defalt
= current_buffer
->directory
;
1620 CHECK_STRING (defalt
, 1);
1621 newdir
= XSTRING (defalt
)->data
;
1624 /* Now concatenate the directory and name to new space in the stack frame */
1626 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1627 target
= (unsigned char *) alloca (tlen
);
1633 if (nm
[0] == 0 || nm
[0] == '/')
1634 strcpy (target
, newdir
);
1637 file_name_as_directory (target
, newdir
);
1640 strcat (target
, nm
);
1642 if (index (target
, '/'))
1643 strcpy (target
, sys_translate_unix (target
));
1646 /* Now canonicalize by removing /. and /foo/.. if they appear */
1654 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1660 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1661 /* brackets are offset from each other by 2 */
1664 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1665 /* convert [foo][bar] to [bar] */
1666 while (o
[-1] != '[' && o
[-1] != '<')
1668 else if (*p
== '-' && *o
!= '.')
1671 else if (p
[0] == '-' && o
[-1] == '.' &&
1672 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1673 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1677 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1678 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1680 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1682 /* else [foo.-] ==> [-] */
1688 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1689 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1699 else if (!strncmp (p
, "//", 2)
1701 /* // at start of filename is meaningful in Apollo system */
1709 else if (p
[0] == '/' && p
[1] == '.' &&
1710 (p
[2] == '/' || p
[2] == 0))
1712 else if (!strncmp (p
, "/..", 3)
1713 /* `/../' is the "superroot" on certain file systems. */
1715 && (p
[3] == '/' || p
[3] == 0))
1717 while (o
!= target
&& *--o
!= '/')
1720 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1724 if (o
== target
&& *o
== '/')
1732 #endif /* not VMS */
1735 return make_string (target
, o
- target
);
1739 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1740 Ssubstitute_in_file_name
, 1, 1, 0,
1741 "Substitute environment variables referred to in FILENAME.\n\
1742 `$FOO' where FOO is an environment variable name means to substitute\n\
1743 the value of that variable. The variable name should be terminated\n\
1744 with a character not a letter, digit or underscore; otherwise, enclose\n\
1745 the entire variable name in braces.\n\
1746 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1747 On VMS, `$' substitution is not done; this function does little and only\n\
1748 duplicates what `expand-file-name' does.")
1750 Lisp_Object filename
;
1754 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1755 unsigned char *target
;
1757 int substituted
= 0;
1759 Lisp_Object handler
;
1761 CHECK_STRING (filename
, 0);
1763 /* If the file name has special constructs in it,
1764 call the corresponding file handler. */
1765 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1766 if (!NILP (handler
))
1767 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1769 nm
= XSTRING (filename
)->data
;
1771 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1772 CORRECT_DIR_SEPS (nm
);
1773 substituted
= (strcmp (nm
, XSTRING (filename
)->data
) != 0);
1775 endp
= nm
+ XSTRING (filename
)->size
;
1777 /* If /~ or // appears, discard everything through first slash. */
1779 for (p
= nm
; p
!= endp
; p
++)
1782 #if defined (APOLLO) || defined (WINDOWSNT)
1783 /* // at start of file name is meaningful in Apollo and
1784 WindowsNT systems */
1785 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1786 #else /* not (APOLLO || WINDOWSNT) */
1787 || IS_DIRECTORY_SEP (p
[0])
1788 #endif /* not (APOLLO || WINDOWSNT) */
1793 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1795 || IS_DIRECTORY_SEP (p
[-1])))
1801 /* see comment in expand-file-name about drive specifiers */
1802 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1803 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1812 return build_string (nm
);
1815 /* See if any variables are substituted into the string
1816 and find the total length of their values in `total' */
1818 for (p
= nm
; p
!= endp
;)
1828 /* "$$" means a single "$" */
1837 while (p
!= endp
&& *p
!= '}') p
++;
1838 if (*p
!= '}') goto missingclose
;
1844 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1848 /* Copy out the variable name */
1849 target
= (unsigned char *) alloca (s
- o
+ 1);
1850 strncpy (target
, o
, s
- o
);
1853 strupr (target
); /* $home == $HOME etc. */
1856 /* Get variable value */
1857 o
= (unsigned char *) egetenv (target
);
1858 if (!o
) goto badvar
;
1859 total
+= strlen (o
);
1866 /* If substitution required, recopy the string and do it */
1867 /* Make space in stack frame for the new copy */
1868 xnm
= (unsigned char *) alloca (XSTRING (filename
)->size
+ total
+ 1);
1871 /* Copy the rest of the name through, replacing $ constructs with values */
1888 while (p
!= endp
&& *p
!= '}') p
++;
1889 if (*p
!= '}') goto missingclose
;
1895 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1899 /* Copy out the variable name */
1900 target
= (unsigned char *) alloca (s
- o
+ 1);
1901 strncpy (target
, o
, s
- o
);
1904 strupr (target
); /* $home == $HOME etc. */
1907 /* Get variable value */
1908 o
= (unsigned char *) egetenv (target
);
1918 /* If /~ or // appears, discard everything through first slash. */
1920 for (p
= xnm
; p
!= x
; p
++)
1922 #if defined (APOLLO) || defined (WINDOWSNT)
1923 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
1924 #else /* not (APOLLO || WINDOWSNT) */
1925 || IS_DIRECTORY_SEP (p
[0])
1926 #endif /* not (APOLLO || WINDOWSNT) */
1928 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
1931 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1932 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1936 return make_string (xnm
, x
- xnm
);
1939 error ("Bad format environment-variable substitution");
1941 error ("Missing \"}\" in environment-variable substitution");
1943 error ("Substituting nonexistent environment variable \"%s\"", target
);
1946 #endif /* not VMS */
1949 /* A slightly faster and more convenient way to get
1950 (directory-file-name (expand-file-name FOO)). */
1953 expand_and_dir_to_file (filename
, defdir
)
1954 Lisp_Object filename
, defdir
;
1956 register Lisp_Object absname
;
1958 absname
= Fexpand_file_name (filename
, defdir
);
1961 register int c
= XSTRING (absname
)->data
[XSTRING (absname
)->size
- 1];
1962 if (c
== ':' || c
== ']' || c
== '>')
1963 absname
= Fdirectory_file_name (absname
);
1966 /* Remove final slash, if any (unless this is the root dir).
1967 stat behaves differently depending! */
1968 if (XSTRING (absname
)->size
> 1
1969 && IS_DIRECTORY_SEP (XSTRING (absname
)->data
[XSTRING (absname
)->size
- 1])
1970 && !IS_DEVICE_SEP (XSTRING (absname
)->data
[XSTRING (absname
)->size
-2]))
1971 /* We cannot take shortcuts; they might be wrong for magic file names. */
1972 absname
= Fdirectory_file_name (absname
);
1977 /* Signal an error if the file ABSNAME already exists.
1978 If INTERACTIVE is nonzero, ask the user whether to proceed,
1979 and bypass the error if the user says to go ahead.
1980 QUERYSTRING is a name for the action that is being considered
1982 *STATPTR is used to store the stat information if the file exists.
1983 If the file does not exist, STATPTR->st_mode is set to 0. */
1986 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
)
1987 Lisp_Object absname
;
1988 unsigned char *querystring
;
1990 struct stat
*statptr
;
1992 register Lisp_Object tem
;
1993 struct stat statbuf
;
1994 struct gcpro gcpro1
;
1996 /* stat is a good way to tell whether the file exists,
1997 regardless of what access permissions it has. */
1998 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
2001 Fsignal (Qfile_already_exists
,
2002 Fcons (build_string ("File already exists"),
2003 Fcons (absname
, Qnil
)));
2005 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
2006 XSTRING (absname
)->data
, querystring
));
2009 Fsignal (Qfile_already_exists
,
2010 Fcons (build_string ("File already exists"),
2011 Fcons (absname
, Qnil
)));
2018 statptr
->st_mode
= 0;
2023 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2024 "fCopy file: \nFCopy %s to file: \np\nP",
2025 "Copy FILE to NEWNAME. Both args must be strings.\n\
2026 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
2027 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
2028 A number as third arg means request confirmation if NEWNAME already exists.\n\
2029 This is what happens in interactive use with M-x.\n\
2030 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
2031 last-modified time as the old one. (This works on only some systems.)\n\
2032 A prefix arg makes KEEP-TIME non-nil.")
2033 (file
, newname
, ok_if_already_exists
, keep_date
)
2034 Lisp_Object file
, newname
, ok_if_already_exists
, keep_date
;
2037 char buf
[16 * 1024];
2038 struct stat st
, out_st
;
2039 Lisp_Object handler
;
2040 struct gcpro gcpro1
, gcpro2
;
2041 int count
= specpdl_ptr
- specpdl
;
2042 int input_file_statable_p
;
2044 GCPRO2 (file
, newname
);
2045 CHECK_STRING (file
, 0);
2046 CHECK_STRING (newname
, 1);
2047 file
= Fexpand_file_name (file
, Qnil
);
2048 newname
= Fexpand_file_name (newname
, Qnil
);
2050 /* If the input file name has special constructs in it,
2051 call the corresponding file handler. */
2052 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2053 /* Likewise for output file name. */
2055 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2056 if (!NILP (handler
))
2057 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2058 ok_if_already_exists
, keep_date
));
2060 if (NILP (ok_if_already_exists
)
2061 || INTEGERP (ok_if_already_exists
))
2062 barf_or_query_if_file_exists (newname
, "copy to it",
2063 INTEGERP (ok_if_already_exists
), &out_st
);
2064 else if (stat (XSTRING (newname
)->data
, &out_st
) < 0)
2067 ifd
= open (XSTRING (file
)->data
, O_RDONLY
);
2069 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2071 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2073 /* We can only copy regular files and symbolic links. Other files are not
2075 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2077 #if !defined (MSDOS) || __DJGPP__ > 1
2078 if (out_st
.st_mode
!= 0
2079 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2082 report_file_error ("Input and output files are the same",
2083 Fcons (file
, Fcons (newname
, Qnil
)));
2087 #if defined (S_ISREG) && defined (S_ISLNK)
2088 if (input_file_statable_p
)
2090 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2092 #if defined (EISDIR)
2093 /* Get a better looking error message. */
2096 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2099 #endif /* S_ISREG && S_ISLNK */
2102 /* Create the copy file with the same record format as the input file */
2103 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
2106 /* System's default file type was set to binary by _fmode in emacs.c. */
2107 ofd
= creat (XSTRING (newname
)->data
, S_IREAD
| S_IWRITE
);
2108 #else /* not MSDOS */
2109 ofd
= creat (XSTRING (newname
)->data
, 0666);
2110 #endif /* not MSDOS */
2113 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2115 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2119 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
2120 if (write (ofd
, buf
, n
) != n
)
2121 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2124 /* Closing the output clobbers the file times on some systems. */
2125 if (close (ofd
) < 0)
2126 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2128 if (input_file_statable_p
)
2130 if (!NILP (keep_date
))
2132 EMACS_TIME atime
, mtime
;
2133 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2134 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2135 if (set_file_times (XSTRING (newname
)->data
, atime
, mtime
))
2136 Fsignal (Qfile_date_error
,
2137 Fcons (build_string ("Cannot set file date"),
2138 Fcons (newname
, Qnil
)));
2141 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
2143 #if defined (__DJGPP__) && __DJGPP__ > 1
2144 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2145 and if it can't, it tells so. Otherwise, under MSDOS we usually
2146 get only the READ bit, which will make the copied file read-only,
2147 so it's better not to chmod at all. */
2148 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2149 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
2150 #endif /* DJGPP version 2 or newer */
2156 /* Discard the unwind protects. */
2157 specpdl_ptr
= specpdl
+ count
;
2163 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2164 Smake_directory_internal
, 1, 1, 0,
2165 "Create a new directory named DIRECTORY.")
2167 Lisp_Object directory
;
2170 Lisp_Object handler
;
2172 CHECK_STRING (directory
, 0);
2173 directory
= Fexpand_file_name (directory
, Qnil
);
2175 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2176 if (!NILP (handler
))
2177 return call2 (handler
, Qmake_directory_internal
, directory
);
2179 dir
= XSTRING (directory
)->data
;
2182 if (mkdir (dir
) != 0)
2184 if (mkdir (dir
, 0777) != 0)
2186 report_file_error ("Creating directory", Flist (1, &directory
));
2191 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2192 "Delete the directory named DIRECTORY.")
2194 Lisp_Object directory
;
2197 Lisp_Object handler
;
2199 CHECK_STRING (directory
, 0);
2200 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2201 dir
= XSTRING (directory
)->data
;
2203 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2204 if (!NILP (handler
))
2205 return call2 (handler
, Qdelete_directory
, directory
);
2207 if (rmdir (dir
) != 0)
2208 report_file_error ("Removing directory", Flist (1, &directory
));
2213 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2214 "Delete file named FILENAME.\n\
2215 If file has multiple names, it continues to exist with the other names.")
2217 Lisp_Object filename
;
2219 Lisp_Object handler
;
2220 CHECK_STRING (filename
, 0);
2221 filename
= Fexpand_file_name (filename
, Qnil
);
2223 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2224 if (!NILP (handler
))
2225 return call2 (handler
, Qdelete_file
, filename
);
2227 if (0 > unlink (XSTRING (filename
)->data
))
2228 report_file_error ("Removing old name", Flist (1, &filename
));
2233 internal_delete_file_1 (ignore
)
2239 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2242 internal_delete_file (filename
)
2243 Lisp_Object filename
;
2245 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2246 Qt
, internal_delete_file_1
));
2249 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2250 "fRename file: \nFRename %s to file: \np",
2251 "Rename FILE as NEWNAME. Both args strings.\n\
2252 If file has names other than FILE, it continues to have those names.\n\
2253 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2254 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2255 A number as third arg means request confirmation if NEWNAME already exists.\n\
2256 This is what happens in interactive use with M-x.")
2257 (file
, newname
, ok_if_already_exists
)
2258 Lisp_Object file
, newname
, ok_if_already_exists
;
2261 Lisp_Object args
[2];
2263 Lisp_Object handler
;
2264 struct gcpro gcpro1
, gcpro2
;
2266 GCPRO2 (file
, newname
);
2267 CHECK_STRING (file
, 0);
2268 CHECK_STRING (newname
, 1);
2269 file
= Fexpand_file_name (file
, Qnil
);
2270 newname
= Fexpand_file_name (newname
, Qnil
);
2272 /* If the file name has special constructs in it,
2273 call the corresponding file handler. */
2274 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2276 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2277 if (!NILP (handler
))
2278 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2279 file
, newname
, ok_if_already_exists
));
2281 if (NILP (ok_if_already_exists
)
2282 || INTEGERP (ok_if_already_exists
))
2283 barf_or_query_if_file_exists (newname
, "rename to it",
2284 INTEGERP (ok_if_already_exists
), 0);
2286 if (0 > rename (XSTRING (file
)->data
, XSTRING (newname
)->data
))
2288 if (0 > link (XSTRING (file
)->data
, XSTRING (newname
)->data
)
2289 || 0 > unlink (XSTRING (file
)->data
))
2294 Fcopy_file (file
, newname
,
2295 /* We have already prompted if it was an integer,
2296 so don't have copy-file prompt again. */
2297 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2298 Fdelete_file (file
);
2305 report_file_error ("Renaming", Flist (2, args
));
2308 report_file_error ("Renaming", Flist (2, &file
));
2315 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2316 "fAdd name to file: \nFName to add to %s: \np",
2317 "Give FILE additional name NEWNAME. Both args strings.\n\
2318 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2319 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2320 A number as third arg means request confirmation if NEWNAME already exists.\n\
2321 This is what happens in interactive use with M-x.")
2322 (file
, newname
, ok_if_already_exists
)
2323 Lisp_Object file
, newname
, ok_if_already_exists
;
2326 Lisp_Object args
[2];
2328 Lisp_Object handler
;
2329 struct gcpro gcpro1
, gcpro2
;
2331 GCPRO2 (file
, newname
);
2332 CHECK_STRING (file
, 0);
2333 CHECK_STRING (newname
, 1);
2334 file
= Fexpand_file_name (file
, Qnil
);
2335 newname
= Fexpand_file_name (newname
, Qnil
);
2337 /* If the file name has special constructs in it,
2338 call the corresponding file handler. */
2339 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2340 if (!NILP (handler
))
2341 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2342 newname
, ok_if_already_exists
));
2344 /* If the new name has special constructs in it,
2345 call the corresponding file handler. */
2346 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2347 if (!NILP (handler
))
2348 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2349 newname
, ok_if_already_exists
));
2351 if (NILP (ok_if_already_exists
)
2352 || INTEGERP (ok_if_already_exists
))
2353 barf_or_query_if_file_exists (newname
, "make it a new name",
2354 INTEGERP (ok_if_already_exists
), 0);
2356 /* Windows does not support this operation. */
2357 report_file_error ("Adding new name", Flist (2, &file
));
2358 #else /* not WINDOWSNT */
2360 unlink (XSTRING (newname
)->data
);
2361 if (0 > link (XSTRING (file
)->data
, XSTRING (newname
)->data
))
2366 report_file_error ("Adding new name", Flist (2, args
));
2368 report_file_error ("Adding new name", Flist (2, &file
));
2371 #endif /* not WINDOWSNT */
2378 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2379 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2380 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2381 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2382 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2383 A number as third arg means request confirmation if LINKNAME already exists.\n\
2384 This happens for interactive use with M-x.")
2385 (filename
, linkname
, ok_if_already_exists
)
2386 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2389 Lisp_Object args
[2];
2391 Lisp_Object handler
;
2392 struct gcpro gcpro1
, gcpro2
;
2394 GCPRO2 (filename
, linkname
);
2395 CHECK_STRING (filename
, 0);
2396 CHECK_STRING (linkname
, 1);
2397 /* If the link target has a ~, we must expand it to get
2398 a truly valid file name. Otherwise, do not expand;
2399 we want to permit links to relative file names. */
2400 if (XSTRING (filename
)->data
[0] == '~')
2401 filename
= Fexpand_file_name (filename
, Qnil
);
2402 linkname
= Fexpand_file_name (linkname
, Qnil
);
2404 /* If the file name has special constructs in it,
2405 call the corresponding file handler. */
2406 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2407 if (!NILP (handler
))
2408 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2409 linkname
, ok_if_already_exists
));
2411 /* If the new link name has special constructs in it,
2412 call the corresponding file handler. */
2413 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2414 if (!NILP (handler
))
2415 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2416 linkname
, ok_if_already_exists
));
2418 if (NILP (ok_if_already_exists
)
2419 || INTEGERP (ok_if_already_exists
))
2420 barf_or_query_if_file_exists (linkname
, "make it a link",
2421 INTEGERP (ok_if_already_exists
), 0);
2422 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2424 /* If we didn't complain already, silently delete existing file. */
2425 if (errno
== EEXIST
)
2427 unlink (XSTRING (linkname
)->data
);
2428 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2438 report_file_error ("Making symbolic link", Flist (2, args
));
2440 report_file_error ("Making symbolic link", Flist (2, &filename
));
2446 #endif /* S_IFLNK */
2450 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2451 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2452 "Define the job-wide logical name NAME to have the value STRING.\n\
2453 If STRING is nil or a null string, the logical name NAME is deleted.")
2458 CHECK_STRING (name
, 0);
2460 delete_logical_name (XSTRING (name
)->data
);
2463 CHECK_STRING (string
, 1);
2465 if (XSTRING (string
)->size
== 0)
2466 delete_logical_name (XSTRING (name
)->data
);
2468 define_logical_name (XSTRING (name
)->data
, XSTRING (string
)->data
);
2477 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2478 "Open a network connection to PATH using LOGIN as the login string.")
2480 Lisp_Object path
, login
;
2484 CHECK_STRING (path
, 0);
2485 CHECK_STRING (login
, 0);
2487 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2489 if (netresult
== -1)
2494 #endif /* HPUX_NET */
2496 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2498 "Return t if file FILENAME specifies an absolute file name.\n\
2499 On Unix, this is a name starting with a `/' or a `~'.")
2501 Lisp_Object filename
;
2505 CHECK_STRING (filename
, 0);
2506 ptr
= XSTRING (filename
)->data
;
2507 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2509 /* ??? This criterion is probably wrong for '<'. */
2510 || index (ptr
, ':') || index (ptr
, '<')
2511 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2515 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2523 /* Return nonzero if file FILENAME exists and can be executed. */
2526 check_executable (filename
)
2530 int len
= strlen (filename
);
2533 if (stat (filename
, &st
) < 0)
2535 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2536 return ((st
.st_mode
& S_IEXEC
) != 0);
2538 return (S_ISREG (st
.st_mode
)
2540 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2541 || stricmp (suffix
, ".exe") == 0
2542 || stricmp (suffix
, ".bat") == 0)
2543 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2544 #endif /* not WINDOWSNT */
2545 #else /* not DOS_NT */
2546 #ifdef HAVE_EUIDACCESS
2547 return (euidaccess (filename
, 1) >= 0);
2549 /* Access isn't quite right because it uses the real uid
2550 and we really want to test with the effective uid.
2551 But Unix doesn't give us a right way to do it. */
2552 return (access (filename
, 1) >= 0);
2554 #endif /* not DOS_NT */
2557 /* Return nonzero if file FILENAME exists and can be written. */
2560 check_writable (filename
)
2565 if (stat (filename
, &st
) < 0)
2567 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2568 #else /* not MSDOS */
2569 #ifdef HAVE_EUIDACCESS
2570 return (euidaccess (filename
, 2) >= 0);
2572 /* Access isn't quite right because it uses the real uid
2573 and we really want to test with the effective uid.
2574 But Unix doesn't give us a right way to do it.
2575 Opening with O_WRONLY could work for an ordinary file,
2576 but would lose for directories. */
2577 return (access (filename
, 2) >= 0);
2579 #endif /* not MSDOS */
2582 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2583 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2584 See also `file-readable-p' and `file-attributes'.")
2586 Lisp_Object filename
;
2588 Lisp_Object absname
;
2589 Lisp_Object handler
;
2590 struct stat statbuf
;
2592 CHECK_STRING (filename
, 0);
2593 absname
= Fexpand_file_name (filename
, Qnil
);
2595 /* If the file name has special constructs in it,
2596 call the corresponding file handler. */
2597 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2598 if (!NILP (handler
))
2599 return call2 (handler
, Qfile_exists_p
, absname
);
2601 return (stat (XSTRING (absname
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2604 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2605 "Return t if FILENAME can be executed by you.\n\
2606 For a directory, this means you can access files in that directory.")
2608 Lisp_Object filename
;
2611 Lisp_Object absname
;
2612 Lisp_Object handler
;
2614 CHECK_STRING (filename
, 0);
2615 absname
= Fexpand_file_name (filename
, Qnil
);
2617 /* If the file name has special constructs in it,
2618 call the corresponding file handler. */
2619 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2620 if (!NILP (handler
))
2621 return call2 (handler
, Qfile_executable_p
, absname
);
2623 return (check_executable (XSTRING (absname
)->data
) ? Qt
: Qnil
);
2626 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2627 "Return t if file FILENAME exists and you can read it.\n\
2628 See also `file-exists-p' and `file-attributes'.")
2630 Lisp_Object filename
;
2632 Lisp_Object absname
;
2633 Lisp_Object handler
;
2636 struct stat statbuf
;
2638 CHECK_STRING (filename
, 0);
2639 absname
= Fexpand_file_name (filename
, Qnil
);
2641 /* If the file name has special constructs in it,
2642 call the corresponding file handler. */
2643 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2644 if (!NILP (handler
))
2645 return call2 (handler
, Qfile_readable_p
, absname
);
2648 /* Under MS-DOS and Windows, open does not work for directories. */
2649 if (access (XSTRING (absname
)->data
, 0) == 0)
2652 #else /* not DOS_NT */
2654 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2655 /* Opening a fifo without O_NONBLOCK can wait.
2656 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2657 except in the case of a fifo, on a system which handles it. */
2658 desc
= stat (XSTRING (absname
)->data
, &statbuf
);
2661 if (S_ISFIFO (statbuf
.st_mode
))
2662 flags
|= O_NONBLOCK
;
2664 desc
= open (XSTRING (absname
)->data
, flags
);
2669 #endif /* not DOS_NT */
2672 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2674 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2675 "Return t if file FILENAME can be written or created by you.")
2677 Lisp_Object filename
;
2679 Lisp_Object absname
, dir
;
2680 Lisp_Object handler
;
2681 struct stat statbuf
;
2683 CHECK_STRING (filename
, 0);
2684 absname
= Fexpand_file_name (filename
, Qnil
);
2686 /* If the file name has special constructs in it,
2687 call the corresponding file handler. */
2688 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2689 if (!NILP (handler
))
2690 return call2 (handler
, Qfile_writable_p
, absname
);
2692 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
2693 return (check_writable (XSTRING (absname
)->data
)
2695 dir
= Ffile_name_directory (absname
);
2698 dir
= Fdirectory_file_name (dir
);
2702 dir
= Fdirectory_file_name (dir
);
2704 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2708 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2709 "Access file FILENAME, and get an error if that does not work.\n\
2710 The second argument STRING is used in the error message.\n\
2711 If there is no error, we return nil.")
2713 Lisp_Object filename
, string
;
2715 Lisp_Object handler
;
2718 CHECK_STRING (filename
, 0);
2720 /* If the file name has special constructs in it,
2721 call the corresponding file handler. */
2722 handler
= Ffind_file_name_handler (filename
, Qaccess_file
);
2723 if (!NILP (handler
))
2724 return call3 (handler
, Qaccess_file
, filename
, string
);
2726 fd
= open (XSTRING (filename
)->data
, O_RDONLY
);
2728 report_file_error (XSTRING (string
)->data
, Fcons (filename
, Qnil
));
2734 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2735 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2736 The value is the name of the file to which it is linked.\n\
2737 Otherwise returns nil.")
2739 Lisp_Object filename
;
2746 Lisp_Object handler
;
2748 CHECK_STRING (filename
, 0);
2749 filename
= Fexpand_file_name (filename
, Qnil
);
2751 /* If the file name has special constructs in it,
2752 call the corresponding file handler. */
2753 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2754 if (!NILP (handler
))
2755 return call2 (handler
, Qfile_symlink_p
, filename
);
2760 buf
= (char *) xmalloc (bufsize
);
2761 bzero (buf
, bufsize
);
2762 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2763 if (valsize
< bufsize
) break;
2764 /* Buffer was not long enough */
2773 val
= make_string (buf
, valsize
);
2776 #else /* not S_IFLNK */
2778 #endif /* not S_IFLNK */
2781 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2782 "Return t if FILENAME names an existing directory.")
2784 Lisp_Object filename
;
2786 register Lisp_Object absname
;
2788 Lisp_Object handler
;
2790 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2792 /* If the file name has special constructs in it,
2793 call the corresponding file handler. */
2794 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2795 if (!NILP (handler
))
2796 return call2 (handler
, Qfile_directory_p
, absname
);
2798 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2800 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2803 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2804 "Return t if file FILENAME is the name of a directory as a file,\n\
2805 and files in that directory can be opened by you. In order to use a\n\
2806 directory as a buffer's current directory, this predicate must return true.\n\
2807 A directory name spec may be given instead; then the value is t\n\
2808 if the directory so specified exists and really is a readable and\n\
2809 searchable directory.")
2811 Lisp_Object filename
;
2813 Lisp_Object handler
;
2815 struct gcpro gcpro1
;
2817 /* If the file name has special constructs in it,
2818 call the corresponding file handler. */
2819 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2820 if (!NILP (handler
))
2821 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2823 /* It's an unlikely combination, but yes we really do need to gcpro:
2824 Suppose that file-accessible-directory-p has no handler, but
2825 file-directory-p does have a handler; this handler causes a GC which
2826 relocates the string in `filename'; and finally file-directory-p
2827 returns non-nil. Then we would end up passing a garbaged string
2828 to file-executable-p. */
2830 tem
= (NILP (Ffile_directory_p (filename
))
2831 || NILP (Ffile_executable_p (filename
)));
2833 return tem
? Qnil
: Qt
;
2836 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2837 "Return t if file FILENAME is the name of a regular file.\n\
2838 This is the sort of file that holds an ordinary stream of data bytes.")
2840 Lisp_Object filename
;
2842 register Lisp_Object absname
;
2844 Lisp_Object handler
;
2846 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2848 /* If the file name has special constructs in it,
2849 call the corresponding file handler. */
2850 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
2851 if (!NILP (handler
))
2852 return call2 (handler
, Qfile_regular_p
, absname
);
2854 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2856 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2859 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2860 "Return mode bits of file named FILENAME, as an integer.")
2862 Lisp_Object filename
;
2864 Lisp_Object absname
;
2866 Lisp_Object handler
;
2868 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2870 /* If the file name has special constructs in it,
2871 call the corresponding file handler. */
2872 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
2873 if (!NILP (handler
))
2874 return call2 (handler
, Qfile_modes
, absname
);
2876 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2878 #if defined (MSDOS) && __DJGPP__ < 2
2879 if (check_executable (XSTRING (absname
)->data
))
2880 st
.st_mode
|= S_IEXEC
;
2881 #endif /* MSDOS && __DJGPP__ < 2 */
2883 return make_number (st
.st_mode
& 07777);
2886 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2887 "Set mode bits of file named FILENAME to MODE (an integer).\n\
2888 Only the 12 low bits of MODE are used.")
2890 Lisp_Object filename
, mode
;
2892 Lisp_Object absname
;
2893 Lisp_Object handler
;
2895 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
2896 CHECK_NUMBER (mode
, 1);
2898 /* If the file name has special constructs in it,
2899 call the corresponding file handler. */
2900 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
2901 if (!NILP (handler
))
2902 return call3 (handler
, Qset_file_modes
, absname
, mode
);
2904 if (chmod (XSTRING (absname
)->data
, XINT (mode
)) < 0)
2905 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
2910 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2911 "Set the file permission bits for newly created files.\n\
2912 The argument MODE should be an integer; only the low 9 bits are used.\n\
2913 This setting is inherited by subprocesses.")
2917 CHECK_NUMBER (mode
, 0);
2919 umask ((~ XINT (mode
)) & 0777);
2924 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2925 "Return the default file protection for created files.\n\
2926 The value is an integer.")
2932 realmask
= umask (0);
2935 XSETINT (value
, (~ realmask
) & 0777);
2941 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2942 "Tell Unix to finish all pending disk updates.")
2951 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2952 "Return t if file FILE1 is newer than file FILE2.\n\
2953 If FILE1 does not exist, the answer is nil;\n\
2954 otherwise, if FILE2 does not exist, the answer is t.")
2956 Lisp_Object file1
, file2
;
2958 Lisp_Object absname1
, absname2
;
2961 Lisp_Object handler
;
2962 struct gcpro gcpro1
, gcpro2
;
2964 CHECK_STRING (file1
, 0);
2965 CHECK_STRING (file2
, 0);
2968 GCPRO2 (absname1
, file2
);
2969 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2970 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2973 /* If the file name has special constructs in it,
2974 call the corresponding file handler. */
2975 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
2977 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
2978 if (!NILP (handler
))
2979 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
2981 if (stat (XSTRING (absname1
)->data
, &st
) < 0)
2984 mtime1
= st
.st_mtime
;
2986 if (stat (XSTRING (absname2
)->data
, &st
) < 0)
2989 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2993 Lisp_Object Qfind_buffer_file_type
;
2996 #ifndef READ_BUF_SIZE
2997 #define READ_BUF_SIZE (64 << 10)
3000 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3002 "Insert contents of file FILENAME after point.\n\
3003 Returns list of absolute file name and length of data inserted.\n\
3004 If second argument VISIT is non-nil, the buffer's visited filename\n\
3005 and last save file modtime are set, and it is marked unmodified.\n\
3006 If visiting and the file does not exist, visiting is completed\n\
3007 before the error is signaled.\n\
3008 The optional third and fourth arguments BEG and END\n\
3009 specify what portion of the file to insert.\n\
3010 If VISIT is non-nil, BEG and END must be nil.\n\
3012 If optional fifth argument REPLACE is non-nil,\n\
3013 it means replace the current buffer contents (in the accessible portion)\n\
3014 with the file contents. This is better than simply deleting and inserting\n\
3015 the whole thing because (1) it preserves some marker positions\n\
3016 and (2) it puts less data in the undo list.\n\
3017 When REPLACE is non-nil, the value is the number of characters actually read,\n\
3018 which is often less than the number of characters to be read.\n\
3019 This does code conversion according to the value of\n\
3020 `coding-system-for-read' or `file-coding-system-alist',\n\
3021 and sets the variable `last-coding-system-used' to the coding system\n\
3023 (filename
, visit
, beg
, end
, replace
)
3024 Lisp_Object filename
, visit
, beg
, end
, replace
;
3028 register int inserted
= 0;
3029 register int how_much
;
3030 register int unprocessed
;
3031 int count
= specpdl_ptr
- specpdl
;
3032 struct gcpro gcpro1
, gcpro2
, gcpro3
;
3033 Lisp_Object handler
, val
, insval
;
3036 int not_regular
= 0;
3037 char read_buf
[READ_BUF_SIZE
];
3038 struct coding_system coding
;
3039 unsigned char buffer
[1 << 14];
3040 int replace_handled
= 0;
3042 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3043 error ("Cannot do file visiting in an indirect buffer");
3045 if (!NILP (current_buffer
->read_only
))
3046 Fbarf_if_buffer_read_only ();
3051 GCPRO3 (filename
, val
, p
);
3053 CHECK_STRING (filename
, 0);
3054 filename
= Fexpand_file_name (filename
, Qnil
);
3056 /* If the file name has special constructs in it,
3057 call the corresponding file handler. */
3058 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3059 if (!NILP (handler
))
3061 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3062 visit
, beg
, end
, replace
);
3066 /* Decide the coding-system of the file. */
3070 if (!NILP (Vcoding_system_for_read
))
3071 val
= Vcoding_system_for_read
;
3072 else if (NILP (current_buffer
->enable_multibyte_characters
))
3076 Lisp_Object args
[6], coding_systems
;
3078 args
[0] = Qinsert_file_contents
, args
[1] = filename
, args
[2] = visit
,
3079 args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3080 coding_systems
= Ffind_operation_coding_system (6, args
);
3081 val
= CONSP (coding_systems
) ? XCONS (coding_systems
)->car
: Qnil
;
3083 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3087 /* Use the conversion type to determine buffer-file-type
3088 (find-buffer-file-type is now used to help determine the
3090 if (coding
.type
== coding_type_no_conversion
)
3091 current_buffer
->buffer_file_type
= Qt
;
3093 current_buffer
->buffer_file_type
= Qnil
;
3099 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3101 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
3102 || fstat (fd
, &st
) < 0)
3103 #endif /* not APOLLO */
3105 if (fd
>= 0) close (fd
);
3108 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3115 /* This code will need to be changed in order to work on named
3116 pipes, and it's probably just not worth it. So we should at
3117 least signal an error. */
3118 if (!S_ISREG (st
.st_mode
))
3125 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3126 Fsignal (Qfile_error
,
3127 Fcons (build_string ("not a regular file"),
3128 Fcons (filename
, Qnil
)));
3133 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
3136 /* Replacement should preserve point as it preserves markers. */
3137 if (!NILP (replace
))
3138 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3140 record_unwind_protect (close_file_unwind
, make_number (fd
));
3142 /* Supposedly happens on VMS. */
3143 if (! not_regular
&& st
.st_size
< 0)
3144 error ("File size is negative");
3146 if (!NILP (beg
) || !NILP (end
))
3148 error ("Attempt to visit less than an entire file");
3151 CHECK_NUMBER (beg
, 0);
3153 XSETFASTINT (beg
, 0);
3156 CHECK_NUMBER (end
, 0);
3161 XSETINT (end
, st
.st_size
);
3162 if (XINT (end
) != st
.st_size
)
3163 error ("Maximum buffer size exceeded");
3167 /* If requested, replace the accessible part of the buffer
3168 with the file contents. Avoid replacing text at the
3169 beginning or end of the buffer that matches the file contents;
3170 that preserves markers pointing to the unchanged parts.
3172 Here we implement this feature in an optimized way
3173 for the case where code conversion is NOT needed.
3174 The following if-statement handles the case of conversion
3175 in a less optimal way.
3177 If the code conversion is "automatic" then we try using this
3178 method and hope for the best.
3179 But if we discover the need for conversion, we give up on this method
3180 and let the following if-statement handle the replace job. */
3182 && CODING_MAY_REQUIRE_NO_CONVERSION (&coding
))
3184 int same_at_start
= BEGV
;
3185 int same_at_end
= ZV
;
3187 /* There is still a possibility we will find the need to do code
3188 conversion. If that happens, we set this variable to 1 to
3189 give up on handling REPLACE in the optimized way. */
3190 int giveup_match_end
= 0;
3192 if (XINT (beg
) != 0)
3194 if (lseek (fd
, XINT (beg
), 0) < 0)
3195 report_file_error ("Setting file position",
3196 Fcons (filename
, Qnil
));
3201 /* Count how many chars at the start of the file
3202 match the text at the beginning of the buffer. */
3207 nread
= read (fd
, buffer
, sizeof buffer
);
3209 error ("IO error reading %s: %s",
3210 XSTRING (filename
)->data
, strerror (errno
));
3211 else if (nread
== 0)
3214 if (coding
.type
== coding_type_undecided
)
3215 detect_coding (&coding
, buffer
, nread
);
3216 if (coding
.type
!= coding_type_undecided
3217 && coding
.type
!= coding_type_no_conversion
3218 && coding
.type
!= coding_type_emacs_mule
)
3219 /* We found that the file should be decoded somehow.
3220 Let's give up here. */
3222 giveup_match_end
= 1;
3226 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3227 detect_eol (&coding
, buffer
, nread
);
3228 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3229 && coding
.eol_type
!= CODING_EOL_LF
)
3230 /* We found that the format of eol should be decoded.
3231 Let's give up here. */
3233 giveup_match_end
= 1;
3238 while (bufpos
< nread
&& same_at_start
< ZV
3239 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3240 same_at_start
++, bufpos
++;
3241 /* If we found a discrepancy, stop the scan.
3242 Otherwise loop around and scan the next bufferful. */
3243 if (bufpos
!= nread
)
3247 /* If the file matches the buffer completely,
3248 there's no need to replace anything. */
3249 if (same_at_start
- BEGV
== XINT (end
))
3253 /* Truncate the buffer to the size of the file. */
3254 del_range_1 (same_at_start
, same_at_end
, 0);
3259 /* Count how many chars at the end of the file
3260 match the text at the end of the buffer. But, if we have
3261 already found that decoding is necessary, don't waste time. */
3262 while (!giveup_match_end
)
3264 int total_read
, nread
, bufpos
, curpos
, trial
;
3266 /* At what file position are we now scanning? */
3267 curpos
= XINT (end
) - (ZV
- same_at_end
);
3268 /* If the entire file matches the buffer tail, stop the scan. */
3271 /* How much can we scan in the next step? */
3272 trial
= min (curpos
, sizeof buffer
);
3273 if (lseek (fd
, curpos
- trial
, 0) < 0)
3274 report_file_error ("Setting file position",
3275 Fcons (filename
, Qnil
));
3278 while (total_read
< trial
)
3280 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
3282 error ("IO error reading %s: %s",
3283 XSTRING (filename
)->data
, strerror (errno
));
3284 total_read
+= nread
;
3286 /* Scan this bufferful from the end, comparing with
3287 the Emacs buffer. */
3288 bufpos
= total_read
;
3289 /* Compare with same_at_start to avoid counting some buffer text
3290 as matching both at the file's beginning and at the end. */
3291 while (bufpos
> 0 && same_at_end
> same_at_start
3292 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3293 same_at_end
--, bufpos
--;
3295 /* If we found a discrepancy, stop the scan.
3296 Otherwise loop around and scan the preceding bufferful. */
3299 /* If this discrepancy is because of code conversion,
3300 we cannot use this method; giveup and try the other. */
3301 if (same_at_end
> same_at_start
3302 && FETCH_BYTE (same_at_end
- 1) >= 0200
3303 && ! NILP (current_buffer
->enable_multibyte_characters
)
3304 && ! CODING_REQUIRE_NO_CONVERSION (&coding
))
3305 giveup_match_end
= 1;
3311 if (! giveup_match_end
)
3313 /* We win! We can handle REPLACE the optimized way. */
3315 /* Extends the end of non-matching text area to multibyte
3316 character boundary. */
3317 if (! NILP (current_buffer
->enable_multibyte_characters
))
3318 while (same_at_end
< ZV
&& ! CHAR_HEAD_P (POS_ADDR (same_at_end
)))
3321 /* Don't try to reuse the same piece of text twice. */
3322 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
3324 same_at_end
+= overlap
;
3326 /* Arrange to read only the nonmatching middle part of the file. */
3327 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV
));
3328 XSETFASTINT (end
, XINT (end
) - (ZV
- same_at_end
));
3330 del_range_1 (same_at_start
, same_at_end
, 0);
3331 /* Insert from the file at the proper position. */
3332 SET_PT (same_at_start
);
3334 /* If display currently starts at beginning of line,
3335 keep it that way. */
3336 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3337 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3339 replace_handled
= 1;
3343 /* If requested, replace the accessible part of the buffer
3344 with the file contents. Avoid replacing text at the
3345 beginning or end of the buffer that matches the file contents;
3346 that preserves markers pointing to the unchanged parts.
3348 Here we implement this feature for the case where code conversion
3349 is needed, in a simple way that needs a lot of memory.
3350 The preceding if-statement handles the case of no conversion
3351 in a more optimized way. */
3352 if (!NILP (replace
) && ! replace_handled
)
3354 int same_at_start
= BEGV
;
3355 int same_at_end
= ZV
;
3358 /* Make sure that the gap is large enough. */
3359 int bufsize
= 2 * st
.st_size
;
3360 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
3362 /* First read the whole file, performing code conversion into
3363 CONVERSION_BUFFER. */
3365 if (lseek (fd
, XINT (beg
), 0) < 0)
3367 free (conversion_buffer
);
3368 report_file_error ("Setting file position",
3369 Fcons (filename
, Qnil
));
3372 total
= st
.st_size
; /* Total bytes in the file. */
3373 how_much
= 0; /* Bytes read from file so far. */
3374 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3375 unprocessed
= 0; /* Bytes not processed in previous loop. */
3377 while (how_much
< total
)
3379 /* try is reserved in some compilers (Microsoft C) */
3380 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3381 char *destination
= read_buf
+ unprocessed
;
3384 /* Allow quitting out of the actual I/O. */
3387 this = read (fd
, destination
, trytry
);
3390 if (this < 0 || this + unprocessed
== 0)
3398 if (! CODING_REQUIRE_NO_CONVERSION (&coding
))
3400 int require
, produced
, consumed
;
3402 this += unprocessed
;
3404 /* If we are using more space than estimated,
3405 make CONVERSION_BUFFER bigger. */
3406 require
= decoding_buffer_size (&coding
, this);
3407 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
3409 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
3410 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
3413 /* Convert this batch with results in CONVERSION_BUFFER. */
3414 if (how_much
>= total
) /* This is the last block. */
3415 coding
.last_block
= 1;
3416 produced
= decode_coding (&coding
, read_buf
,
3417 conversion_buffer
+ inserted
,
3418 this, bufsize
- inserted
,
3421 /* Save for next iteration whatever we didn't convert. */
3422 unprocessed
= this - consumed
;
3423 bcopy (read_buf
+ consumed
, read_buf
, unprocessed
);
3430 /* At this point, INSERTED is how many characters
3431 are present in CONVERSION_BUFFER.
3432 HOW_MUCH should equal TOTAL,
3433 or should be <= 0 if we couldn't read the file. */
3437 free (conversion_buffer
);
3440 error ("IO error reading %s: %s",
3441 XSTRING (filename
)->data
, strerror (errno
));
3442 else if (how_much
== -2)
3443 error ("maximum buffer size exceeded");
3446 /* Compare the beginning of the converted file
3447 with the buffer text. */
3450 while (bufpos
< inserted
&& same_at_start
< same_at_end
3451 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
3452 same_at_start
++, bufpos
++;
3454 /* If the file matches the buffer completely,
3455 there's no need to replace anything. */
3457 if (bufpos
== inserted
)
3459 free (conversion_buffer
);
3462 /* Truncate the buffer to the size of the file. */
3463 del_range_1 (same_at_start
, same_at_end
, 0);
3467 /* Scan this bufferful from the end, comparing with
3468 the Emacs buffer. */
3471 /* Compare with same_at_start to avoid counting some buffer text
3472 as matching both at the file's beginning and at the end. */
3473 while (bufpos
> 0 && same_at_end
> same_at_start
3474 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
3475 same_at_end
--, bufpos
--;
3477 /* Don't try to reuse the same piece of text twice. */
3478 overlap
= same_at_start
- BEGV
- (same_at_end
+ inserted
- ZV
);
3480 same_at_end
+= overlap
;
3482 /* If display currently starts at beginning of line,
3483 keep it that way. */
3484 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3485 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3487 /* Replace the chars that we need to replace,
3488 and update INSERTED to equal the number of bytes
3489 we are taking from the file. */
3490 inserted
-= (Z
- same_at_end
) + (same_at_start
- BEG
);
3491 move_gap (same_at_start
);
3492 del_range_1 (same_at_start
, same_at_end
, 0);
3493 SET_PT (same_at_start
);
3494 insert_1 (conversion_buffer
+ same_at_start
- BEG
, inserted
, 0, 0);
3496 free (conversion_buffer
);
3505 register Lisp_Object temp
;
3507 total
= XINT (end
) - XINT (beg
);
3509 /* Make sure point-max won't overflow after this insertion. */
3510 XSETINT (temp
, total
);
3511 if (total
!= XINT (temp
))
3512 error ("Maximum buffer size exceeded");
3515 /* For a special file, all we can do is guess. */
3516 total
= READ_BUF_SIZE
;
3518 if (NILP (visit
) && total
> 0)
3519 prepare_to_modify_buffer (PT
, PT
, NULL
);
3522 if (GAP_SIZE
< total
)
3523 make_gap (total
- GAP_SIZE
);
3525 if (XINT (beg
) != 0 || !NILP (replace
))
3527 if (lseek (fd
, XINT (beg
), 0) < 0)
3528 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
3531 /* In the following loop, HOW_MUCH contains the total bytes read so
3532 far. Before exiting the loop, it is set to -1 if I/O error
3533 occurs, set to -2 if the maximum buffer size is exceeded. */
3535 /* Total bytes inserted. */
3537 /* Bytes not processed in the previous loop because short gap size. */
3539 while (how_much
< total
)
3541 /* try is reserved in some compilers (Microsoft C) */
3542 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3543 char *destination
= (CODING_REQUIRE_NO_CONVERSION (&coding
)
3544 ? (char *) (POS_ADDR (PT
+ inserted
- 1) + 1)
3545 : read_buf
+ unprocessed
);
3548 /* Allow quitting out of the actual I/O. */
3551 this = read (fd
, destination
, trytry
);
3554 if (this < 0 || this + unprocessed
== 0)
3560 /* For a regular file, where TOTAL is the real size,
3561 count HOW_MUCH to compare with it.
3562 For a special file, where TOTAL is just a buffer size,
3563 so don't bother counting in HOW_MUCH.
3564 (INSERTED is where we count the number of characters inserted.) */
3568 if (! CODING_REQUIRE_NO_CONVERSION (&coding
))
3570 int require
, produced
, consumed
;
3572 this += unprocessed
;
3573 /* Make sure that the gap is large enough. */
3574 require
= decoding_buffer_size (&coding
, this);
3575 if (GAP_SIZE
< require
)
3576 make_gap (require
- GAP_SIZE
);
3580 if (how_much
>= total
) /* This is the last block. */
3581 coding
.last_block
= 1;
3585 /* If we encounter EOF, say it is the last block. (The
3586 data this will apply to is the UNPROCESSED characters
3587 carried over from the last batch.) */
3589 coding
.last_block
= 1;
3592 produced
= decode_coding (&coding
, read_buf
,
3593 POS_ADDR (PT
+ inserted
- 1) + 1,
3594 this, GAP_SIZE
, &consumed
);
3599 XSET (temp
, Lisp_Int
, Z
+ produced
);
3600 if (Z
+ produced
!= XINT (temp
))
3606 unprocessed
= this - consumed
;
3607 bcopy (read_buf
+ consumed
, read_buf
, unprocessed
);
3616 /* Put an anchor to ensure multi-byte form ends at gap. */
3621 /* We don't have to consider file type of MSDOS because all files
3622 are read as binary and end-of-line format has already been
3623 decoded appropriately. */
3626 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
3627 /* Determine file type from name and remove LFs from CR-LFs if the file
3628 is deemed to be a text file. */
3630 current_buffer
->buffer_file_type
3631 = call1 (Qfind_buffer_file_type
, filename
);
3632 if (NILP (current_buffer
->buffer_file_type
))
3635 = inserted
- crlf_to_lf (inserted
, POS_ADDR (PT
- 1) + 1);
3638 GPT
-= reduced_size
;
3639 GAP_SIZE
+= reduced_size
;
3640 inserted
-= reduced_size
;
3648 record_insert (PT
, inserted
);
3650 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
3651 offset_intervals (current_buffer
, PT
, inserted
);
3657 /* Discard the unwind protect for closing the file. */
3661 error ("IO error reading %s: %s",
3662 XSTRING (filename
)->data
, strerror (errno
));
3663 else if (how_much
== -2)
3664 error ("maximum buffer size exceeded");
3671 if (!EQ (current_buffer
->undo_list
, Qt
))
3672 current_buffer
->undo_list
= Qnil
;
3674 stat (XSTRING (filename
)->data
, &st
);
3679 current_buffer
->modtime
= st
.st_mtime
;
3680 current_buffer
->filename
= filename
;
3683 SAVE_MODIFF
= MODIFF
;
3684 current_buffer
->auto_save_modified
= MODIFF
;
3685 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3686 #ifdef CLASH_DETECTION
3689 if (!NILP (current_buffer
->file_truename
))
3690 unlock_file (current_buffer
->file_truename
);
3691 unlock_file (filename
);
3693 #endif /* CLASH_DETECTION */
3695 Fsignal (Qfile_error
,
3696 Fcons (build_string ("not a regular file"),
3697 Fcons (filename
, Qnil
)));
3699 /* If visiting nonexistent file, return nil. */
3700 if (current_buffer
->modtime
== -1)
3701 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3704 /* Decode file format */
3707 insval
= call3 (Qformat_decode
,
3708 Qnil
, make_number (inserted
), visit
);
3709 CHECK_NUMBER (insval
, 0);
3710 inserted
= XFASTINT (insval
);
3713 /* Call after-change hooks for the inserted text, aside from the case
3714 of normal visiting (not with REPLACE), which is done in a new buffer
3715 "before" the buffer is changed. */
3716 if (inserted
> 0 && total
> 0
3717 && (NILP (visit
) || !NILP (replace
)))
3718 signal_after_change (PT
, 0, inserted
);
3722 p
= Vafter_insert_file_functions
;
3723 if (!NILP (coding
.post_read_conversion
))
3724 p
= Fcons (coding
.post_read_conversion
, p
);
3728 insval
= call1 (Fcar (p
), make_number (inserted
));
3731 CHECK_NUMBER (insval
, 0);
3732 inserted
= XFASTINT (insval
);
3740 val
= Fcons (filename
,
3741 Fcons (make_number (inserted
),
3744 RETURN_UNGCPRO (unbind_to (count
, val
));
3747 static Lisp_Object
build_annotations ();
3748 extern Lisp_Object
Ffile_locked_p ();
3750 /* If build_annotations switched buffers, switch back to BUF.
3751 Kill the temporary buffer that was selected in the meantime.
3753 Since this kill only the last temporary buffer, some buffers remain
3754 not killed if build_annotations switched buffers more than once.
3758 build_annotations_unwind (buf
)
3763 if (XBUFFER (buf
) == current_buffer
)
3765 tembuf
= Fcurrent_buffer ();
3767 Fkill_buffer (tembuf
);
3771 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 6,
3772 "r\nFWrite region to file: ",
3773 "Write current region into specified file.\n\
3774 When called from a program, takes three arguments:\n\
3775 START, END and FILENAME. START and END are buffer positions.\n\
3776 Optional fourth argument APPEND if non-nil means\n\
3777 append to existing file contents (if any).\n\
3778 Optional fifth argument VISIT if t means\n\
3779 set the last-save-file-modtime of buffer to this file's modtime\n\
3780 and mark buffer not modified.\n\
3781 If VISIT is a string, it is a second file name;\n\
3782 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
3783 VISIT is also the file name to lock and unlock for clash detection.\n\
3784 If VISIT is neither t nor nil nor a string,\n\
3785 that means do not print the \"Wrote file\" message.\n\
3786 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
3787 use for locking and unlocking, overriding FILENAME and VISIT.\n\
3788 Kludgy feature: if START is a string, then that string is written\n\
3789 to the file, instead of any buffer contents, and END is ignored.")
3790 (start
, end
, filename
, append
, visit
, lockname
)
3791 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
3799 int count
= specpdl_ptr
- specpdl
;
3802 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3804 Lisp_Object handler
;
3805 Lisp_Object visit_file
;
3806 Lisp_Object annotations
;
3807 int visiting
, quietly
;
3808 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3809 struct buffer
*given_buffer
;
3811 int buffer_file_type
= O_BINARY
;
3813 struct coding_system coding
;
3815 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3816 error ("Cannot do file visiting in an indirect buffer");
3818 if (!NILP (start
) && !STRINGP (start
))
3819 validate_region (&start
, &end
);
3821 GCPRO4 (start
, filename
, visit
, lockname
);
3823 /* Decide the coding-system to be encoded to. */
3829 else if (!NILP (Vcoding_system_for_write
))
3830 val
= Vcoding_system_for_write
;
3831 else if (NILP (current_buffer
->enable_multibyte_characters
))
3832 val
= (NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
))
3834 : Fsymbol_value (Qbuffer_file_coding_system
));
3837 Lisp_Object args
[7], coding_systems
;
3839 args
[0] = Qwrite_region
, args
[1] = start
, args
[2] = end
,
3840 args
[3] = filename
, args
[4] = append
, args
[5] = visit
,
3842 coding_systems
= Ffind_operation_coding_system (7, args
);
3843 val
= (CONSP (coding_systems
) && !NILP (XCONS (coding_systems
)->cdr
)
3844 ? XCONS (coding_systems
)->cdr
3845 : current_buffer
->buffer_file_coding_system
);
3847 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3848 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
3849 coding
.selective
= 1;
3852 filename
= Fexpand_file_name (filename
, Qnil
);
3853 if (STRINGP (visit
))
3854 visit_file
= Fexpand_file_name (visit
, Qnil
);
3856 visit_file
= filename
;
3859 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
3860 quietly
= !NILP (visit
);
3864 if (NILP (lockname
))
3865 lockname
= visit_file
;
3867 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
3869 /* If the file name has special constructs in it,
3870 call the corresponding file handler. */
3871 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
3872 /* If FILENAME has no handler, see if VISIT has one. */
3873 if (NILP (handler
) && STRINGP (visit
))
3874 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
3876 if (!NILP (handler
))
3879 val
= call6 (handler
, Qwrite_region
, start
, end
,
3880 filename
, append
, visit
);
3884 SAVE_MODIFF
= MODIFF
;
3885 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3886 current_buffer
->filename
= visit_file
;
3892 /* Special kludge to simplify auto-saving. */
3895 XSETFASTINT (start
, BEG
);
3896 XSETFASTINT (end
, Z
);
3899 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
3900 count1
= specpdl_ptr
- specpdl
;
3902 given_buffer
= current_buffer
;
3903 annotations
= build_annotations (start
, end
, coding
.pre_write_conversion
);
3904 if (current_buffer
!= given_buffer
)
3906 XSETFASTINT (start
, BEGV
);
3907 XSETFASTINT (end
, ZV
);
3910 #ifdef CLASH_DETECTION
3913 #if 0 /* This causes trouble for GNUS. */
3914 /* If we've locked this file for some other buffer,
3915 query before proceeding. */
3916 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
3917 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
3920 lock_file (lockname
);
3922 #endif /* CLASH_DETECTION */
3924 fn
= XSTRING (filename
)->data
;
3928 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
3929 #else /* not DOS_NT */
3930 desc
= open (fn
, O_WRONLY
);
3931 #endif /* not DOS_NT */
3933 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
) )
3935 if (auto_saving
) /* Overwrite any previous version of autosave file */
3937 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3938 desc
= open (fn
, O_RDWR
);
3940 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3941 ? XSTRING (current_buffer
->filename
)->data
: 0,
3944 else /* Write to temporary name and rename if no errors */
3946 Lisp_Object temp_name
;
3947 temp_name
= Ffile_name_directory (filename
);
3949 if (!NILP (temp_name
))
3951 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3952 build_string ("$$SAVE$$")));
3953 fname
= XSTRING (filename
)->data
;
3954 fn
= XSTRING (temp_name
)->data
;
3955 desc
= creat_copy_attrs (fname
, fn
);
3958 /* If we can't open the temporary file, try creating a new
3959 version of the original file. VMS "creat" creates a
3960 new version rather than truncating an existing file. */
3963 desc
= creat (fn
, 0666);
3964 #if 0 /* This can clobber an existing file and fail to replace it,
3965 if the user runs out of space. */
3968 /* We can't make a new version;
3969 try to truncate and rewrite existing version if any. */
3971 desc
= open (fn
, O_RDWR
);
3977 desc
= creat (fn
, 0666);
3982 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3983 S_IREAD
| S_IWRITE
);
3984 #else /* not DOS_NT */
3985 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3986 #endif /* not DOS_NT */
3987 #endif /* not VMS */
3993 #ifdef CLASH_DETECTION
3995 if (!auto_saving
) unlock_file (lockname
);
3997 #endif /* CLASH_DETECTION */
3998 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4001 record_unwind_protect (close_file_unwind
, make_number (desc
));
4004 if (lseek (desc
, 0, 2) < 0)
4006 #ifdef CLASH_DETECTION
4007 if (!auto_saving
) unlock_file (lockname
);
4008 #endif /* CLASH_DETECTION */
4009 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4014 * Kludge Warning: The VMS C RTL likes to insert carriage returns
4015 * if we do writes that don't end with a carriage return. Furthermore
4016 * it cannot handle writes of more then 16K. The modified
4017 * version of "sys_write" in SYSDEP.C (see comment there) copes with
4018 * this EXCEPT for the last record (iff it doesn't end with a carriage
4019 * return). This implies that if your buffer doesn't end with a carriage
4020 * return, you get one free... tough. However it also means that if
4021 * we make two calls to sys_write (a la the following code) you can
4022 * get one at the gap as well. The easiest way to fix this (honest)
4023 * is to move the gap to the next newline (or the end of the buffer).
4028 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4029 move_gap (find_next_newline (GPT
, 1));
4031 /* Whether VMS or not, we must move the gap to the next of newline
4032 when we must put designation sequences at beginning of line. */
4033 if (INTEGERP (start
)
4034 && coding
.type
== coding_type_iso2022
4035 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
4036 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4037 move_gap (find_next_newline (GPT
, 1));
4043 if (STRINGP (start
))
4045 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
4046 XSTRING (start
)->size
, 0, &annotations
, &coding
);
4049 else if (XINT (start
) != XINT (end
))
4052 if (XINT (start
) < GPT
)
4054 register int end1
= XINT (end
);
4056 failure
= 0 > a_write (desc
, POS_ADDR (tem
),
4057 min (GPT
, end1
) - tem
, tem
, &annotations
,
4059 nwritten
+= min (GPT
, end1
) - tem
;
4063 if (XINT (end
) > GPT
&& !failure
)
4066 tem
= max (tem
, GPT
);
4067 failure
= 0 > a_write (desc
, POS_ADDR (tem
), XINT (end
) - tem
,
4068 tem
, &annotations
, &coding
);
4069 nwritten
+= XINT (end
) - tem
;
4075 /* If file was empty, still need to write the annotations */
4076 coding
.last_block
= 1;
4077 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
, &coding
);
4081 if (coding
.require_flushing
&& !coding
.last_block
)
4083 /* We have to flush out a data. */
4084 coding
.last_block
= 1;
4085 failure
= 0 > e_write (desc
, "", 0, &coding
);
4092 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4093 Disk full in NFS may be reported here. */
4094 /* mib says that closing the file will try to write as fast as NFS can do
4095 it, and that means the fsync here is not crucial for autosave files. */
4096 if (!auto_saving
&& fsync (desc
) < 0)
4098 /* If fsync fails with EINTR, don't treat that as serious. */
4100 failure
= 1, save_errno
= errno
;
4104 /* Spurious "file has changed on disk" warnings have been
4105 observed on Suns as well.
4106 It seems that `close' can change the modtime, under nfs.
4108 (This has supposedly been fixed in Sunos 4,
4109 but who knows about all the other machines with NFS?) */
4112 /* On VMS and APOLLO, must do the stat after the close
4113 since closing changes the modtime. */
4116 /* Recall that #if defined does not work on VMS. */
4123 /* NFS can report a write failure now. */
4124 if (close (desc
) < 0)
4125 failure
= 1, save_errno
= errno
;
4128 /* If we wrote to a temporary name and had no errors, rename to real name. */
4132 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
4140 /* Discard the unwind protect for close_file_unwind. */
4141 specpdl_ptr
= specpdl
+ count1
;
4142 /* Restore the original current buffer. */
4143 visit_file
= unbind_to (count
, visit_file
);
4145 #ifdef CLASH_DETECTION
4147 unlock_file (lockname
);
4148 #endif /* CLASH_DETECTION */
4150 /* Do this before reporting IO error
4151 to avoid a "file has changed on disk" warning on
4152 next attempt to save. */
4154 current_buffer
->modtime
= st
.st_mtime
;
4157 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
4161 SAVE_MODIFF
= MODIFF
;
4162 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4163 current_buffer
->filename
= visit_file
;
4164 update_mode_lines
++;
4170 message ("Wrote %s", XSTRING (visit_file
)->data
);
4175 Lisp_Object
merge ();
4177 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4178 "Return t if (car A) is numerically less than (car B).")
4182 return Flss (Fcar (a
), Fcar (b
));
4185 /* Build the complete list of annotations appropriate for writing out
4186 the text between START and END, by calling all the functions in
4187 write-region-annotate-functions and merging the lists they return.
4188 If one of these functions switches to a different buffer, we assume
4189 that buffer contains altered text. Therefore, the caller must
4190 make sure to restore the current buffer in all cases,
4191 as save-excursion would do. */
4194 build_annotations (start
, end
, pre_write_conversion
)
4195 Lisp_Object start
, end
, pre_write_conversion
;
4197 Lisp_Object annotations
;
4199 struct gcpro gcpro1
, gcpro2
;
4200 Lisp_Object original_buffer
;
4202 XSETBUFFER (original_buffer
, current_buffer
);
4205 p
= Vwrite_region_annotate_functions
;
4206 GCPRO2 (annotations
, p
);
4209 struct buffer
*given_buffer
= current_buffer
;
4210 Vwrite_region_annotations_so_far
= annotations
;
4211 res
= call2 (Fcar (p
), start
, end
);
4212 /* If the function makes a different buffer current,
4213 assume that means this buffer contains altered text to be output.
4214 Reset START and END from the buffer bounds
4215 and discard all previous annotations because they should have
4216 been dealt with by this function. */
4217 if (current_buffer
!= given_buffer
)
4219 XSETFASTINT (start
, BEGV
);
4220 XSETFASTINT (end
, ZV
);
4223 Flength (res
); /* Check basic validity of return value */
4224 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4228 /* Now do the same for annotation functions implied by the file-format */
4229 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
4230 p
= Vauto_save_file_format
;
4232 p
= current_buffer
->file_format
;
4235 struct buffer
*given_buffer
= current_buffer
;
4236 Vwrite_region_annotations_so_far
= annotations
;
4237 res
= call4 (Qformat_annotate_function
, Fcar (p
), start
, end
,
4239 if (current_buffer
!= given_buffer
)
4241 XSETFASTINT (start
, BEGV
);
4242 XSETFASTINT (end
, ZV
);
4246 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4250 /* At last, do the same for the function PRE_WRITE_CONVERSION
4251 implied by the current coding-system. */
4252 if (!NILP (pre_write_conversion
))
4254 struct buffer
*given_buffer
= current_buffer
;
4255 Vwrite_region_annotations_so_far
= annotations
;
4256 res
= call2 (pre_write_conversion
, start
, end
);
4258 annotations
= (current_buffer
!= given_buffer
4260 : merge (annotations
, res
, Qcar_less_than_car
));
4267 /* Write to descriptor DESC the LEN characters starting at ADDR,
4268 assuming they start at position POS in the buffer.
4269 Intersperse with them the annotations from *ANNOT
4270 (those which fall within the range of positions POS to POS + LEN),
4271 each at its appropriate position.
4273 Modify *ANNOT by discarding elements as we output them.
4274 The return value is negative in case of system call failure. */
4277 a_write (desc
, addr
, len
, pos
, annot
, coding
)
4279 register char *addr
;
4283 struct coding_system
*coding
;
4287 int lastpos
= pos
+ len
;
4289 while (NILP (*annot
) || CONSP (*annot
))
4291 tem
= Fcar_safe (Fcar (*annot
));
4292 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
4293 nextpos
= XFASTINT (tem
);
4295 return e_write (desc
, addr
, lastpos
- pos
, coding
);
4298 if (0 > e_write (desc
, addr
, nextpos
- pos
, coding
))
4300 addr
+= nextpos
- pos
;
4303 tem
= Fcdr (Fcar (*annot
));
4306 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
,
4310 *annot
= Fcdr (*annot
);
4314 #ifndef WRITE_BUF_SIZE
4315 #define WRITE_BUF_SIZE (16 * 1024)
4319 e_write (desc
, addr
, len
, coding
)
4321 register char *addr
;
4323 struct coding_system
*coding
;
4325 char buf
[WRITE_BUF_SIZE
];
4326 int produced
, consumed
;
4328 /* We used to have a code for handling selective display here. But,
4329 now it is handled within encode_coding. */
4332 produced
= encode_coding (coding
, addr
, buf
, len
, WRITE_BUF_SIZE
,
4334 len
-= consumed
, addr
+= consumed
;
4337 produced
-= write (desc
, buf
, produced
);
4338 if (produced
) return -1;
4346 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
4347 Sverify_visited_file_modtime
, 1, 1, 0,
4348 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
4349 This means that the file has not been changed since it was visited or saved.")
4355 Lisp_Object handler
;
4357 CHECK_BUFFER (buf
, 0);
4360 if (!STRINGP (b
->filename
)) return Qt
;
4361 if (b
->modtime
== 0) return Qt
;
4363 /* If the file name has special constructs in it,
4364 call the corresponding file handler. */
4365 handler
= Ffind_file_name_handler (b
->filename
,
4366 Qverify_visited_file_modtime
);
4367 if (!NILP (handler
))
4368 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
4370 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
4372 /* If the file doesn't exist now and didn't exist before,
4373 we say that it isn't modified, provided the error is a tame one. */
4374 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
4379 if (st
.st_mtime
== b
->modtime
4380 /* If both are positive, accept them if they are off by one second. */
4381 || (st
.st_mtime
> 0 && b
->modtime
> 0
4382 && (st
.st_mtime
== b
->modtime
+ 1
4383 || st
.st_mtime
== b
->modtime
- 1)))
4388 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
4389 Sclear_visited_file_modtime
, 0, 0, 0,
4390 "Clear out records of last mod time of visited file.\n\
4391 Next attempt to save will certainly not complain of a discrepancy.")
4394 current_buffer
->modtime
= 0;
4398 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
4399 Svisited_file_modtime
, 0, 0, 0,
4400 "Return the current buffer's recorded visited file modification time.\n\
4401 The value is a list of the form (HIGH . LOW), like the time values\n\
4402 that `file-attributes' returns.")
4405 return long_to_cons ((unsigned long) current_buffer
->modtime
);
4408 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
4409 Sset_visited_file_modtime
, 0, 1, 0,
4410 "Update buffer's recorded modification time from the visited file's time.\n\
4411 Useful if the buffer was not read from the file normally\n\
4412 or if the file itself has been changed for some known benign reason.\n\
4413 An argument specifies the modification time value to use\n\
4414 \(instead of that of the visited file), in the form of a list\n\
4415 \(HIGH . LOW) or (HIGH LOW).")
4417 Lisp_Object time_list
;
4419 if (!NILP (time_list
))
4420 current_buffer
->modtime
= cons_to_long (time_list
);
4423 register Lisp_Object filename
;
4425 Lisp_Object handler
;
4427 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
4429 /* If the file name has special constructs in it,
4430 call the corresponding file handler. */
4431 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
4432 if (!NILP (handler
))
4433 /* The handler can find the file name the same way we did. */
4434 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
4435 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
4436 current_buffer
->modtime
= st
.st_mtime
;
4446 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
4447 Fsleep_for (make_number (1), Qnil
);
4448 message ("Autosaving...error!for %s", XSTRING (current_buffer
->name
)->data
);
4449 Fsleep_for (make_number (1), Qnil
);
4450 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
4451 Fsleep_for (make_number (1), Qnil
);
4461 /* Get visited file's mode to become the auto save file's mode. */
4462 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
4463 /* But make sure we can overwrite it later! */
4464 auto_save_mode_bits
= st
.st_mode
| 0600;
4466 auto_save_mode_bits
= 0666;
4469 Fwrite_region (Qnil
, Qnil
,
4470 current_buffer
->auto_save_file_name
,
4471 Qnil
, Qlambda
, Qnil
);
4475 do_auto_save_unwind (stream
) /* used as unwind-protect function */
4480 fclose ((FILE *) (XFASTINT (XCONS (stream
)->car
) << 16
4481 | XFASTINT (XCONS (stream
)->cdr
)));
4486 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
4489 minibuffer_auto_raise
= XINT (value
);
4493 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
4494 "Auto-save all buffers that need it.\n\
4495 This is all buffers that have auto-saving enabled\n\
4496 and are changed since last auto-saved.\n\
4497 Auto-saving writes the buffer into a file\n\
4498 so that your editing is not lost if the system crashes.\n\
4499 This file is not the file you visited; that changes only when you save.\n\
4500 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
4501 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
4502 A non-nil CURRENT-ONLY argument means save only current buffer.")
4503 (no_message
, current_only
)
4504 Lisp_Object no_message
, current_only
;
4506 struct buffer
*old
= current_buffer
, *b
;
4507 Lisp_Object tail
, buf
;
4509 char *omessage
= echo_area_glyphs
;
4510 int omessage_length
= echo_area_glyphs_length
;
4511 int do_handled_files
;
4514 Lisp_Object lispstream
;
4515 int count
= specpdl_ptr
- specpdl
;
4517 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
4519 /* Ordinarily don't quit within this function,
4520 but don't make it impossible to quit (in case we get hung in I/O). */
4524 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
4525 point to non-strings reached from Vbuffer_alist. */
4530 if (!NILP (Vrun_hooks
))
4531 call1 (Vrun_hooks
, intern ("auto-save-hook"));
4533 if (STRINGP (Vauto_save_list_file_name
))
4535 Lisp_Object listfile
;
4536 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
4537 stream
= fopen (XSTRING (listfile
)->data
, "w");
4539 /* Arrange to close that file whether or not we get an error.
4540 Also reset auto_saving to 0. */
4541 lispstream
= Fcons (Qnil
, Qnil
);
4542 XSETFASTINT (XCONS (lispstream
)->car
, (EMACS_UINT
)stream
>> 16);
4543 XSETFASTINT (XCONS (lispstream
)->cdr
, (EMACS_UINT
)stream
& 0xffff);
4551 record_unwind_protect (do_auto_save_unwind
, lispstream
);
4552 record_unwind_protect (do_auto_save_unwind_1
,
4553 make_number (minibuffer_auto_raise
));
4554 minibuffer_auto_raise
= 0;
4557 /* First, save all files which don't have handlers. If Emacs is
4558 crashing, the handlers may tweak what is causing Emacs to crash
4559 in the first place, and it would be a shame if Emacs failed to
4560 autosave perfectly ordinary files because it couldn't handle some
4562 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
4563 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
4565 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
4568 /* Record all the buffers that have auto save mode
4569 in the special file that lists them. For each of these buffers,
4570 Record visited name (if any) and auto save name. */
4571 if (STRINGP (b
->auto_save_file_name
)
4572 && stream
!= NULL
&& do_handled_files
== 0)
4574 if (!NILP (b
->filename
))
4576 fwrite (XSTRING (b
->filename
)->data
, 1,
4577 XSTRING (b
->filename
)->size
, stream
);
4579 putc ('\n', stream
);
4580 fwrite (XSTRING (b
->auto_save_file_name
)->data
, 1,
4581 XSTRING (b
->auto_save_file_name
)->size
, stream
);
4582 putc ('\n', stream
);
4585 if (!NILP (current_only
)
4586 && b
!= current_buffer
)
4589 /* Don't auto-save indirect buffers.
4590 The base buffer takes care of it. */
4594 /* Check for auto save enabled
4595 and file changed since last auto save
4596 and file changed since last real save. */
4597 if (STRINGP (b
->auto_save_file_name
)
4598 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
4599 && b
->auto_save_modified
< BUF_MODIFF (b
)
4600 /* -1 means we've turned off autosaving for a while--see below. */
4601 && XINT (b
->save_length
) >= 0
4602 && (do_handled_files
4603 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
4606 EMACS_TIME before_time
, after_time
;
4608 EMACS_GET_TIME (before_time
);
4610 /* If we had a failure, don't try again for 20 minutes. */
4611 if (b
->auto_save_failure_time
>= 0
4612 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
4615 if ((XFASTINT (b
->save_length
) * 10
4616 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
4617 /* A short file is likely to change a large fraction;
4618 spare the user annoying messages. */
4619 && XFASTINT (b
->save_length
) > 5000
4620 /* These messages are frequent and annoying for `*mail*'. */
4621 && !EQ (b
->filename
, Qnil
)
4622 && NILP (no_message
))
4624 /* It has shrunk too much; turn off auto-saving here. */
4625 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
4626 message ("Buffer %s has shrunk a lot; auto save turned off there",
4627 XSTRING (b
->name
)->data
);
4628 minibuffer_auto_raise
= 0;
4629 /* Turn off auto-saving until there's a real save,
4630 and prevent any more warnings. */
4631 XSETINT (b
->save_length
, -1);
4632 Fsleep_for (make_number (1), Qnil
);
4635 set_buffer_internal (b
);
4636 if (!auto_saved
&& NILP (no_message
))
4637 message1 ("Auto-saving...");
4638 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
4640 b
->auto_save_modified
= BUF_MODIFF (b
);
4641 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4642 set_buffer_internal (old
);
4644 EMACS_GET_TIME (after_time
);
4646 /* If auto-save took more than 60 seconds,
4647 assume it was an NFS failure that got a timeout. */
4648 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
4649 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
4653 /* Prevent another auto save till enough input events come in. */
4654 record_auto_save ();
4656 if (auto_saved
&& NILP (no_message
))
4660 sit_for (1, 0, 0, 0, 0);
4661 message2 (omessage
, omessage_length
);
4664 message1 ("Auto-saving...done");
4669 unbind_to (count
, Qnil
);
4673 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
4674 Sset_buffer_auto_saved
, 0, 0, 0,
4675 "Mark current buffer as auto-saved with its current text.\n\
4676 No auto-save file will be written until the buffer changes again.")
4679 current_buffer
->auto_save_modified
= MODIFF
;
4680 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4681 current_buffer
->auto_save_failure_time
= -1;
4685 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
4686 Sclear_buffer_auto_save_failure
, 0, 0, 0,
4687 "Clear any record of a recent auto-save failure in the current buffer.")
4690 current_buffer
->auto_save_failure_time
= -1;
4694 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
4696 "Return t if buffer has been auto-saved since last read in or saved.")
4699 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
4702 /* Reading and completing file names */
4703 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
4705 /* In the string VAL, change each $ to $$ and return the result. */
4708 double_dollars (val
)
4711 register unsigned char *old
, *new;
4715 osize
= XSTRING (val
)->size
;
4716 /* Quote "$" as "$$" to get it past substitute-in-file-name */
4717 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
4718 if (*old
++ == '$') count
++;
4721 old
= XSTRING (val
)->data
;
4722 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
4723 new = XSTRING (val
)->data
;
4724 for (n
= osize
; n
> 0; n
--)
4737 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
4739 "Internal subroutine for read-file-name. Do not call this.")
4740 (string
, dir
, action
)
4741 Lisp_Object string
, dir
, action
;
4742 /* action is nil for complete, t for return list of completions,
4743 lambda for verify final value */
4745 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
4747 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4749 CHECK_STRING (string
, 0);
4756 /* No need to protect ACTION--we only compare it with t and nil. */
4757 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
4759 if (XSTRING (string
)->size
== 0)
4761 if (EQ (action
, Qlambda
))
4769 orig_string
= string
;
4770 string
= Fsubstitute_in_file_name (string
);
4771 changed
= NILP (Fstring_equal (string
, orig_string
));
4772 name
= Ffile_name_nondirectory (string
);
4773 val
= Ffile_name_directory (string
);
4775 realdir
= Fexpand_file_name (val
, realdir
);
4780 specdir
= Ffile_name_directory (string
);
4781 val
= Ffile_name_completion (name
, realdir
);
4786 return double_dollars (string
);
4790 if (!NILP (specdir
))
4791 val
= concat2 (specdir
, val
);
4793 return double_dollars (val
);
4796 #endif /* not VMS */
4800 if (EQ (action
, Qt
))
4801 return Ffile_name_all_completions (name
, realdir
);
4802 /* Only other case actually used is ACTION = lambda */
4804 /* Supposedly this helps commands such as `cd' that read directory names,
4805 but can someone explain how it helps them? -- RMS */
4806 if (XSTRING (name
)->size
== 0)
4809 return Ffile_exists_p (string
);
4812 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4813 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
4814 Value is not expanded---you must call `expand-file-name' yourself.\n\
4815 Default name to DEFAULT-FILENAME if user enters a null string.\n\
4816 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
4817 except that if INITIAL is specified, that combined with DIR is used.)\n\
4818 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
4819 Non-nil and non-t means also require confirmation after completion.\n\
4820 Fifth arg INITIAL specifies text to start with.\n\
4821 DIR defaults to current buffer's directory default.")
4822 (prompt
, dir
, default_filename
, mustmatch
, initial
)
4823 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
4825 Lisp_Object val
, insdef
, insdef1
, tem
;
4826 struct gcpro gcpro1
, gcpro2
;
4827 register char *homedir
;
4831 dir
= current_buffer
->directory
;
4832 if (NILP (default_filename
))
4834 if (! NILP (initial
))
4835 default_filename
= Fexpand_file_name (initial
, dir
);
4837 default_filename
= current_buffer
->filename
;
4840 /* If dir starts with user's homedir, change that to ~. */
4841 homedir
= (char *) egetenv ("HOME");
4843 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
4844 CORRECT_DIR_SEPS (homedir
);
4848 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4849 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
4851 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4852 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4853 XSTRING (dir
)->data
[0] = '~';
4856 if (insert_default_directory
&& STRINGP (dir
))
4859 if (!NILP (initial
))
4861 Lisp_Object args
[2], pos
;
4865 insdef
= Fconcat (2, args
);
4866 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
4867 insdef1
= Fcons (double_dollars (insdef
), pos
);
4870 insdef1
= double_dollars (insdef
);
4872 else if (STRINGP (initial
))
4875 insdef1
= Fcons (double_dollars (insdef
), make_number (0));
4878 insdef
= Qnil
, insdef1
= Qnil
;
4881 count
= specpdl_ptr
- specpdl
;
4882 specbind (intern ("completion-ignore-case"), Qt
);
4885 GCPRO2 (insdef
, default_filename
);
4886 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4887 dir
, mustmatch
, insdef1
,
4888 Qfile_name_history
, default_filename
);
4889 /* If Fcompleting_read returned the default string itself
4890 (rather than a new string with the same contents),
4891 it has to mean that the user typed RET with the minibuffer empty.
4892 In that case, we really want to return ""
4893 so that commands such as set-visited-file-name can distinguish. */
4894 if (EQ (val
, default_filename
))
4895 val
= build_string ("");
4898 unbind_to (count
, Qnil
);
4903 error ("No file name specified");
4904 tem
= Fstring_equal (val
, insdef
);
4905 if (!NILP (tem
) && !NILP (default_filename
))
4906 return default_filename
;
4907 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
4909 if (!NILP (default_filename
))
4910 return default_filename
;
4912 error ("No default file name");
4914 return Fsubstitute_in_file_name (val
);
4917 #if 0 /* Old version */
4918 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4919 /* Don't confuse make-docfile by having two doc strings for this function.
4920 make-docfile does not pay attention to #if, for good reason! */
4922 (prompt
, dir
, defalt
, mustmatch
, initial
)
4923 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4925 Lisp_Object val
, insdef
, tem
;
4926 struct gcpro gcpro1
, gcpro2
;
4927 register char *homedir
;
4931 dir
= current_buffer
->directory
;
4933 defalt
= current_buffer
->filename
;
4935 /* If dir starts with user's homedir, change that to ~. */
4936 homedir
= (char *) egetenv ("HOME");
4939 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4940 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
4942 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4943 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4944 XSTRING (dir
)->data
[0] = '~';
4947 if (!NILP (initial
))
4949 else if (insert_default_directory
)
4952 insdef
= build_string ("");
4955 count
= specpdl_ptr
- specpdl
;
4956 specbind (intern ("completion-ignore-case"), Qt
);
4959 GCPRO2 (insdef
, defalt
);
4960 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4962 insert_default_directory
? insdef
: Qnil
,
4963 Qfile_name_history
, Qnil
);
4966 unbind_to (count
, Qnil
);
4971 error ("No file name specified");
4972 tem
= Fstring_equal (val
, insdef
);
4973 if (!NILP (tem
) && !NILP (defalt
))
4975 return Fsubstitute_in_file_name (val
);
4977 #endif /* Old version */
4981 Qexpand_file_name
= intern ("expand-file-name");
4982 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
4983 Qdirectory_file_name
= intern ("directory-file-name");
4984 Qfile_name_directory
= intern ("file-name-directory");
4985 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
4986 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
4987 Qfile_name_as_directory
= intern ("file-name-as-directory");
4988 Qcopy_file
= intern ("copy-file");
4989 Qmake_directory_internal
= intern ("make-directory-internal");
4990 Qdelete_directory
= intern ("delete-directory");
4991 Qdelete_file
= intern ("delete-file");
4992 Qrename_file
= intern ("rename-file");
4993 Qadd_name_to_file
= intern ("add-name-to-file");
4994 Qmake_symbolic_link
= intern ("make-symbolic-link");
4995 Qfile_exists_p
= intern ("file-exists-p");
4996 Qfile_executable_p
= intern ("file-executable-p");
4997 Qfile_readable_p
= intern ("file-readable-p");
4998 Qfile_writable_p
= intern ("file-writable-p");
4999 Qfile_symlink_p
= intern ("file-symlink-p");
5000 Qaccess_file
= intern ("access-file");
5001 Qfile_directory_p
= intern ("file-directory-p");
5002 Qfile_regular_p
= intern ("file-regular-p");
5003 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
5004 Qfile_modes
= intern ("file-modes");
5005 Qset_file_modes
= intern ("set-file-modes");
5006 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
5007 Qinsert_file_contents
= intern ("insert-file-contents");
5008 Qwrite_region
= intern ("write-region");
5009 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
5010 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
5012 staticpro (&Qexpand_file_name
);
5013 staticpro (&Qsubstitute_in_file_name
);
5014 staticpro (&Qdirectory_file_name
);
5015 staticpro (&Qfile_name_directory
);
5016 staticpro (&Qfile_name_nondirectory
);
5017 staticpro (&Qunhandled_file_name_directory
);
5018 staticpro (&Qfile_name_as_directory
);
5019 staticpro (&Qcopy_file
);
5020 staticpro (&Qmake_directory_internal
);
5021 staticpro (&Qdelete_directory
);
5022 staticpro (&Qdelete_file
);
5023 staticpro (&Qrename_file
);
5024 staticpro (&Qadd_name_to_file
);
5025 staticpro (&Qmake_symbolic_link
);
5026 staticpro (&Qfile_exists_p
);
5027 staticpro (&Qfile_executable_p
);
5028 staticpro (&Qfile_readable_p
);
5029 staticpro (&Qfile_writable_p
);
5030 staticpro (&Qaccess_file
);
5031 staticpro (&Qfile_symlink_p
);
5032 staticpro (&Qfile_directory_p
);
5033 staticpro (&Qfile_regular_p
);
5034 staticpro (&Qfile_accessible_directory_p
);
5035 staticpro (&Qfile_modes
);
5036 staticpro (&Qset_file_modes
);
5037 staticpro (&Qfile_newer_than_file_p
);
5038 staticpro (&Qinsert_file_contents
);
5039 staticpro (&Qwrite_region
);
5040 staticpro (&Qverify_visited_file_modtime
);
5041 staticpro (&Qset_visited_file_modtime
);
5043 Qfile_name_history
= intern ("file-name-history");
5044 Fset (Qfile_name_history
, Qnil
);
5045 staticpro (&Qfile_name_history
);
5047 Qfile_error
= intern ("file-error");
5048 staticpro (&Qfile_error
);
5049 Qfile_already_exists
= intern ("file-already-exists");
5050 staticpro (&Qfile_already_exists
);
5051 Qfile_date_error
= intern ("file-date-error");
5052 staticpro (&Qfile_date_error
);
5055 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
5056 staticpro (&Qfind_buffer_file_type
);
5059 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
5060 "*Format in which to write auto-save files.\n\
5061 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
5062 If it is t, which is the default, auto-save files are written in the\n\
5063 same format as a regular save would use.");
5064 Vauto_save_file_format
= Qt
;
5066 Qformat_decode
= intern ("format-decode");
5067 staticpro (&Qformat_decode
);
5068 Qformat_annotate_function
= intern ("format-annotate-function");
5069 staticpro (&Qformat_annotate_function
);
5071 Qcar_less_than_car
= intern ("car-less-than-car");
5072 staticpro (&Qcar_less_than_car
);
5074 Fput (Qfile_error
, Qerror_conditions
,
5075 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
5076 Fput (Qfile_error
, Qerror_message
,
5077 build_string ("File error"));
5079 Fput (Qfile_already_exists
, Qerror_conditions
,
5080 Fcons (Qfile_already_exists
,
5081 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5082 Fput (Qfile_already_exists
, Qerror_message
,
5083 build_string ("File already exists"));
5085 Fput (Qfile_date_error
, Qerror_conditions
,
5086 Fcons (Qfile_date_error
,
5087 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5088 Fput (Qfile_date_error
, Qerror_message
,
5089 build_string ("Cannot set file date"));
5091 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
5092 "*Non-nil means when reading a filename start with default dir in minibuffer.");
5093 insert_default_directory
= 1;
5095 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
5096 "*Non-nil means write new files with record format `stmlf'.\n\
5097 nil means use format `var'. This variable is meaningful only on VMS.");
5098 vms_stmlf_recfm
= 0;
5100 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
5101 "Directory separator character for built-in functions that return file names.\n\
5102 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
5103 This variable affects the built-in functions only on Windows,\n\
5104 on other platforms, it is initialized so that Lisp code can find out\n\
5105 what the normal separator is.");
5106 XSETFASTINT (Vdirectory_sep_char
, '/');
5108 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5109 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
5110 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
5113 The first argument given to HANDLER is the name of the I/O primitive\n\
5114 to be handled; the remaining arguments are the arguments that were\n\
5115 passed to that primitive. For example, if you do\n\
5116 (file-exists-p FILENAME)\n\
5117 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
5118 (funcall HANDLER 'file-exists-p FILENAME)\n\
5119 The function `find-file-name-handler' checks this list for a handler\n\
5120 for its argument.");
5121 Vfile_name_handler_alist
= Qnil
;
5123 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5124 "A list of functions to be called at the end of `insert-file-contents'.\n\
5125 Each is passed one argument, the number of bytes inserted. It should return\n\
5126 the new byte count, and leave point the same. If `insert-file-contents' is\n\
5127 intercepted by a handler from `file-name-handler-alist', that handler is\n\
5128 responsible for calling the after-insert-file-functions if appropriate.");
5129 Vafter_insert_file_functions
= Qnil
;
5131 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5132 "A list of functions to be called at the start of `write-region'.\n\
5133 Each is passed two arguments, START and END as for `write-region'.\n\
5134 These are usually two numbers but not always; see the documentation\n\
5135 for `write-region'. The function should return a list of pairs\n\
5136 of the form (POSITION . STRING), consisting of strings to be effectively\n\
5137 inserted at the specified positions of the file being written (1 means to\n\
5138 insert before the first byte written). The POSITIONs must be sorted into\n\
5139 increasing order. If there are several functions in the list, the several\n\
5140 lists are merged destructively.");
5141 Vwrite_region_annotate_functions
= Qnil
;
5143 DEFVAR_LISP ("write-region-annotations-so-far",
5144 &Vwrite_region_annotations_so_far
,
5145 "When an annotation function is called, this holds the previous annotations.\n\
5146 These are the annotations made by other annotation functions\n\
5147 that were already called. See also `write-region-annotate-functions'.");
5148 Vwrite_region_annotations_so_far
= Qnil
;
5150 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5151 "A list of file name handlers that temporarily should not be used.\n\
5152 This applies only to the operation `inhibit-file-name-operation'.");
5153 Vinhibit_file_name_handlers
= Qnil
;
5155 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5156 "The operation for which `inhibit-file-name-handlers' is applicable.");
5157 Vinhibit_file_name_operation
= Qnil
;
5159 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5160 "File name in which we write a list of all auto save file names.\n\
5161 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
5162 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
5164 Vauto_save_list_file_name
= Qnil
;
5166 defsubr (&Sfind_file_name_handler
);
5167 defsubr (&Sfile_name_directory
);
5168 defsubr (&Sfile_name_nondirectory
);
5169 defsubr (&Sunhandled_file_name_directory
);
5170 defsubr (&Sfile_name_as_directory
);
5171 defsubr (&Sdirectory_file_name
);
5172 defsubr (&Smake_temp_name
);
5173 defsubr (&Sexpand_file_name
);
5174 defsubr (&Ssubstitute_in_file_name
);
5175 defsubr (&Scopy_file
);
5176 defsubr (&Smake_directory_internal
);
5177 defsubr (&Sdelete_directory
);
5178 defsubr (&Sdelete_file
);
5179 defsubr (&Srename_file
);
5180 defsubr (&Sadd_name_to_file
);
5182 defsubr (&Smake_symbolic_link
);
5183 #endif /* S_IFLNK */
5185 defsubr (&Sdefine_logical_name
);
5188 defsubr (&Ssysnetunam
);
5189 #endif /* HPUX_NET */
5190 defsubr (&Sfile_name_absolute_p
);
5191 defsubr (&Sfile_exists_p
);
5192 defsubr (&Sfile_executable_p
);
5193 defsubr (&Sfile_readable_p
);
5194 defsubr (&Sfile_writable_p
);
5195 defsubr (&Saccess_file
);
5196 defsubr (&Sfile_symlink_p
);
5197 defsubr (&Sfile_directory_p
);
5198 defsubr (&Sfile_accessible_directory_p
);
5199 defsubr (&Sfile_regular_p
);
5200 defsubr (&Sfile_modes
);
5201 defsubr (&Sset_file_modes
);
5202 defsubr (&Sset_default_file_modes
);
5203 defsubr (&Sdefault_file_modes
);
5204 defsubr (&Sfile_newer_than_file_p
);
5205 defsubr (&Sinsert_file_contents
);
5206 defsubr (&Swrite_region
);
5207 defsubr (&Scar_less_than_car
);
5208 defsubr (&Sverify_visited_file_modtime
);
5209 defsubr (&Sclear_visited_file_modtime
);
5210 defsubr (&Svisited_file_modtime
);
5211 defsubr (&Sset_visited_file_modtime
);
5212 defsubr (&Sdo_auto_save
);
5213 defsubr (&Sset_buffer_auto_saved
);
5214 defsubr (&Sclear_buffer_auto_save_failure
);
5215 defsubr (&Srecent_auto_save_p
);
5217 defsubr (&Sread_file_name_internal
);
5218 defsubr (&Sread_file_name
);
5221 defsubr (&Sunix_sync
);