1 /* File IO for GNU Emacs.
2 Copyright (C) 1985,86,87,88,93,94,95,96 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 /* These variables describe handlers that have "already" had a chance
202 to handle the current operation.
204 Vinhibit_file_name_handlers is a list of file name handlers.
205 Vinhibit_file_name_operation is the operation being handled.
206 If we try to handle that operation, we ignore those handlers. */
208 static Lisp_Object Vinhibit_file_name_handlers
;
209 static Lisp_Object Vinhibit_file_name_operation
;
211 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
213 Lisp_Object Qfile_name_history
;
215 Lisp_Object Qcar_less_than_car
;
217 report_file_error (string
, data
)
221 Lisp_Object errstring
;
223 errstring
= build_string (strerror (errno
));
225 /* System error messages are capitalized. Downcase the initial
226 unless it is followed by a slash. */
227 if (XSTRING (errstring
)->data
[1] != '/')
228 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
231 Fsignal (Qfile_error
,
232 Fcons (build_string (string
), Fcons (errstring
, data
)));
235 close_file_unwind (fd
)
238 close (XFASTINT (fd
));
241 /* Restore point, having saved it as a marker. */
243 restore_point_unwind (location
)
244 Lisp_Object location
;
246 SET_PT (marker_position (location
));
247 Fset_marker (location
, Qnil
, Qnil
);
250 Lisp_Object Qexpand_file_name
;
251 Lisp_Object Qsubstitute_in_file_name
;
252 Lisp_Object Qdirectory_file_name
;
253 Lisp_Object Qfile_name_directory
;
254 Lisp_Object Qfile_name_nondirectory
;
255 Lisp_Object Qunhandled_file_name_directory
;
256 Lisp_Object Qfile_name_as_directory
;
257 Lisp_Object Qcopy_file
;
258 Lisp_Object Qmake_directory_internal
;
259 Lisp_Object Qdelete_directory
;
260 Lisp_Object Qdelete_file
;
261 Lisp_Object Qrename_file
;
262 Lisp_Object Qadd_name_to_file
;
263 Lisp_Object Qmake_symbolic_link
;
264 Lisp_Object Qfile_exists_p
;
265 Lisp_Object Qfile_executable_p
;
266 Lisp_Object Qfile_readable_p
;
267 Lisp_Object Qfile_writable_p
;
268 Lisp_Object Qfile_symlink_p
;
269 Lisp_Object Qaccess_file
;
270 Lisp_Object Qfile_directory_p
;
271 Lisp_Object Qfile_regular_p
;
272 Lisp_Object Qfile_accessible_directory_p
;
273 Lisp_Object Qfile_modes
;
274 Lisp_Object Qset_file_modes
;
275 Lisp_Object Qfile_newer_than_file_p
;
276 Lisp_Object Qinsert_file_contents
;
277 Lisp_Object Qwrite_region
;
278 Lisp_Object Qverify_visited_file_modtime
;
279 Lisp_Object Qset_visited_file_modtime
;
281 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
282 "Return FILENAME's handler function for OPERATION, if it has one.\n\
283 Otherwise, return nil.\n\
284 A file name is handled if one of the regular expressions in\n\
285 `file-name-handler-alist' matches it.\n\n\
286 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
287 any handlers that are members of `inhibit-file-name-handlers',\n\
288 but we still do run any other handlers. This lets handlers\n\
289 use the standard functions without calling themselves recursively.")
290 (filename
, operation
)
291 Lisp_Object filename
, operation
;
293 /* This function must not munge the match data. */
294 Lisp_Object chain
, inhibited_handlers
;
296 CHECK_STRING (filename
, 0);
298 if (EQ (operation
, Vinhibit_file_name_operation
))
299 inhibited_handlers
= Vinhibit_file_name_handlers
;
301 inhibited_handlers
= Qnil
;
303 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
304 chain
= XCONS (chain
)->cdr
)
307 elt
= XCONS (chain
)->car
;
311 string
= XCONS (elt
)->car
;
312 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
314 Lisp_Object handler
, tem
;
316 handler
= XCONS (elt
)->cdr
;
317 tem
= Fmemq (handler
, inhibited_handlers
);
328 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
330 "Return the directory component in file name FILENAME.\n\
331 Return nil if FILENAME does not include a directory.\n\
332 Otherwise return a directory spec.\n\
333 Given a Unix syntax file name, returns a string ending in slash;\n\
334 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
336 Lisp_Object filename
;
338 register unsigned char *beg
;
339 register unsigned char *p
;
342 CHECK_STRING (filename
, 0);
344 /* If the file name has special constructs in it,
345 call the corresponding file handler. */
346 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
348 return call2 (handler
, Qfile_name_directory
, filename
);
350 #ifdef FILE_SYSTEM_CASE
351 filename
= FILE_SYSTEM_CASE (filename
);
353 beg
= XSTRING (filename
)->data
;
355 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
357 p
= beg
+ XSTRING (filename
)->size
;
359 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
361 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
364 /* only recognise drive specifier at beginning */
365 && !(p
[-1] == ':' && p
== beg
+ 2)
372 /* Expansion of "c:" to drive and default directory. */
373 if (p
== beg
+ 2 && beg
[1] == ':')
375 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
376 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
377 if (getdefdir (toupper (*beg
) - 'A' + 1, res
))
379 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
382 p
= beg
+ strlen (beg
);
385 CORRECT_DIR_SEPS (beg
);
387 return make_string (beg
, p
- beg
);
390 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
392 "Return file name FILENAME sans its directory.\n\
393 For example, in a Unix-syntax file name,\n\
394 this is everything after the last slash,\n\
395 or the entire name if it contains no slash.")
397 Lisp_Object filename
;
399 register unsigned char *beg
, *p
, *end
;
402 CHECK_STRING (filename
, 0);
404 /* If the file name has special constructs in it,
405 call the corresponding file handler. */
406 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
408 return call2 (handler
, Qfile_name_nondirectory
, filename
);
410 beg
= XSTRING (filename
)->data
;
411 end
= p
= beg
+ XSTRING (filename
)->size
;
413 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
415 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
418 /* only recognise drive specifier at beginning */
419 && !(p
[-1] == ':' && p
== beg
+ 2)
423 return make_string (p
, end
- p
);
426 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
, Sunhandled_file_name_directory
, 1, 1, 0,
427 "Return a directly usable directory name somehow associated with FILENAME.\n\
428 A `directly usable' directory name is one that may be used without the\n\
429 intervention of any file handler.\n\
430 If FILENAME is a directly usable file itself, return\n\
431 (file-name-directory FILENAME).\n\
432 The `call-process' and `start-process' functions use this function to\n\
433 get a current directory to run processes in.")
435 Lisp_Object filename
;
439 /* If the file name has special constructs in it,
440 call the corresponding file handler. */
441 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
443 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
445 return Ffile_name_directory (filename
);
450 file_name_as_directory (out
, in
)
453 int size
= strlen (in
) - 1;
458 /* Is it already a directory string? */
459 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
461 /* Is it a VMS directory file name? If so, hack VMS syntax. */
462 else if (! index (in
, '/')
463 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
464 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
465 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
466 || ! strncmp (&in
[size
- 5], ".dir", 4))
467 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
468 && in
[size
] == '1')))
470 register char *p
, *dot
;
474 dir:x.dir --> dir:[x]
475 dir:[x]y.dir --> dir:[x.y] */
477 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
480 strncpy (out
, in
, p
- in
);
499 dot
= index (p
, '.');
502 /* blindly remove any extension */
503 size
= strlen (out
) + (dot
- p
);
504 strncat (out
, p
, dot
- p
);
515 /* For Unix syntax, Append a slash if necessary */
516 if (!IS_DIRECTORY_SEP (out
[size
]))
518 out
[size
+ 1] = DIRECTORY_SEP
;
519 out
[size
+ 2] = '\0';
522 CORRECT_DIR_SEPS (out
);
528 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
529 Sfile_name_as_directory
, 1, 1, 0,
530 "Return a string representing file FILENAME interpreted as a directory.\n\
531 This operation exists because a directory is also a file, but its name as\n\
532 a directory is different from its name as a file.\n\
533 The result can be used as the value of `default-directory'\n\
534 or passed as second argument to `expand-file-name'.\n\
535 For a Unix-syntax file name, just appends a slash.\n\
536 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
543 CHECK_STRING (file
, 0);
547 /* If the file name has special constructs in it,
548 call the corresponding file handler. */
549 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
551 return call2 (handler
, Qfile_name_as_directory
, file
);
553 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
554 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
558 * Convert from directory name to filename.
560 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
561 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
562 * On UNIX, it's simple: just make sure there isn't a terminating /
564 * Value is nonzero if the string output is different from the input.
567 directory_file_name (src
, dst
)
575 struct FAB fab
= cc$rms_fab
;
576 struct NAM nam
= cc$rms_nam
;
577 char esa
[NAM$C_MAXRSS
];
582 if (! index (src
, '/')
583 && (src
[slen
- 1] == ']'
584 || src
[slen
- 1] == ':'
585 || src
[slen
- 1] == '>'))
587 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
589 fab
.fab$b_fns
= slen
;
590 fab
.fab$l_nam
= &nam
;
591 fab
.fab$l_fop
= FAB$M_NAM
;
594 nam
.nam$b_ess
= sizeof esa
;
595 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
597 /* We call SYS$PARSE to handle such things as [--] for us. */
598 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
600 slen
= nam
.nam$b_esl
;
601 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
606 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
608 /* what about when we have logical_name:???? */
609 if (src
[slen
- 1] == ':')
610 { /* Xlate logical name and see what we get */
611 ptr
= strcpy (dst
, src
); /* upper case for getenv */
614 if ('a' <= *ptr
&& *ptr
<= 'z')
618 dst
[slen
- 1] = 0; /* remove colon */
619 if (!(src
= egetenv (dst
)))
621 /* should we jump to the beginning of this procedure?
622 Good points: allows us to use logical names that xlate
624 Bad points: can be a problem if we just translated to a device
626 For now, I'll punt and always expect VMS names, and hope for
629 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
630 { /* no recursion here! */
636 { /* not a directory spec */
641 bracket
= src
[slen
- 1];
643 /* If bracket is ']' or '>', bracket - 2 is the corresponding
645 ptr
= index (src
, bracket
- 2);
647 { /* no opening bracket */
651 if (!(rptr
= rindex (src
, '.')))
654 strncpy (dst
, src
, slen
);
658 dst
[slen
++] = bracket
;
663 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
664 then translate the device and recurse. */
665 if (dst
[slen
- 1] == ':'
666 && dst
[slen
- 2] != ':' /* skip decnet nodes */
667 && strcmp (src
+ slen
, "[000000]") == 0)
669 dst
[slen
- 1] = '\0';
670 if ((ptr
= egetenv (dst
))
671 && (rlen
= strlen (ptr
) - 1) > 0
672 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
673 && ptr
[rlen
- 1] == '.')
675 char * buf
= (char *) alloca (strlen (ptr
) + 1);
679 return directory_file_name (buf
, dst
);
684 strcat (dst
, "[000000]");
688 rlen
= strlen (rptr
) - 1;
689 strncat (dst
, rptr
, rlen
);
690 dst
[slen
+ rlen
] = '\0';
691 strcat (dst
, ".DIR.1");
695 /* Process as Unix format: just remove any final slash.
696 But leave "/" unchanged; do not change it to "". */
699 /* Handle // as root for apollo's. */
700 if ((slen
> 2 && dst
[slen
- 1] == '/')
701 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
705 && IS_DIRECTORY_SEP (dst
[slen
- 1])
707 && !IS_ANY_SEP (dst
[slen
- 2])
713 CORRECT_DIR_SEPS (dst
);
718 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
720 "Returns the file name of the directory named DIRECTORY.\n\
721 This is the name of the file that holds the data for the directory DIRECTORY.\n\
722 This operation exists because a directory is also a file, but its name as\n\
723 a directory is different from its name as a file.\n\
724 In Unix-syntax, this function just removes the final slash.\n\
725 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
726 it returns a file name such as \"[X]Y.DIR.1\".")
728 Lisp_Object directory
;
733 CHECK_STRING (directory
, 0);
735 if (NILP (directory
))
738 /* If the file name has special constructs in it,
739 call the corresponding file handler. */
740 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
742 return call2 (handler
, Qdirectory_file_name
, directory
);
745 /* 20 extra chars is insufficient for VMS, since we might perform a
746 logical name translation. an equivalence string can be up to 255
747 chars long, so grab that much extra space... - sss */
748 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
750 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
752 directory_file_name (XSTRING (directory
)->data
, buf
);
753 return build_string (buf
);
756 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
757 "Generate temporary file name (string) starting with PREFIX (a string).\n\
758 The Emacs process number forms part of the result,\n\
759 so there is no danger of generating a name being used by another process.")
765 /* Don't use too many characters of the restricted 8+3 DOS
767 val
= concat2 (prefix
, build_string ("a.XXX"));
769 val
= concat2 (prefix
, build_string ("XXXXXX"));
771 mktemp (XSTRING (val
)->data
);
773 CORRECT_DIR_SEPS (XSTRING (val
)->data
);
778 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
779 "Convert filename NAME to absolute, and canonicalize it.\n\
780 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative\n\
781 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,\n\
782 the current buffer's value of default-directory is used.\n\
783 File name components that are `.' are removed, and \n\
784 so are file name components followed by `..', along with the `..' itself;\n\
785 note that these simplifications are done without checking the resulting\n\
786 file names in the file system.\n\
787 An initial `~/' expands to your home directory.\n\
788 An initial `~USER/' expands to USER's home directory.\n\
789 See also the function `substitute-in-file-name'.")
790 (name
, default_directory
)
791 Lisp_Object name
, default_directory
;
795 register unsigned char *newdir
, *p
, *o
;
797 unsigned char *target
;
800 unsigned char * colon
= 0;
801 unsigned char * close
= 0;
802 unsigned char * slash
= 0;
803 unsigned char * brack
= 0;
804 int lbrack
= 0, rbrack
= 0;
809 int collapse_newdir
= 1;
814 CHECK_STRING (name
, 0);
816 /* If the file name has special constructs in it,
817 call the corresponding file handler. */
818 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
820 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
822 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
823 if (NILP (default_directory
))
824 default_directory
= current_buffer
->directory
;
825 CHECK_STRING (default_directory
, 1);
827 if (!NILP (default_directory
))
829 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
831 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
834 o
= XSTRING (default_directory
)->data
;
836 /* Make sure DEFAULT_DIRECTORY is properly expanded.
837 It would be better to do this down below where we actually use
838 default_directory. Unfortunately, calling Fexpand_file_name recursively
839 could invoke GC, and the strings might be relocated. This would
840 be annoying because we have pointers into strings lying around
841 that would need adjusting, and people would add new pointers to
842 the code and forget to adjust them, resulting in intermittent bugs.
843 Putting this call here avoids all that crud.
845 The EQ test avoids infinite recursion. */
846 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
847 /* Save time in some common cases - as long as default_directory
848 is not relative, it can be canonicalized with name below (if it
849 is needed at all) without requiring it to be expanded now. */
851 /* Detect MSDOS file names with drive specifiers. */
852 && ! (IS_DRIVE (o
[0]) && (IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2])))
854 /* Detect Windows file names in UNC format. */
855 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
857 #else /* not DOS_NT */
858 /* Detect Unix absolute file names (/... alone is not absolute on
860 && ! (IS_DIRECTORY_SEP (o
[0]))
861 #endif /* not DOS_NT */
867 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
872 /* Filenames on VMS are always upper case. */
873 name
= Fupcase (name
);
875 #ifdef FILE_SYSTEM_CASE
876 name
= FILE_SYSTEM_CASE (name
);
879 nm
= XSTRING (name
)->data
;
882 /* We will force directory separators to be either all \ or /, so make
883 a local copy to modify, even if there ends up being no change. */
884 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
886 /* Find and remove drive specifier if present; this makes nm absolute
887 even if the rest of the name appears to be relative. */
889 unsigned char *colon
= rindex (nm
, ':');
892 /* Only recognize colon as part of drive specifier if there is a
893 single alphabetic character preceeding the colon (and if the
894 character before the drive letter, if present, is a directory
895 separator); this is to support the remote system syntax used by
896 ange-ftp, and the "po:username" syntax for POP mailboxes. */
900 else if (IS_DRIVE (colon
[-1])
901 && (colon
== nm
+ 1 || IS_DIRECTORY_SEP (colon
[-2])))
908 while (--colon
>= nm
)
916 /* Discard any previous drive specifier if nm is now in UNC format. */
917 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
923 /* If nm is absolute, look for /./ or /../ sequences; if none are
924 found, we can probably return right away. We will avoid allocating
925 a new string if name is already fully expanded. */
927 IS_DIRECTORY_SEP (nm
[0])
932 && (drive
|| IS_DIRECTORY_SEP (nm
[1]))
939 /* If it turns out that the filename we want to return is just a
940 suffix of FILENAME, we don't need to go through and edit
941 things; we just need to construct a new string using data
942 starting at the middle of FILENAME. If we set lose to a
943 non-zero value, that means we've discovered that we can't do
950 /* Since we know the name is absolute, we can assume that each
951 element starts with a "/". */
953 /* "." and ".." are hairy. */
954 if (IS_DIRECTORY_SEP (p
[0])
956 && (IS_DIRECTORY_SEP (p
[2])
958 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
965 /* if dev:[dir]/, move nm to / */
966 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
967 nm
= (brack
? brack
+ 1 : colon
+ 1);
976 /* VMS pre V4.4,convert '-'s in filenames. */
977 if (lbrack
== rbrack
)
979 if (dots
< 2) /* this is to allow negative version numbers */
984 if (lbrack
> rbrack
&&
985 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
986 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
992 /* count open brackets, reset close bracket pointer */
993 if (p
[0] == '[' || p
[0] == '<')
995 /* count close brackets, set close bracket pointer */
996 if (p
[0] == ']' || p
[0] == '>')
998 /* detect ][ or >< */
999 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1001 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1002 nm
= p
+ 1, lose
= 1;
1003 if (p
[0] == ':' && (colon
|| slash
))
1004 /* if dev1:[dir]dev2:, move nm to dev2: */
1010 /* if /name/dev:, move nm to dev: */
1013 /* if node::dev:, move colon following dev */
1014 else if (colon
&& colon
[-1] == ':')
1016 /* if dev1:dev2:, move nm to dev2: */
1017 else if (colon
&& colon
[-1] != ':')
1022 if (p
[0] == ':' && !colon
)
1028 if (lbrack
== rbrack
)
1031 else if (p
[0] == '.')
1039 if (index (nm
, '/'))
1040 return build_string (sys_translate_unix (nm
));
1043 /* Make sure directories are all separated with / or \ as
1044 desired, but avoid allocation of a new string when not
1046 CORRECT_DIR_SEPS (nm
);
1048 if (IS_DIRECTORY_SEP (nm
[1]))
1050 if (strcmp (nm
, XSTRING (name
)->data
) != 0)
1051 name
= build_string (nm
);
1055 /* drive must be set, so this is okay */
1056 if (strcmp (nm
- 2, XSTRING (name
)->data
) != 0)
1058 name
= make_string (nm
- 2, p
- nm
+ 2);
1059 XSTRING (name
)->data
[0] = DRIVE_LETTER (drive
);
1060 XSTRING (name
)->data
[1] = ':';
1063 #else /* not DOS_NT */
1064 if (nm
== XSTRING (name
)->data
)
1066 return build_string (nm
);
1067 #endif /* not DOS_NT */
1071 /* At this point, nm might or might not be an absolute file name. We
1072 need to expand ~ or ~user if present, otherwise prefix nm with
1073 default_directory if nm is not absolute, and finally collapse /./
1074 and /foo/../ sequences.
1076 We set newdir to be the appropriate prefix if one is needed:
1077 - the relevant user directory if nm starts with ~ or ~user
1078 - the specified drive's working dir (DOS/NT only) if nm does not
1080 - the value of default_directory.
1082 Note that these prefixes are not guaranteed to be absolute (except
1083 for the working dir of a drive). Therefore, to ensure we always
1084 return an absolute name, if the final prefix is not absolute we
1085 append it to the current working directory. */
1089 if (nm
[0] == '~') /* prefix ~ */
1091 if (IS_DIRECTORY_SEP (nm
[1])
1095 || nm
[1] == 0) /* ~ by itself */
1097 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1098 newdir
= (unsigned char *) "";
1101 collapse_newdir
= 0;
1104 nm
++; /* Don't leave the slash in nm. */
1107 else /* ~user/filename */
1109 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1114 o
= (unsigned char *) alloca (p
- nm
+ 1);
1115 bcopy ((char *) nm
, o
, p
- nm
);
1118 pw
= (struct passwd
*) getpwnam (o
+ 1);
1121 newdir
= (unsigned char *) pw
-> pw_dir
;
1123 nm
= p
+ 1; /* skip the terminator */
1127 collapse_newdir
= 0;
1132 /* If we don't find a user of that name, leave the name
1133 unchanged; don't move nm forward to p. */
1138 /* On DOS and Windows, nm is absolute if a drive name was specified;
1139 use the drive's current directory as the prefix if needed. */
1140 if (!newdir
&& drive
)
1142 /* Get default directory if needed to make nm absolute. */
1143 if (!IS_DIRECTORY_SEP (nm
[0]))
1145 newdir
= alloca (MAXPATHLEN
+ 1);
1146 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1151 /* Either nm starts with /, or drive isn't mounted. */
1152 newdir
= alloca (4);
1153 newdir
[0] = DRIVE_LETTER (drive
);
1161 /* Finally, if no prefix has been specified and nm is not absolute,
1162 then it must be expanded relative to default_directory. */
1166 /* /... alone is not absolute on DOS and Windows. */
1167 && !IS_DIRECTORY_SEP (nm
[0])
1170 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1177 newdir
= XSTRING (default_directory
)->data
;
1183 /* First ensure newdir is an absolute name. */
1185 /* Detect MSDOS file names with drive specifiers. */
1186 ! (IS_DRIVE (newdir
[0])
1187 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1189 /* Detect Windows file names in UNC format. */
1190 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1194 /* Effectively, let newdir be (expand-file-name newdir cwd).
1195 Because of the admonition against calling expand-file-name
1196 when we have pointers into lisp strings, we accomplish this
1197 indirectly by prepending newdir to nm if necessary, and using
1198 cwd (or the wd of newdir's drive) as the new newdir. */
1200 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1205 if (!IS_DIRECTORY_SEP (nm
[0]))
1207 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1208 file_name_as_directory (tmp
, newdir
);
1212 newdir
= alloca (MAXPATHLEN
+ 1);
1215 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1222 /* Strip off drive name from prefix, if present. */
1223 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1229 /* Keep only a prefix from newdir if nm starts with slash
1230 (//server/share for UNC, nothing otherwise). */
1231 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1234 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1236 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1238 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1240 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1252 /* Get rid of any slash at the end of newdir, unless newdir is
1253 just // (an incomplete UNC name). */
1254 length
= strlen (newdir
);
1255 if (length
> 0 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1257 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1261 unsigned char *temp
= (unsigned char *) alloca (length
);
1262 bcopy (newdir
, temp
, length
- 1);
1263 temp
[length
- 1] = 0;
1271 /* Now concatenate the directory and name to new space in the stack frame */
1272 tlen
+= strlen (nm
) + 1;
1274 /* Add reserved space for drive name. (The Microsoft x86 compiler
1275 produces incorrect code if the following two lines are combined.) */
1276 target
= (unsigned char *) alloca (tlen
+ 2);
1278 #else /* not DOS_NT */
1279 target
= (unsigned char *) alloca (tlen
);
1280 #endif /* not DOS_NT */
1286 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1287 strcpy (target
, newdir
);
1290 file_name_as_directory (target
, newdir
);
1293 strcat (target
, nm
);
1295 if (index (target
, '/'))
1296 strcpy (target
, sys_translate_unix (target
));
1299 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1301 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1309 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1315 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1316 /* brackets are offset from each other by 2 */
1319 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1320 /* convert [foo][bar] to [bar] */
1321 while (o
[-1] != '[' && o
[-1] != '<')
1323 else if (*p
== '-' && *o
!= '.')
1326 else if (p
[0] == '-' && o
[-1] == '.' &&
1327 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1328 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1332 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1333 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1335 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1337 /* else [foo.-] ==> [-] */
1343 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1344 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1350 if (!IS_DIRECTORY_SEP (*p
))
1354 else if (IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1])
1355 #if defined (APOLLO) || defined (WINDOWSNT)
1356 /* // at start of filename is meaningful in Apollo
1357 and WindowsNT systems */
1359 #endif /* APOLLO || WINDOWSNT */
1365 else if (IS_DIRECTORY_SEP (p
[0])
1367 && (IS_DIRECTORY_SEP (p
[2])
1370 /* If "/." is the entire filename, keep the "/". Otherwise,
1371 just delete the whole "/.". */
1372 if (o
== target
&& p
[2] == '\0')
1376 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1377 /* `/../' is the "superroot" on certain file systems. */
1379 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1381 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1383 /* Keep initial / only if this is the whole name. */
1384 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1392 #endif /* not VMS */
1396 /* At last, set drive name. */
1398 /* Except for network file name. */
1399 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1400 #endif /* WINDOWSNT */
1402 if (!drive
) abort ();
1404 target
[0] = DRIVE_LETTER (drive
);
1407 CORRECT_DIR_SEPS (target
);
1410 return make_string (target
, o
- target
);
1414 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1415 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1416 "Convert FILENAME to absolute, and canonicalize it.\n\
1417 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1418 (does not start with slash); if DEFAULT is nil or missing,\n\
1419 the current buffer's value of default-directory is used.\n\
1420 Filenames containing `.' or `..' as components are simplified;\n\
1421 initial `~/' expands to your home directory.\n\
1422 See also the function `substitute-in-file-name'.")
1424 Lisp_Object name
, defalt
;
1428 register unsigned char *newdir
, *p
, *o
;
1430 unsigned char *target
;
1434 unsigned char * colon
= 0;
1435 unsigned char * close
= 0;
1436 unsigned char * slash
= 0;
1437 unsigned char * brack
= 0;
1438 int lbrack
= 0, rbrack
= 0;
1442 CHECK_STRING (name
, 0);
1445 /* Filenames on VMS are always upper case. */
1446 name
= Fupcase (name
);
1449 nm
= XSTRING (name
)->data
;
1451 /* If nm is absolute, flush ...// and detect /./ and /../.
1452 If no /./ or /../ we can return right away. */
1464 if (p
[0] == '/' && p
[1] == '/'
1466 /* // at start of filename is meaningful on Apollo system */
1471 if (p
[0] == '/' && p
[1] == '~')
1472 nm
= p
+ 1, lose
= 1;
1473 if (p
[0] == '/' && p
[1] == '.'
1474 && (p
[2] == '/' || p
[2] == 0
1475 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1481 /* if dev:[dir]/, move nm to / */
1482 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1483 nm
= (brack
? brack
+ 1 : colon
+ 1);
1484 lbrack
= rbrack
= 0;
1492 /* VMS pre V4.4,convert '-'s in filenames. */
1493 if (lbrack
== rbrack
)
1495 if (dots
< 2) /* this is to allow negative version numbers */
1500 if (lbrack
> rbrack
&&
1501 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1502 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1508 /* count open brackets, reset close bracket pointer */
1509 if (p
[0] == '[' || p
[0] == '<')
1510 lbrack
++, brack
= 0;
1511 /* count close brackets, set close bracket pointer */
1512 if (p
[0] == ']' || p
[0] == '>')
1513 rbrack
++, brack
= p
;
1514 /* detect ][ or >< */
1515 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1517 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1518 nm
= p
+ 1, lose
= 1;
1519 if (p
[0] == ':' && (colon
|| slash
))
1520 /* if dev1:[dir]dev2:, move nm to dev2: */
1526 /* If /name/dev:, move nm to dev: */
1529 /* If node::dev:, move colon following dev */
1530 else if (colon
&& colon
[-1] == ':')
1532 /* If dev1:dev2:, move nm to dev2: */
1533 else if (colon
&& colon
[-1] != ':')
1538 if (p
[0] == ':' && !colon
)
1544 if (lbrack
== rbrack
)
1547 else if (p
[0] == '.')
1555 if (index (nm
, '/'))
1556 return build_string (sys_translate_unix (nm
));
1558 if (nm
== XSTRING (name
)->data
)
1560 return build_string (nm
);
1564 /* Now determine directory to start with and put it in NEWDIR */
1568 if (nm
[0] == '~') /* prefix ~ */
1573 || nm
[1] == 0)/* ~/filename */
1575 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1576 newdir
= (unsigned char *) "";
1579 nm
++; /* Don't leave the slash in nm. */
1582 else /* ~user/filename */
1584 /* Get past ~ to user */
1585 unsigned char *user
= nm
+ 1;
1586 /* Find end of name. */
1587 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1588 int len
= ptr
? ptr
- user
: strlen (user
);
1590 unsigned char *ptr1
= index (user
, ':');
1591 if (ptr1
!= 0 && ptr1
- user
< len
)
1594 /* Copy the user name into temp storage. */
1595 o
= (unsigned char *) alloca (len
+ 1);
1596 bcopy ((char *) user
, o
, len
);
1599 /* Look up the user name. */
1600 pw
= (struct passwd
*) getpwnam (o
+ 1);
1602 error ("\"%s\" isn't a registered user", o
+ 1);
1604 newdir
= (unsigned char *) pw
->pw_dir
;
1606 /* Discard the user name from NM. */
1613 #endif /* not VMS */
1617 defalt
= current_buffer
->directory
;
1618 CHECK_STRING (defalt
, 1);
1619 newdir
= XSTRING (defalt
)->data
;
1622 /* Now concatenate the directory and name to new space in the stack frame */
1624 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1625 target
= (unsigned char *) alloca (tlen
);
1631 if (nm
[0] == 0 || nm
[0] == '/')
1632 strcpy (target
, newdir
);
1635 file_name_as_directory (target
, newdir
);
1638 strcat (target
, nm
);
1640 if (index (target
, '/'))
1641 strcpy (target
, sys_translate_unix (target
));
1644 /* Now canonicalize by removing /. and /foo/.. if they appear */
1652 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1658 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1659 /* brackets are offset from each other by 2 */
1662 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1663 /* convert [foo][bar] to [bar] */
1664 while (o
[-1] != '[' && o
[-1] != '<')
1666 else if (*p
== '-' && *o
!= '.')
1669 else if (p
[0] == '-' && o
[-1] == '.' &&
1670 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1671 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1675 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1676 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1678 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1680 /* else [foo.-] ==> [-] */
1686 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1687 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1697 else if (!strncmp (p
, "//", 2)
1699 /* // at start of filename is meaningful in Apollo system */
1707 else if (p
[0] == '/' && p
[1] == '.' &&
1708 (p
[2] == '/' || p
[2] == 0))
1710 else if (!strncmp (p
, "/..", 3)
1711 /* `/../' is the "superroot" on certain file systems. */
1713 && (p
[3] == '/' || p
[3] == 0))
1715 while (o
!= target
&& *--o
!= '/')
1718 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1722 if (o
== target
&& *o
== '/')
1730 #endif /* not VMS */
1733 return make_string (target
, o
- target
);
1737 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1738 Ssubstitute_in_file_name
, 1, 1, 0,
1739 "Substitute environment variables referred to in FILENAME.\n\
1740 `$FOO' where FOO is an environment variable name means to substitute\n\
1741 the value of that variable. The variable name should be terminated\n\
1742 with a character not a letter, digit or underscore; otherwise, enclose\n\
1743 the entire variable name in braces.\n\
1744 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1745 On VMS, `$' substitution is not done; this function does little and only\n\
1746 duplicates what `expand-file-name' does.")
1748 Lisp_Object filename
;
1752 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1753 unsigned char *target
;
1755 int substituted
= 0;
1757 Lisp_Object handler
;
1759 CHECK_STRING (filename
, 0);
1761 /* If the file name has special constructs in it,
1762 call the corresponding file handler. */
1763 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1764 if (!NILP (handler
))
1765 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1767 nm
= XSTRING (filename
)->data
;
1769 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1770 CORRECT_DIR_SEPS (nm
);
1771 substituted
= (strcmp (nm
, XSTRING (filename
)->data
) != 0);
1773 endp
= nm
+ XSTRING (filename
)->size
;
1775 /* If /~ or // appears, discard everything through first slash. */
1777 for (p
= nm
; p
!= endp
; p
++)
1780 #if defined (APOLLO) || defined (WINDOWSNT)
1781 /* // at start of file name is meaningful in Apollo and
1782 WindowsNT systems */
1783 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1784 #else /* not (APOLLO || WINDOWSNT) */
1785 || IS_DIRECTORY_SEP (p
[0])
1786 #endif /* not (APOLLO || WINDOWSNT) */
1791 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1793 || IS_DIRECTORY_SEP (p
[-1])))
1799 /* see comment in expand-file-name about drive specifiers */
1800 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1801 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1810 return build_string (nm
);
1813 /* See if any variables are substituted into the string
1814 and find the total length of their values in `total' */
1816 for (p
= nm
; p
!= endp
;)
1826 /* "$$" means a single "$" */
1835 while (p
!= endp
&& *p
!= '}') p
++;
1836 if (*p
!= '}') goto missingclose
;
1842 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1846 /* Copy out the variable name */
1847 target
= (unsigned char *) alloca (s
- o
+ 1);
1848 strncpy (target
, o
, s
- o
);
1851 strupr (target
); /* $home == $HOME etc. */
1854 /* Get variable value */
1855 o
= (unsigned char *) egetenv (target
);
1856 if (!o
) goto badvar
;
1857 total
+= strlen (o
);
1864 /* If substitution required, recopy the string and do it */
1865 /* Make space in stack frame for the new copy */
1866 xnm
= (unsigned char *) alloca (XSTRING (filename
)->size
+ total
+ 1);
1869 /* Copy the rest of the name through, replacing $ constructs with values */
1886 while (p
!= endp
&& *p
!= '}') p
++;
1887 if (*p
!= '}') goto missingclose
;
1893 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1897 /* Copy out the variable name */
1898 target
= (unsigned char *) alloca (s
- o
+ 1);
1899 strncpy (target
, o
, s
- o
);
1902 strupr (target
); /* $home == $HOME etc. */
1905 /* Get variable value */
1906 o
= (unsigned char *) egetenv (target
);
1916 /* If /~ or // appears, discard everything through first slash. */
1918 for (p
= xnm
; p
!= x
; p
++)
1920 #if defined (APOLLO) || defined (WINDOWSNT)
1921 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
1922 #else /* not (APOLLO || WINDOWSNT) */
1923 || IS_DIRECTORY_SEP (p
[0])
1924 #endif /* not (APOLLO || WINDOWSNT) */
1926 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
1929 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1930 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1934 return make_string (xnm
, x
- xnm
);
1937 error ("Bad format environment-variable substitution");
1939 error ("Missing \"}\" in environment-variable substitution");
1941 error ("Substituting nonexistent environment variable \"%s\"", target
);
1944 #endif /* not VMS */
1947 /* A slightly faster and more convenient way to get
1948 (directory-file-name (expand-file-name FOO)). */
1951 expand_and_dir_to_file (filename
, defdir
)
1952 Lisp_Object filename
, defdir
;
1954 register Lisp_Object absname
;
1956 absname
= Fexpand_file_name (filename
, defdir
);
1959 register int c
= XSTRING (absname
)->data
[XSTRING (absname
)->size
- 1];
1960 if (c
== ':' || c
== ']' || c
== '>')
1961 absname
= Fdirectory_file_name (absname
);
1964 /* Remove final slash, if any (unless this is the root dir).
1965 stat behaves differently depending! */
1966 if (XSTRING (absname
)->size
> 1
1967 && IS_DIRECTORY_SEP (XSTRING (absname
)->data
[XSTRING (absname
)->size
- 1])
1968 && !IS_DEVICE_SEP (XSTRING (absname
)->data
[XSTRING (absname
)->size
-2]))
1969 /* We cannot take shortcuts; they might be wrong for magic file names. */
1970 absname
= Fdirectory_file_name (absname
);
1975 /* Signal an error if the file ABSNAME already exists.
1976 If INTERACTIVE is nonzero, ask the user whether to proceed,
1977 and bypass the error if the user says to go ahead.
1978 QUERYSTRING is a name for the action that is being considered
1980 *STATPTR is used to store the stat information if the file exists.
1981 If the file does not exist, STATPTR->st_mode is set to 0. */
1984 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
)
1985 Lisp_Object absname
;
1986 unsigned char *querystring
;
1988 struct stat
*statptr
;
1990 register Lisp_Object tem
;
1991 struct stat statbuf
;
1992 struct gcpro gcpro1
;
1994 /* stat is a good way to tell whether the file exists,
1995 regardless of what access permissions it has. */
1996 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
1999 Fsignal (Qfile_already_exists
,
2000 Fcons (build_string ("File already exists"),
2001 Fcons (absname
, Qnil
)));
2003 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
2004 XSTRING (absname
)->data
, querystring
));
2007 Fsignal (Qfile_already_exists
,
2008 Fcons (build_string ("File already exists"),
2009 Fcons (absname
, Qnil
)));
2016 statptr
->st_mode
= 0;
2021 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2022 "fCopy file: \nFCopy %s to file: \np\nP",
2023 "Copy FILE to NEWNAME. Both args must be strings.\n\
2024 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
2025 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
2026 A number as third arg means request confirmation if NEWNAME already exists.\n\
2027 This is what happens in interactive use with M-x.\n\
2028 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
2029 last-modified time as the old one. (This works on only some systems.)\n\
2030 A prefix arg makes KEEP-TIME non-nil.")
2031 (file
, newname
, ok_if_already_exists
, keep_date
)
2032 Lisp_Object file
, newname
, ok_if_already_exists
, keep_date
;
2035 char buf
[16 * 1024];
2036 struct stat st
, out_st
;
2037 Lisp_Object handler
;
2038 struct gcpro gcpro1
, gcpro2
;
2039 int count
= specpdl_ptr
- specpdl
;
2040 int input_file_statable_p
;
2042 GCPRO2 (file
, newname
);
2043 CHECK_STRING (file
, 0);
2044 CHECK_STRING (newname
, 1);
2045 file
= Fexpand_file_name (file
, Qnil
);
2046 newname
= Fexpand_file_name (newname
, Qnil
);
2048 /* If the input file name has special constructs in it,
2049 call the corresponding file handler. */
2050 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2051 /* Likewise for output file name. */
2053 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2054 if (!NILP (handler
))
2055 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2056 ok_if_already_exists
, keep_date
));
2058 if (NILP (ok_if_already_exists
)
2059 || INTEGERP (ok_if_already_exists
))
2060 barf_or_query_if_file_exists (newname
, "copy to it",
2061 INTEGERP (ok_if_already_exists
), &out_st
);
2062 else if (stat (XSTRING (newname
)->data
, &out_st
) < 0)
2065 ifd
= open (XSTRING (file
)->data
, O_RDONLY
);
2067 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2069 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2071 /* We can only copy regular files and symbolic links. Other files are not
2073 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2075 #if !defined (MSDOS) || __DJGPP__ > 1
2076 if (out_st
.st_mode
!= 0
2077 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2080 report_file_error ("Input and output files are the same",
2081 Fcons (file
, Fcons (newname
, Qnil
)));
2085 #if defined (S_ISREG) && defined (S_ISLNK)
2086 if (input_file_statable_p
)
2088 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2090 #if defined (EISDIR)
2091 /* Get a better looking error message. */
2094 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2097 #endif /* S_ISREG && S_ISLNK */
2100 /* Create the copy file with the same record format as the input file */
2101 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
2104 /* System's default file type was set to binary by _fmode in emacs.c. */
2105 ofd
= creat (XSTRING (newname
)->data
, S_IREAD
| S_IWRITE
);
2106 #else /* not MSDOS */
2107 ofd
= creat (XSTRING (newname
)->data
, 0666);
2108 #endif /* not MSDOS */
2111 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2113 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2117 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
2118 if (write (ofd
, buf
, n
) != n
)
2119 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2122 /* Closing the output clobbers the file times on some systems. */
2123 if (close (ofd
) < 0)
2124 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2126 if (input_file_statable_p
)
2128 if (!NILP (keep_date
))
2130 EMACS_TIME atime
, mtime
;
2131 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2132 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2133 if (set_file_times (XSTRING (newname
)->data
, atime
, mtime
))
2134 Fsignal (Qfile_date_error
,
2135 Fcons (build_string ("Cannot set file date"),
2136 Fcons (newname
, Qnil
)));
2139 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
2141 #if defined (__DJGPP__) && __DJGPP__ > 1
2142 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2143 and if it can't, it tells so. Otherwise, under MSDOS we usually
2144 get only the READ bit, which will make the copied file read-only,
2145 so it's better not to chmod at all. */
2146 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2147 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
2148 #endif /* DJGPP version 2 or newer */
2154 /* Discard the unwind protects. */
2155 specpdl_ptr
= specpdl
+ count
;
2161 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2162 Smake_directory_internal
, 1, 1, 0,
2163 "Create a new directory named DIRECTORY.")
2165 Lisp_Object directory
;
2168 Lisp_Object handler
;
2170 CHECK_STRING (directory
, 0);
2171 directory
= Fexpand_file_name (directory
, Qnil
);
2173 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2174 if (!NILP (handler
))
2175 return call2 (handler
, Qmake_directory_internal
, directory
);
2177 dir
= XSTRING (directory
)->data
;
2180 if (mkdir (dir
) != 0)
2182 if (mkdir (dir
, 0777) != 0)
2184 report_file_error ("Creating directory", Flist (1, &directory
));
2189 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2190 "Delete the directory named DIRECTORY.")
2192 Lisp_Object directory
;
2195 Lisp_Object handler
;
2197 CHECK_STRING (directory
, 0);
2198 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2199 dir
= XSTRING (directory
)->data
;
2201 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2202 if (!NILP (handler
))
2203 return call2 (handler
, Qdelete_directory
, directory
);
2205 if (rmdir (dir
) != 0)
2206 report_file_error ("Removing directory", Flist (1, &directory
));
2211 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2212 "Delete file named FILENAME.\n\
2213 If file has multiple names, it continues to exist with the other names.")
2215 Lisp_Object filename
;
2217 Lisp_Object handler
;
2218 CHECK_STRING (filename
, 0);
2219 filename
= Fexpand_file_name (filename
, Qnil
);
2221 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2222 if (!NILP (handler
))
2223 return call2 (handler
, Qdelete_file
, filename
);
2225 if (0 > unlink (XSTRING (filename
)->data
))
2226 report_file_error ("Removing old name", Flist (1, &filename
));
2231 internal_delete_file_1 (ignore
)
2237 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2240 internal_delete_file (filename
)
2241 Lisp_Object filename
;
2243 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2244 Qt
, internal_delete_file_1
));
2247 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2248 "fRename file: \nFRename %s to file: \np",
2249 "Rename FILE as NEWNAME. Both args strings.\n\
2250 If file has names other than FILE, it continues to have those names.\n\
2251 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2252 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2253 A number as third arg means request confirmation if NEWNAME already exists.\n\
2254 This is what happens in interactive use with M-x.")
2255 (file
, newname
, ok_if_already_exists
)
2256 Lisp_Object file
, newname
, ok_if_already_exists
;
2259 Lisp_Object args
[2];
2261 Lisp_Object handler
;
2262 struct gcpro gcpro1
, gcpro2
;
2264 GCPRO2 (file
, newname
);
2265 CHECK_STRING (file
, 0);
2266 CHECK_STRING (newname
, 1);
2267 file
= Fexpand_file_name (file
, Qnil
);
2268 newname
= Fexpand_file_name (newname
, Qnil
);
2270 /* If the file name has special constructs in it,
2271 call the corresponding file handler. */
2272 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2274 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2275 if (!NILP (handler
))
2276 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2277 file
, newname
, ok_if_already_exists
));
2279 if (NILP (ok_if_already_exists
)
2280 || INTEGERP (ok_if_already_exists
))
2281 barf_or_query_if_file_exists (newname
, "rename to it",
2282 INTEGERP (ok_if_already_exists
), 0);
2284 if (0 > rename (XSTRING (file
)->data
, XSTRING (newname
)->data
))
2286 if (0 > link (XSTRING (file
)->data
, XSTRING (newname
)->data
)
2287 || 0 > unlink (XSTRING (file
)->data
))
2292 Fcopy_file (file
, newname
,
2293 /* We have already prompted if it was an integer,
2294 so don't have copy-file prompt again. */
2295 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2296 Fdelete_file (file
);
2303 report_file_error ("Renaming", Flist (2, args
));
2306 report_file_error ("Renaming", Flist (2, &file
));
2313 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2314 "fAdd name to file: \nFName to add to %s: \np",
2315 "Give FILE additional name NEWNAME. Both args strings.\n\
2316 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2317 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2318 A number as third arg means request confirmation if NEWNAME already exists.\n\
2319 This is what happens in interactive use with M-x.")
2320 (file
, newname
, ok_if_already_exists
)
2321 Lisp_Object file
, newname
, ok_if_already_exists
;
2324 Lisp_Object args
[2];
2326 Lisp_Object handler
;
2327 struct gcpro gcpro1
, gcpro2
;
2329 GCPRO2 (file
, newname
);
2330 CHECK_STRING (file
, 0);
2331 CHECK_STRING (newname
, 1);
2332 file
= Fexpand_file_name (file
, Qnil
);
2333 newname
= Fexpand_file_name (newname
, Qnil
);
2335 /* If the file name has special constructs in it,
2336 call the corresponding file handler. */
2337 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2338 if (!NILP (handler
))
2339 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2340 newname
, ok_if_already_exists
));
2342 /* If the new name has special constructs in it,
2343 call the corresponding file handler. */
2344 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2345 if (!NILP (handler
))
2346 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2347 newname
, ok_if_already_exists
));
2349 if (NILP (ok_if_already_exists
)
2350 || INTEGERP (ok_if_already_exists
))
2351 barf_or_query_if_file_exists (newname
, "make it a new name",
2352 INTEGERP (ok_if_already_exists
), 0);
2354 /* Windows does not support this operation. */
2355 report_file_error ("Adding new name", Flist (2, &file
));
2356 #else /* not WINDOWSNT */
2358 unlink (XSTRING (newname
)->data
);
2359 if (0 > link (XSTRING (file
)->data
, XSTRING (newname
)->data
))
2364 report_file_error ("Adding new name", Flist (2, args
));
2366 report_file_error ("Adding new name", Flist (2, &file
));
2369 #endif /* not WINDOWSNT */
2376 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2377 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2378 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2379 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2380 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2381 A number as third arg means request confirmation if LINKNAME already exists.\n\
2382 This happens for interactive use with M-x.")
2383 (filename
, linkname
, ok_if_already_exists
)
2384 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2387 Lisp_Object args
[2];
2389 Lisp_Object handler
;
2390 struct gcpro gcpro1
, gcpro2
;
2392 GCPRO2 (filename
, linkname
);
2393 CHECK_STRING (filename
, 0);
2394 CHECK_STRING (linkname
, 1);
2395 /* If the link target has a ~, we must expand it to get
2396 a truly valid file name. Otherwise, do not expand;
2397 we want to permit links to relative file names. */
2398 if (XSTRING (filename
)->data
[0] == '~')
2399 filename
= Fexpand_file_name (filename
, Qnil
);
2400 linkname
= Fexpand_file_name (linkname
, Qnil
);
2402 /* If the file name has special constructs in it,
2403 call the corresponding file handler. */
2404 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2405 if (!NILP (handler
))
2406 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2407 linkname
, ok_if_already_exists
));
2409 /* If the new link name has special constructs in it,
2410 call the corresponding file handler. */
2411 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2412 if (!NILP (handler
))
2413 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2414 linkname
, ok_if_already_exists
));
2416 if (NILP (ok_if_already_exists
)
2417 || INTEGERP (ok_if_already_exists
))
2418 barf_or_query_if_file_exists (linkname
, "make it a link",
2419 INTEGERP (ok_if_already_exists
), 0);
2420 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2422 /* If we didn't complain already, silently delete existing file. */
2423 if (errno
== EEXIST
)
2425 unlink (XSTRING (linkname
)->data
);
2426 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2436 report_file_error ("Making symbolic link", Flist (2, args
));
2438 report_file_error ("Making symbolic link", Flist (2, &filename
));
2444 #endif /* S_IFLNK */
2448 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2449 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2450 "Define the job-wide logical name NAME to have the value STRING.\n\
2451 If STRING is nil or a null string, the logical name NAME is deleted.")
2456 CHECK_STRING (name
, 0);
2458 delete_logical_name (XSTRING (name
)->data
);
2461 CHECK_STRING (string
, 1);
2463 if (XSTRING (string
)->size
== 0)
2464 delete_logical_name (XSTRING (name
)->data
);
2466 define_logical_name (XSTRING (name
)->data
, XSTRING (string
)->data
);
2475 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2476 "Open a network connection to PATH using LOGIN as the login string.")
2478 Lisp_Object path
, login
;
2482 CHECK_STRING (path
, 0);
2483 CHECK_STRING (login
, 0);
2485 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2487 if (netresult
== -1)
2492 #endif /* HPUX_NET */
2494 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2496 "Return t if file FILENAME specifies an absolute file name.\n\
2497 On Unix, this is a name starting with a `/' or a `~'.")
2499 Lisp_Object filename
;
2503 CHECK_STRING (filename
, 0);
2504 ptr
= XSTRING (filename
)->data
;
2505 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2507 /* ??? This criterion is probably wrong for '<'. */
2508 || index (ptr
, ':') || index (ptr
, '<')
2509 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2513 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2521 /* Return nonzero if file FILENAME exists and can be executed. */
2524 check_executable (filename
)
2528 int len
= strlen (filename
);
2531 if (stat (filename
, &st
) < 0)
2533 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2534 return ((st
.st_mode
& S_IEXEC
) != 0);
2536 return (S_ISREG (st
.st_mode
)
2538 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2539 || stricmp (suffix
, ".exe") == 0
2540 || stricmp (suffix
, ".bat") == 0)
2541 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2542 #endif /* not WINDOWSNT */
2543 #else /* not DOS_NT */
2544 #ifdef HAVE_EUIDACCESS
2545 return (euidaccess (filename
, 1) >= 0);
2547 /* Access isn't quite right because it uses the real uid
2548 and we really want to test with the effective uid.
2549 But Unix doesn't give us a right way to do it. */
2550 return (access (filename
, 1) >= 0);
2552 #endif /* not DOS_NT */
2555 /* Return nonzero if file FILENAME exists and can be written. */
2558 check_writable (filename
)
2563 if (stat (filename
, &st
) < 0)
2565 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2566 #else /* not MSDOS */
2567 #ifdef HAVE_EUIDACCESS
2568 return (euidaccess (filename
, 2) >= 0);
2570 /* Access isn't quite right because it uses the real uid
2571 and we really want to test with the effective uid.
2572 But Unix doesn't give us a right way to do it.
2573 Opening with O_WRONLY could work for an ordinary file,
2574 but would lose for directories. */
2575 return (access (filename
, 2) >= 0);
2577 #endif /* not MSDOS */
2580 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2581 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2582 See also `file-readable-p' and `file-attributes'.")
2584 Lisp_Object filename
;
2586 Lisp_Object absname
;
2587 Lisp_Object handler
;
2588 struct stat statbuf
;
2590 CHECK_STRING (filename
, 0);
2591 absname
= Fexpand_file_name (filename
, Qnil
);
2593 /* If the file name has special constructs in it,
2594 call the corresponding file handler. */
2595 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2596 if (!NILP (handler
))
2597 return call2 (handler
, Qfile_exists_p
, absname
);
2599 return (stat (XSTRING (absname
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2602 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2603 "Return t if FILENAME can be executed by you.\n\
2604 For a directory, this means you can access files in that directory.")
2606 Lisp_Object filename
;
2609 Lisp_Object absname
;
2610 Lisp_Object handler
;
2612 CHECK_STRING (filename
, 0);
2613 absname
= Fexpand_file_name (filename
, Qnil
);
2615 /* If the file name has special constructs in it,
2616 call the corresponding file handler. */
2617 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2618 if (!NILP (handler
))
2619 return call2 (handler
, Qfile_executable_p
, absname
);
2621 return (check_executable (XSTRING (absname
)->data
) ? Qt
: Qnil
);
2624 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2625 "Return t if file FILENAME exists and you can read it.\n\
2626 See also `file-exists-p' and `file-attributes'.")
2628 Lisp_Object filename
;
2630 Lisp_Object absname
;
2631 Lisp_Object handler
;
2634 struct stat statbuf
;
2636 CHECK_STRING (filename
, 0);
2637 absname
= Fexpand_file_name (filename
, Qnil
);
2639 /* If the file name has special constructs in it,
2640 call the corresponding file handler. */
2641 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2642 if (!NILP (handler
))
2643 return call2 (handler
, Qfile_readable_p
, absname
);
2646 /* Under MS-DOS and Windows, open does not work for directories. */
2647 if (access (XSTRING (absname
)->data
, 0) == 0)
2650 #else /* not DOS_NT */
2652 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2653 /* Opening a fifo without O_NONBLOCK can wait.
2654 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2655 except in the case of a fifo, on a system which handles it. */
2656 desc
= stat (XSTRING (absname
)->data
, &statbuf
);
2659 if (S_ISFIFO (statbuf
.st_mode
))
2660 flags
|= O_NONBLOCK
;
2662 desc
= open (XSTRING (absname
)->data
, flags
);
2667 #endif /* not DOS_NT */
2670 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2672 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2673 "Return t if file FILENAME can be written or created by you.")
2675 Lisp_Object filename
;
2677 Lisp_Object absname
, dir
;
2678 Lisp_Object handler
;
2679 struct stat statbuf
;
2681 CHECK_STRING (filename
, 0);
2682 absname
= Fexpand_file_name (filename
, Qnil
);
2684 /* If the file name has special constructs in it,
2685 call the corresponding file handler. */
2686 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2687 if (!NILP (handler
))
2688 return call2 (handler
, Qfile_writable_p
, absname
);
2690 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
2691 return (check_writable (XSTRING (absname
)->data
)
2693 dir
= Ffile_name_directory (absname
);
2696 dir
= Fdirectory_file_name (dir
);
2700 dir
= Fdirectory_file_name (dir
);
2702 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2706 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2707 "Access file FILENAME, and get an error if that does not work.\n\
2708 The second argument STRING is used in the error message.\n\
2709 If there is no error, we return nil.")
2711 Lisp_Object filename
, string
;
2713 Lisp_Object handler
;
2716 CHECK_STRING (filename
, 0);
2718 /* If the file name has special constructs in it,
2719 call the corresponding file handler. */
2720 handler
= Ffind_file_name_handler (filename
, Qaccess_file
);
2721 if (!NILP (handler
))
2722 return call3 (handler
, Qaccess_file
, filename
, string
);
2724 fd
= open (XSTRING (filename
)->data
, O_RDONLY
);
2726 report_file_error (XSTRING (string
)->data
, Fcons (filename
, Qnil
));
2732 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2733 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2734 The value is the name of the file to which it is linked.\n\
2735 Otherwise returns nil.")
2737 Lisp_Object filename
;
2744 Lisp_Object handler
;
2746 CHECK_STRING (filename
, 0);
2747 filename
= Fexpand_file_name (filename
, Qnil
);
2749 /* If the file name has special constructs in it,
2750 call the corresponding file handler. */
2751 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2752 if (!NILP (handler
))
2753 return call2 (handler
, Qfile_symlink_p
, filename
);
2758 buf
= (char *) xmalloc (bufsize
);
2759 bzero (buf
, bufsize
);
2760 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2761 if (valsize
< bufsize
) break;
2762 /* Buffer was not long enough */
2771 val
= make_string (buf
, valsize
);
2774 #else /* not S_IFLNK */
2776 #endif /* not S_IFLNK */
2779 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2780 "Return t if file FILENAME is the name of a directory as a file.\n\
2781 A directory name spec may be given instead; then the value is t\n\
2782 if the directory so specified exists and really is a 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 `coding-system-alist', and sets the variable\n\
3021 `last-coding-system-used' to the coding system actually used.")
3022 (filename
, visit
, beg
, end
, replace
)
3023 Lisp_Object filename
, visit
, beg
, end
, replace
;
3027 register int inserted
= 0;
3028 register int how_much
;
3029 register int unprocessed
;
3030 int count
= specpdl_ptr
- specpdl
;
3031 struct gcpro gcpro1
, gcpro2
, gcpro3
;
3032 Lisp_Object handler
, val
, insval
;
3035 int not_regular
= 0;
3036 char read_buf
[READ_BUF_SIZE
];
3037 struct coding_system coding
;
3038 unsigned char buffer
[1 << 14];
3039 int replace_handled
= 0;
3041 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3042 error ("Cannot do file visiting in an indirect buffer");
3044 if (!NILP (current_buffer
->read_only
))
3045 Fbarf_if_buffer_read_only ();
3050 GCPRO3 (filename
, val
, p
);
3052 CHECK_STRING (filename
, 0);
3053 filename
= Fexpand_file_name (filename
, Qnil
);
3055 /* If the file name has special constructs in it,
3056 call the corresponding file handler. */
3057 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3058 if (!NILP (handler
))
3060 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3061 visit
, beg
, end
, replace
);
3065 /* Decide the coding-system of the file. */
3067 Lisp_Object val
= Vcoding_system_for_read
;
3068 if (NILP (current_buffer
->enable_multibyte_characters
))
3070 else if (NILP (val
))
3072 Lisp_Object args
[6], coding_systems
;
3074 args
[0] = Qinsert_file_contents
, args
[1] = filename
, args
[2] = visit
,
3075 args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3076 coding_systems
= Ffind_coding_system (6, args
);
3077 val
= CONSP (coding_systems
) ? XCONS (coding_systems
)->car
: Qnil
;
3079 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3085 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3087 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
3088 || fstat (fd
, &st
) < 0)
3089 #endif /* not APOLLO */
3091 if (fd
>= 0) close (fd
);
3094 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3101 /* This code will need to be changed in order to work on named
3102 pipes, and it's probably just not worth it. So we should at
3103 least signal an error. */
3104 if (!S_ISREG (st
.st_mode
))
3111 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3112 Fsignal (Qfile_error
,
3113 Fcons (build_string ("not a regular file"),
3114 Fcons (filename
, Qnil
)));
3119 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
3122 /* Replacement should preserve point as it preserves markers. */
3123 if (!NILP (replace
))
3124 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3126 record_unwind_protect (close_file_unwind
, make_number (fd
));
3128 /* Supposedly happens on VMS. */
3129 if (! not_regular
&& st
.st_size
< 0)
3130 error ("File size is negative");
3132 if (!NILP (beg
) || !NILP (end
))
3134 error ("Attempt to visit less than an entire file");
3137 CHECK_NUMBER (beg
, 0);
3139 XSETFASTINT (beg
, 0);
3142 CHECK_NUMBER (end
, 0);
3147 XSETINT (end
, st
.st_size
);
3148 if (XINT (end
) != st
.st_size
)
3149 error ("Maximum buffer size exceeded");
3153 /* If requested, replace the accessible part of the buffer
3154 with the file contents. Avoid replacing text at the
3155 beginning or end of the buffer that matches the file contents;
3156 that preserves markers pointing to the unchanged parts.
3158 Here we implement this feature in an optimized way
3159 for the case where code conversion is NOT needed.
3160 The following if-statement handles the case of conversion
3161 in a less optimal way.
3163 If the code conversion is "automatic" then we try using this
3164 method and hope for the best.
3165 But if we discover the need for conversion, we give up on this method
3166 and let the following if-statement handle the replace job. */
3168 && (! CODING_REQUIRE_CONVERSION (&coding
)
3169 || (coding
.type
== coding_type_undecided
3170 && ! CODING_REQUIRE_EOL_CONVERSION (&coding
))
3171 || (coding
.eol_type
== CODING_EOL_UNDECIDED
3172 && ! CODING_REQUIRE_TEXT_CONVERSION (&coding
))))
3174 int same_at_start
= BEGV
;
3175 int same_at_end
= ZV
;
3177 /* There is still a possibility we will find the need to do code
3178 conversion. If that happens, we set this variable to 1 to
3179 give up on handling REPLACE in the optimized way. */
3180 int giveup_match_end
= 0;
3182 if (XINT (beg
) != 0)
3184 if (lseek (fd
, XINT (beg
), 0) < 0)
3185 report_file_error ("Setting file position",
3186 Fcons (filename
, Qnil
));
3191 /* Count how many chars at the start of the file
3192 match the text at the beginning of the buffer. */
3197 nread
= read (fd
, buffer
, sizeof buffer
);
3199 error ("IO error reading %s: %s",
3200 XSTRING (filename
)->data
, strerror (errno
));
3201 else if (nread
== 0)
3204 if (coding
.type
== coding_type_undecided
)
3205 detect_coding (&coding
, buffer
, nread
);
3206 if (coding
.type
!= coding_type_undecided
3207 && CODING_REQUIRE_TEXT_CONVERSION (&coding
))
3208 /* We found that the file should be decoded somehow.
3209 Let's give up here. */
3211 giveup_match_end
= 1;
3215 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3216 detect_eol (&coding
, buffer
, nread
);
3217 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3218 && CODING_REQUIRE_EOL_CONVERSION (&coding
))
3219 /* We found that the format of eol should be decoded.
3220 Let's give up here. */
3222 giveup_match_end
= 1;
3227 while (bufpos
< nread
&& same_at_start
< ZV
3228 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3229 same_at_start
++, bufpos
++;
3230 /* If we found a discrepancy, stop the scan.
3231 Otherwise loop around and scan the next bufferful. */
3232 if (bufpos
!= nread
)
3236 /* If the file matches the buffer completely,
3237 there's no need to replace anything. */
3238 if (same_at_start
- BEGV
== XINT (end
))
3242 /* Truncate the buffer to the size of the file. */
3243 del_range_1 (same_at_start
, same_at_end
, 0);
3248 /* Count how many chars at the end of the file
3249 match the text at the end of the buffer. But, if we have
3250 already found that decoding is necessary, don't waste time. */
3251 while (!giveup_match_end
)
3253 int total_read
, nread
, bufpos
, curpos
, trial
;
3255 /* At what file position are we now scanning? */
3256 curpos
= XINT (end
) - (ZV
- same_at_end
);
3257 /* If the entire file matches the buffer tail, stop the scan. */
3260 /* How much can we scan in the next step? */
3261 trial
= min (curpos
, sizeof buffer
);
3262 if (lseek (fd
, curpos
- trial
, 0) < 0)
3263 report_file_error ("Setting file position",
3264 Fcons (filename
, Qnil
));
3267 while (total_read
< trial
)
3269 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
3271 error ("IO error reading %s: %s",
3272 XSTRING (filename
)->data
, strerror (errno
));
3273 total_read
+= nread
;
3275 /* Scan this bufferful from the end, comparing with
3276 the Emacs buffer. */
3277 bufpos
= total_read
;
3278 /* Compare with same_at_start to avoid counting some buffer text
3279 as matching both at the file's beginning and at the end. */
3280 while (bufpos
> 0 && same_at_end
> same_at_start
3281 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3282 same_at_end
--, bufpos
--;
3284 /* If we found a discrepancy, stop the scan.
3285 Otherwise loop around and scan the preceding bufferful. */
3288 /* If this discrepancy is because of code conversion,
3289 we cannot use this method; giveup and try the other. */
3290 if (same_at_end
> same_at_start
3291 && FETCH_BYTE (same_at_end
- 1) >= 0200
3292 && ! NILP (current_buffer
->enable_multibyte_characters
))
3293 giveup_match_end
= 1;
3299 if (! giveup_match_end
)
3301 /* We win! We can handle REPLACE the optimized way. */
3303 /* Don't try to reuse the same piece of text twice. */
3304 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
3306 same_at_end
+= overlap
;
3308 /* Arrange to read only the nonmatching middle part of the file. */
3309 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV
));
3310 XSETFASTINT (end
, XINT (end
) - (ZV
- same_at_end
));
3312 del_range_1 (same_at_start
, same_at_end
, 0);
3313 /* Insert from the file at the proper position. */
3314 SET_PT (same_at_start
);
3316 /* If display currently starts at beginning of line,
3317 keep it that way. */
3318 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3319 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3321 replace_handled
= 1;
3325 /* If requested, replace the accessible part of the buffer
3326 with the file contents. Avoid replacing text at the
3327 beginning or end of the buffer that matches the file contents;
3328 that preserves markers pointing to the unchanged parts.
3330 Here we implement this feature for the case where code conversion
3331 is needed, in a simple way that needs a lot of memory.
3332 The preceding if-statement handles the case of no conversion
3333 in a more optimized way. */
3334 if (!NILP (replace
) && ! replace_handled
)
3336 int same_at_start
= BEGV
;
3337 int same_at_end
= ZV
;
3340 /* Make sure that the gap is large enough. */
3341 int bufsize
= 2 * st
.st_size
;
3342 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
3344 /* First read the whole file, performing code conversion into
3345 CONVERSION_BUFFER. */
3347 if (lseek (fd
, XINT (beg
), 0) < 0)
3349 free (conversion_buffer
);
3350 report_file_error ("Setting file position",
3351 Fcons (filename
, Qnil
));
3354 total
= st
.st_size
; /* Total bytes in the file. */
3355 how_much
= 0; /* Bytes read from file so far. */
3356 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3357 unprocessed
= 0; /* Bytes not processed in previous loop. */
3359 while (how_much
< total
)
3361 /* try is reserved in some compilers (Microsoft C) */
3362 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3363 char *destination
= read_buf
+ unprocessed
;
3366 /* Allow quitting out of the actual I/O. */
3369 this = read (fd
, destination
, trytry
);
3372 if (this < 0 || this + unprocessed
== 0)
3380 if (CODING_REQUIRE_CONVERSION (&coding
))
3382 int require
, produced
, consumed
;
3384 this += unprocessed
;
3386 /* If we are using more space than estimated,
3387 make CONVERSION_BUFFER bigger. */
3388 require
= decoding_buffer_size (&coding
, this);
3389 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
3391 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
3392 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
3395 /* Convert this batch with results in CONVERSION_BUFFER. */
3396 if (how_much
>= total
) /* This is the last block. */
3397 coding
.last_block
= 1;
3398 produced
= decode_coding (&coding
, read_buf
,
3399 conversion_buffer
+ inserted
,
3400 this, bufsize
- inserted
,
3403 /* Save for next iteration whatever we didn't convert. */
3404 unprocessed
= this - consumed
;
3405 bcopy (read_buf
+ consumed
, read_buf
, unprocessed
);
3412 /* At this point, INSERTED is how many characters
3413 are present in CONVERSION_BUFFER.
3414 HOW_MUCH should equal TOTAL,
3415 or should be <= 0 if we couldn't read the file. */
3419 free (conversion_buffer
);
3422 error ("IO error reading %s: %s",
3423 XSTRING (filename
)->data
, strerror (errno
));
3424 else if (how_much
== -2)
3425 error ("maximum buffer size exceeded");
3428 /* Compare the beginning of the converted file
3429 with the buffer text. */
3432 while (bufpos
< inserted
&& same_at_start
< same_at_end
3433 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
3434 same_at_start
++, bufpos
++;
3436 /* If the file matches the buffer completely,
3437 there's no need to replace anything. */
3439 if (bufpos
== inserted
)
3441 free (conversion_buffer
);
3444 /* Truncate the buffer to the size of the file. */
3445 del_range_1 (same_at_start
, same_at_end
, 0);
3449 /* Scan this bufferful from the end, comparing with
3450 the Emacs buffer. */
3453 /* Compare with same_at_start to avoid counting some buffer text
3454 as matching both at the file's beginning and at the end. */
3455 while (bufpos
> 0 && same_at_end
> same_at_start
3456 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
3457 same_at_end
--, bufpos
--;
3459 /* Don't try to reuse the same piece of text twice. */
3460 overlap
= same_at_start
- BEGV
- (same_at_end
+ inserted
- ZV
);
3462 same_at_end
+= overlap
;
3464 /* If display currently starts at beginning of line,
3465 keep it that way. */
3466 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3467 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3469 /* Replace the chars that we need to replace,
3470 and update INSERTED to equal the number of bytes
3471 we are taking from the file. */
3472 inserted
-= (Z
- same_at_end
) + (same_at_start
- BEG
);
3473 move_gap (same_at_start
);
3474 del_range_1 (same_at_start
, same_at_end
, 0);
3475 SET_PT (same_at_start
);
3476 insert_1 (conversion_buffer
+ same_at_start
- BEG
, inserted
, 0, 0);
3478 free (conversion_buffer
);
3487 register Lisp_Object temp
;
3489 total
= XINT (end
) - XINT (beg
);
3491 /* Make sure point-max won't overflow after this insertion. */
3492 XSETINT (temp
, total
);
3493 if (total
!= XINT (temp
))
3494 error ("Maximum buffer size exceeded");
3497 /* For a special file, all we can do is guess. */
3498 total
= READ_BUF_SIZE
;
3500 if (NILP (visit
) && total
> 0)
3501 prepare_to_modify_buffer (PT
, PT
);
3504 if (GAP_SIZE
< total
)
3505 make_gap (total
- GAP_SIZE
);
3507 if (XINT (beg
) != 0 || !NILP (replace
))
3509 if (lseek (fd
, XINT (beg
), 0) < 0)
3510 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
3513 /* In the following loop, HOW_MUCH contains the total bytes read so
3514 far. Before exiting the loop, it is set to -1 if I/O error
3515 occurs, set to -2 if the maximum buffer size is exceeded. */
3517 /* Total bytes inserted. */
3519 /* Bytes not processed in the previous loop because short gap size. */
3521 while (how_much
< total
)
3523 /* try is reserved in some compilers (Microsoft C) */
3524 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3525 char *destination
= (CODING_REQUIRE_CONVERSION (&coding
)
3526 ? read_buf
+ unprocessed
3527 : (char *) (POS_ADDR (PT
+ inserted
- 1) + 1));
3530 /* Allow quitting out of the actual I/O. */
3533 this = read (fd
, destination
, trytry
);
3536 if (this < 0 || this + unprocessed
== 0)
3542 /* For a regular file, where TOTAL is the real size,
3543 count HOW_MUCH to compare with it.
3544 For a special file, where TOTAL is just a buffer size,
3545 so don't bother counting in HOW_MUCH.
3546 (INSERTED is where we count the number of characters inserted.) */
3550 if (CODING_REQUIRE_CONVERSION (&coding
))
3552 int require
, produced
, consumed
;
3554 this += unprocessed
;
3555 /* Make sure that the gap is large enough. */
3556 require
= decoding_buffer_size (&coding
, this);
3557 if (GAP_SIZE
< require
)
3558 make_gap (require
- GAP_SIZE
);
3562 if (how_much
>= total
) /* This is the last block. */
3563 coding
.last_block
= 1;
3567 /* If we encounter EOF, say it is the last block. (The
3568 data this will apply to is the UNPROCESSED characters
3569 carried over from the last batch.) */
3571 coding
.last_block
= 1;
3574 produced
= decode_coding (&coding
, read_buf
,
3575 POS_ADDR (PT
+ inserted
- 1) + 1,
3576 this, GAP_SIZE
, &consumed
);
3581 XSET (temp
, Lisp_Int
, Z
+ produced
);
3582 if (Z
+ produced
!= XINT (temp
))
3588 unprocessed
= this - consumed
;
3589 bcopy (read_buf
+ consumed
, read_buf
, unprocessed
);
3598 /* Put an anchor to ensure multi-byte form ends at gap. */
3603 /* We don't have to consider file type of MSDOS because all files
3604 are read as binary and end-of-line format has already been
3605 decoded appropriately. */
3608 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
3609 /* Determine file type from name and remove LFs from CR-LFs if the file
3610 is deemed to be a text file. */
3612 current_buffer
->buffer_file_type
3613 = call1 (Qfind_buffer_file_type
, filename
);
3614 if (NILP (current_buffer
->buffer_file_type
))
3617 = inserted
- crlf_to_lf (inserted
, POS_ADDR (PT
- 1) + 1);
3620 GPT
-= reduced_size
;
3621 GAP_SIZE
+= reduced_size
;
3622 inserted
-= reduced_size
;
3630 record_insert (PT
, inserted
);
3632 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
3633 offset_intervals (current_buffer
, PT
, inserted
);
3639 /* Discard the unwind protect for closing the file. */
3643 error ("IO error reading %s: %s",
3644 XSTRING (filename
)->data
, strerror (errno
));
3645 else if (how_much
== -2)
3646 error ("maximum buffer size exceeded");
3653 if (!EQ (current_buffer
->undo_list
, Qt
))
3654 current_buffer
->undo_list
= Qnil
;
3656 stat (XSTRING (filename
)->data
, &st
);
3661 current_buffer
->modtime
= st
.st_mtime
;
3662 current_buffer
->filename
= filename
;
3665 SAVE_MODIFF
= MODIFF
;
3666 current_buffer
->auto_save_modified
= MODIFF
;
3667 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3668 #ifdef CLASH_DETECTION
3671 if (!NILP (current_buffer
->file_truename
))
3672 unlock_file (current_buffer
->file_truename
);
3673 unlock_file (filename
);
3675 #endif /* CLASH_DETECTION */
3677 Fsignal (Qfile_error
,
3678 Fcons (build_string ("not a regular file"),
3679 Fcons (filename
, Qnil
)));
3681 /* If visiting nonexistent file, return nil. */
3682 if (current_buffer
->modtime
== -1)
3683 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3686 /* Decode file format */
3689 insval
= call3 (Qformat_decode
,
3690 Qnil
, make_number (inserted
), visit
);
3691 CHECK_NUMBER (insval
, 0);
3692 inserted
= XFASTINT (insval
);
3695 /* Call after-change hooks for the inserted text, aside from the case
3696 of normal visiting (not with REPLACE), which is done in a new buffer
3697 "before" the buffer is changed. */
3698 if (inserted
> 0 && total
> 0
3699 && (NILP (visit
) || !NILP (replace
)))
3700 signal_after_change (PT
, 0, inserted
);
3704 p
= Vafter_insert_file_functions
;
3705 if (!NILP (coding
.post_read_conversion
))
3706 p
= Fcons (coding
.post_read_conversion
, p
);
3710 insval
= call1 (Fcar (p
), make_number (inserted
));
3713 CHECK_NUMBER (insval
, 0);
3714 inserted
= XFASTINT (insval
);
3722 val
= Fcons (filename
,
3723 Fcons (make_number (inserted
),
3726 RETURN_UNGCPRO (unbind_to (count
, val
));
3729 static Lisp_Object
build_annotations ();
3731 /* If build_annotations switched buffers, switch back to BUF.
3732 Kill the temporary buffer that was selected in the meantime.
3734 Since this kill only the last temporary buffer, some buffers remain
3735 not killed if build_annotations switched buffers more than once.
3739 build_annotations_unwind (buf
)
3744 if (XBUFFER (buf
) == current_buffer
)
3746 tembuf
= Fcurrent_buffer ();
3748 Fkill_buffer (tembuf
);
3752 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 6,
3753 "r\nFWrite region to file: ",
3754 "Write current region into specified file.\n\
3755 When called from a program, takes three arguments:\n\
3756 START, END and FILENAME. START and END are buffer positions.\n\
3757 Optional fourth argument APPEND if non-nil means\n\
3758 append to existing file contents (if any).\n\
3759 Optional fifth argument VISIT if t means\n\
3760 set the last-save-file-modtime of buffer to this file's modtime\n\
3761 and mark buffer not modified.\n\
3762 If VISIT is a string, it is a second file name;\n\
3763 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
3764 VISIT is also the file name to lock and unlock for clash detection.\n\
3765 If VISIT is neither t nor nil nor a string,\n\
3766 that means do not print the \"Wrote file\" message.\n\
3767 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
3768 use for locking and unlocking, overriding FILENAME and VISIT.\n\
3769 Kludgy feature: if START is a string, then that string is written\n\
3770 to the file, instead of any buffer contents, and END is ignored.")
3771 (start
, end
, filename
, append
, visit
, lockname
)
3772 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
3780 int count
= specpdl_ptr
- specpdl
;
3783 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3785 Lisp_Object handler
;
3786 Lisp_Object visit_file
;
3787 Lisp_Object annotations
;
3788 int visiting
, quietly
;
3789 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3790 struct buffer
*given_buffer
;
3792 int buffer_file_type
3793 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
3795 struct coding_system coding
;
3797 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3798 error ("Cannot do file visiting in an indirect buffer");
3800 if (!NILP (start
) && !STRINGP (start
))
3801 validate_region (&start
, &end
);
3803 GCPRO4 (start
, filename
, visit
, lockname
);
3805 /* Decide the coding-system to be encoded to. */
3809 if (auto_saving
|| NILP (current_buffer
->enable_multibyte_characters
))
3811 else if (!NILP (Vcoding_system_for_write
))
3812 val
= Vcoding_system_for_write
;
3813 else if (!NILP (Flocal_variable_if_set_p (Qbuffer_file_coding_system
,
3815 val
= Fsymbol_value (Qbuffer_file_coding_system
);
3818 Lisp_Object args
[7], coding_systems
;
3820 args
[0] = Qwrite_region
, args
[1] = start
, args
[2] = end
,
3821 args
[3] = filename
, args
[4] = append
, args
[5] = visit
,
3823 coding_systems
= Ffind_coding_system (7, args
);
3824 val
= (CONSP (coding_systems
)
3825 ? XCONS (coding_systems
)->cdr
3826 : current_buffer
->buffer_file_coding_system
);
3828 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3829 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
3830 coding
.selective
= 1;
3832 if (!NILP (current_buffer
->buffer_file_type
))
3833 coding
.eol_type
= CODING_EOL_LF
;
3837 filename
= Fexpand_file_name (filename
, Qnil
);
3838 if (STRINGP (visit
))
3839 visit_file
= Fexpand_file_name (visit
, Qnil
);
3841 visit_file
= filename
;
3844 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
3845 quietly
= !NILP (visit
);
3849 if (NILP (lockname
))
3850 lockname
= visit_file
;
3852 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
3854 /* If the file name has special constructs in it,
3855 call the corresponding file handler. */
3856 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
3857 /* If FILENAME has no handler, see if VISIT has one. */
3858 if (NILP (handler
) && STRINGP (visit
))
3859 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
3861 if (!NILP (handler
))
3864 val
= call6 (handler
, Qwrite_region
, start
, end
,
3865 filename
, append
, visit
);
3869 SAVE_MODIFF
= MODIFF
;
3870 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3871 current_buffer
->filename
= visit_file
;
3877 /* Special kludge to simplify auto-saving. */
3880 XSETFASTINT (start
, BEG
);
3881 XSETFASTINT (end
, Z
);
3884 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
3885 count1
= specpdl_ptr
- specpdl
;
3887 given_buffer
= current_buffer
;
3888 annotations
= build_annotations (start
, end
, coding
.pre_write_conversion
);
3889 if (current_buffer
!= given_buffer
)
3891 XSETFASTINT (start
, BEGV
);
3892 XSETFASTINT (end
, ZV
);
3895 #ifdef CLASH_DETECTION
3898 /* If we've locked this file for some other buffer,
3899 query before proceeding. */
3900 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
3901 call2 (intern ("ask-user-about-lock"), fn
, Vuser_login_name
);
3903 lock_file (lockname
);
3905 #endif /* CLASH_DETECTION */
3907 fn
= XSTRING (filename
)->data
;
3911 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
3912 #else /* not DOS_NT */
3913 desc
= open (fn
, O_WRONLY
);
3914 #endif /* not DOS_NT */
3916 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
) )
3918 if (auto_saving
) /* Overwrite any previous version of autosave file */
3920 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3921 desc
= open (fn
, O_RDWR
);
3923 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3924 ? XSTRING (current_buffer
->filename
)->data
: 0,
3927 else /* Write to temporary name and rename if no errors */
3929 Lisp_Object temp_name
;
3930 temp_name
= Ffile_name_directory (filename
);
3932 if (!NILP (temp_name
))
3934 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3935 build_string ("$$SAVE$$")));
3936 fname
= XSTRING (filename
)->data
;
3937 fn
= XSTRING (temp_name
)->data
;
3938 desc
= creat_copy_attrs (fname
, fn
);
3941 /* If we can't open the temporary file, try creating a new
3942 version of the original file. VMS "creat" creates a
3943 new version rather than truncating an existing file. */
3946 desc
= creat (fn
, 0666);
3947 #if 0 /* This can clobber an existing file and fail to replace it,
3948 if the user runs out of space. */
3951 /* We can't make a new version;
3952 try to truncate and rewrite existing version if any. */
3954 desc
= open (fn
, O_RDWR
);
3960 desc
= creat (fn
, 0666);
3965 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3966 S_IREAD
| S_IWRITE
);
3967 #else /* not DOS_NT */
3968 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3969 #endif /* not DOS_NT */
3970 #endif /* not VMS */
3976 #ifdef CLASH_DETECTION
3978 if (!auto_saving
) unlock_file (lockname
);
3980 #endif /* CLASH_DETECTION */
3981 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
3984 record_unwind_protect (close_file_unwind
, make_number (desc
));
3987 if (lseek (desc
, 0, 2) < 0)
3989 #ifdef CLASH_DETECTION
3990 if (!auto_saving
) unlock_file (lockname
);
3991 #endif /* CLASH_DETECTION */
3992 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
3997 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3998 * if we do writes that don't end with a carriage return. Furthermore
3999 * it cannot handle writes of more then 16K. The modified
4000 * version of "sys_write" in SYSDEP.C (see comment there) copes with
4001 * this EXCEPT for the last record (iff it doesn't end with a carriage
4002 * return). This implies that if your buffer doesn't end with a carriage
4003 * return, you get one free... tough. However it also means that if
4004 * we make two calls to sys_write (a la the following code) you can
4005 * get one at the gap as well. The easiest way to fix this (honest)
4006 * is to move the gap to the next newline (or the end of the buffer).
4011 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4012 move_gap (find_next_newline (GPT
, 1));
4014 /* Whether VMS or not, we must move the gap to the next of newline
4015 when we must put designation sequences at beginning of line. */
4016 if (INTEGERP (start
)
4017 && coding
.type
== coding_type_iso2022
4018 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
4019 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4020 move_gap (find_next_newline (GPT
, 1));
4026 if (STRINGP (start
))
4028 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
4029 XSTRING (start
)->size
, 0, &annotations
, &coding
);
4032 else if (XINT (start
) != XINT (end
))
4035 if (XINT (start
) < GPT
)
4037 register int end1
= XINT (end
);
4039 failure
= 0 > a_write (desc
, POS_ADDR (tem
),
4040 min (GPT
, end1
) - tem
, tem
, &annotations
,
4042 nwritten
+= min (GPT
, end1
) - tem
;
4046 if (XINT (end
) > GPT
&& !failure
)
4049 tem
= max (tem
, GPT
);
4050 failure
= 0 > a_write (desc
, POS_ADDR (tem
), XINT (end
) - tem
,
4051 tem
, &annotations
, &coding
);
4052 nwritten
+= XINT (end
) - tem
;
4058 /* If file was empty, still need to write the annotations */
4059 coding
.last_block
= 1;
4060 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
, &coding
);
4064 if (coding
.require_flushing
)
4066 /* We have to flush out a data. */
4067 coding
.last_block
= 1;
4068 failure
= 0 > e_write (desc
, "", 0, &coding
);
4075 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4076 Disk full in NFS may be reported here. */
4077 /* mib says that closing the file will try to write as fast as NFS can do
4078 it, and that means the fsync here is not crucial for autosave files. */
4079 if (!auto_saving
&& fsync (desc
) < 0)
4081 /* If fsync fails with EINTR, don't treat that as serious. */
4083 failure
= 1, save_errno
= errno
;
4087 /* Spurious "file has changed on disk" warnings have been
4088 observed on Suns as well.
4089 It seems that `close' can change the modtime, under nfs.
4091 (This has supposedly been fixed in Sunos 4,
4092 but who knows about all the other machines with NFS?) */
4095 /* On VMS and APOLLO, must do the stat after the close
4096 since closing changes the modtime. */
4099 /* Recall that #if defined does not work on VMS. */
4106 /* NFS can report a write failure now. */
4107 if (close (desc
) < 0)
4108 failure
= 1, save_errno
= errno
;
4111 /* If we wrote to a temporary name and had no errors, rename to real name. */
4115 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
4123 /* Discard the unwind protect for close_file_unwind. */
4124 specpdl_ptr
= specpdl
+ count1
;
4125 /* Restore the original current buffer. */
4126 visit_file
= unbind_to (count
, visit_file
);
4128 #ifdef CLASH_DETECTION
4130 unlock_file (lockname
);
4131 #endif /* CLASH_DETECTION */
4133 /* Do this before reporting IO error
4134 to avoid a "file has changed on disk" warning on
4135 next attempt to save. */
4137 current_buffer
->modtime
= st
.st_mtime
;
4140 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
4144 SAVE_MODIFF
= MODIFF
;
4145 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4146 current_buffer
->filename
= visit_file
;
4147 update_mode_lines
++;
4153 message ("Wrote %s", XSTRING (visit_file
)->data
);
4158 Lisp_Object
merge ();
4160 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4161 "Return t if (car A) is numerically less than (car B).")
4165 return Flss (Fcar (a
), Fcar (b
));
4168 /* Build the complete list of annotations appropriate for writing out
4169 the text between START and END, by calling all the functions in
4170 write-region-annotate-functions and merging the lists they return.
4171 If one of these functions switches to a different buffer, we assume
4172 that buffer contains altered text. Therefore, the caller must
4173 make sure to restore the current buffer in all cases,
4174 as save-excursion would do. */
4177 build_annotations (start
, end
, pre_write_conversion
)
4178 Lisp_Object start
, end
, pre_write_conversion
;
4180 Lisp_Object annotations
;
4182 struct gcpro gcpro1
, gcpro2
;
4183 Lisp_Object original_buffer
;
4185 XSETBUFFER (original_buffer
, current_buffer
);
4188 p
= Vwrite_region_annotate_functions
;
4189 GCPRO2 (annotations
, p
);
4192 struct buffer
*given_buffer
= current_buffer
;
4193 Vwrite_region_annotations_so_far
= annotations
;
4194 res
= call2 (Fcar (p
), start
, end
);
4195 /* If the function makes a different buffer current,
4196 assume that means this buffer contains altered text to be output.
4197 Reset START and END from the buffer bounds
4198 and discard all previous annotations because they should have
4199 been dealt with by this function. */
4200 if (current_buffer
!= given_buffer
)
4202 XSETFASTINT (start
, BEGV
);
4203 XSETFASTINT (end
, ZV
);
4206 Flength (res
); /* Check basic validity of return value */
4207 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4211 /* Now do the same for annotation functions implied by the file-format */
4212 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
4213 p
= Vauto_save_file_format
;
4215 p
= current_buffer
->file_format
;
4218 struct buffer
*given_buffer
= current_buffer
;
4219 Vwrite_region_annotations_so_far
= annotations
;
4220 res
= call4 (Qformat_annotate_function
, Fcar (p
), start
, end
,
4222 if (current_buffer
!= given_buffer
)
4224 XSETFASTINT (start
, BEGV
);
4225 XSETFASTINT (end
, ZV
);
4229 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4233 /* At last, do the same for the function PRE_WRITE_CONVERSION
4234 implied by the current coding-system. */
4235 if (!NILP (pre_write_conversion
))
4237 struct buffer
*given_buffer
= current_buffer
;
4238 Vwrite_region_annotations_so_far
= annotations
;
4239 res
= call2 (pre_write_conversion
, start
, end
);
4241 annotations
= (current_buffer
!= given_buffer
4243 : merge (annotations
, res
, Qcar_less_than_car
));
4250 /* Write to descriptor DESC the LEN characters starting at ADDR,
4251 assuming they start at position POS in the buffer.
4252 Intersperse with them the annotations from *ANNOT
4253 (those which fall within the range of positions POS to POS + LEN),
4254 each at its appropriate position.
4256 Modify *ANNOT by discarding elements as we output them.
4257 The return value is negative in case of system call failure. */
4260 a_write (desc
, addr
, len
, pos
, annot
, coding
)
4262 register char *addr
;
4266 struct coding_system
*coding
;
4270 int lastpos
= pos
+ len
;
4272 while (NILP (*annot
) || CONSP (*annot
))
4274 tem
= Fcar_safe (Fcar (*annot
));
4275 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
4276 nextpos
= XFASTINT (tem
);
4278 return e_write (desc
, addr
, lastpos
- pos
, coding
);
4281 if (0 > e_write (desc
, addr
, nextpos
- pos
, coding
))
4283 addr
+= nextpos
- pos
;
4286 tem
= Fcdr (Fcar (*annot
));
4289 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
,
4293 *annot
= Fcdr (*annot
);
4297 #ifndef WRITE_BUF_SIZE
4298 #define WRITE_BUF_SIZE (16 * 1024)
4302 e_write (desc
, addr
, len
, coding
)
4304 register char *addr
;
4306 struct coding_system
*coding
;
4308 char buf
[WRITE_BUF_SIZE
];
4309 int produced
, consumed
;
4311 /* We used to have a code for handling selective display here. But,
4312 now it is handled within encode_coding. */
4315 produced
= encode_coding (coding
, addr
, buf
, len
, WRITE_BUF_SIZE
,
4317 len
-= consumed
, addr
+= consumed
;
4320 produced
-= write (desc
, buf
, produced
);
4321 if (produced
) return -1;
4329 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
4330 Sverify_visited_file_modtime
, 1, 1, 0,
4331 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
4332 This means that the file has not been changed since it was visited or saved.")
4338 Lisp_Object handler
;
4340 CHECK_BUFFER (buf
, 0);
4343 if (!STRINGP (b
->filename
)) return Qt
;
4344 if (b
->modtime
== 0) return Qt
;
4346 /* If the file name has special constructs in it,
4347 call the corresponding file handler. */
4348 handler
= Ffind_file_name_handler (b
->filename
,
4349 Qverify_visited_file_modtime
);
4350 if (!NILP (handler
))
4351 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
4353 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
4355 /* If the file doesn't exist now and didn't exist before,
4356 we say that it isn't modified, provided the error is a tame one. */
4357 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
4362 if (st
.st_mtime
== b
->modtime
4363 /* If both are positive, accept them if they are off by one second. */
4364 || (st
.st_mtime
> 0 && b
->modtime
> 0
4365 && (st
.st_mtime
== b
->modtime
+ 1
4366 || st
.st_mtime
== b
->modtime
- 1)))
4371 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
4372 Sclear_visited_file_modtime
, 0, 0, 0,
4373 "Clear out records of last mod time of visited file.\n\
4374 Next attempt to save will certainly not complain of a discrepancy.")
4377 current_buffer
->modtime
= 0;
4381 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
4382 Svisited_file_modtime
, 0, 0, 0,
4383 "Return the current buffer's recorded visited file modification time.\n\
4384 The value is a list of the form (HIGH . LOW), like the time values\n\
4385 that `file-attributes' returns.")
4388 return long_to_cons ((unsigned long) current_buffer
->modtime
);
4391 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
4392 Sset_visited_file_modtime
, 0, 1, 0,
4393 "Update buffer's recorded modification time from the visited file's time.\n\
4394 Useful if the buffer was not read from the file normally\n\
4395 or if the file itself has been changed for some known benign reason.\n\
4396 An argument specifies the modification time value to use\n\
4397 \(instead of that of the visited file), in the form of a list\n\
4398 \(HIGH . LOW) or (HIGH LOW).")
4400 Lisp_Object time_list
;
4402 if (!NILP (time_list
))
4403 current_buffer
->modtime
= cons_to_long (time_list
);
4406 register Lisp_Object filename
;
4408 Lisp_Object handler
;
4410 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
4412 /* If the file name has special constructs in it,
4413 call the corresponding file handler. */
4414 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
4415 if (!NILP (handler
))
4416 /* The handler can find the file name the same way we did. */
4417 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
4418 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
4419 current_buffer
->modtime
= st
.st_mtime
;
4429 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
4430 Fsleep_for (make_number (1), Qnil
);
4431 message ("Autosaving...error!for %s", XSTRING (current_buffer
->name
)->data
);
4432 Fsleep_for (make_number (1), Qnil
);
4433 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
4434 Fsleep_for (make_number (1), Qnil
);
4444 /* Get visited file's mode to become the auto save file's mode. */
4445 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
4446 /* But make sure we can overwrite it later! */
4447 auto_save_mode_bits
= st
.st_mode
| 0600;
4449 auto_save_mode_bits
= 0666;
4452 Fwrite_region (Qnil
, Qnil
,
4453 current_buffer
->auto_save_file_name
,
4454 Qnil
, Qlambda
, Qnil
);
4458 do_auto_save_unwind (stream
) /* used as unwind-protect function */
4463 fclose ((FILE *) (XFASTINT (XCONS (stream
)->car
) << 16
4464 | XFASTINT (XCONS (stream
)->cdr
)));
4468 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
4469 "Auto-save all buffers that need it.\n\
4470 This is all buffers that have auto-saving enabled\n\
4471 and are changed since last auto-saved.\n\
4472 Auto-saving writes the buffer into a file\n\
4473 so that your editing is not lost if the system crashes.\n\
4474 This file is not the file you visited; that changes only when you save.\n\
4475 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
4476 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
4477 A non-nil CURRENT-ONLY argument means save only current buffer.")
4478 (no_message
, current_only
)
4479 Lisp_Object no_message
, current_only
;
4481 struct buffer
*old
= current_buffer
, *b
;
4482 Lisp_Object tail
, buf
;
4484 char *omessage
= echo_area_glyphs
;
4485 int omessage_length
= echo_area_glyphs_length
;
4486 int do_handled_files
;
4489 Lisp_Object lispstream
;
4490 int count
= specpdl_ptr
- specpdl
;
4493 /* Ordinarily don't quit within this function,
4494 but don't make it impossible to quit (in case we get hung in I/O). */
4498 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
4499 point to non-strings reached from Vbuffer_alist. */
4504 if (!NILP (Vrun_hooks
))
4505 call1 (Vrun_hooks
, intern ("auto-save-hook"));
4507 if (STRINGP (Vauto_save_list_file_name
))
4509 Lisp_Object listfile
;
4510 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
4511 stream
= fopen (XSTRING (listfile
)->data
, "w");
4513 /* Arrange to close that file whether or not we get an error.
4514 Also reset auto_saving to 0. */
4515 lispstream
= Fcons (Qnil
, Qnil
);
4516 XSETFASTINT (XCONS (lispstream
)->car
, (EMACS_UINT
)stream
>> 16);
4517 XSETFASTINT (XCONS (lispstream
)->cdr
, (EMACS_UINT
)stream
& 0xffff);
4525 record_unwind_protect (do_auto_save_unwind
, lispstream
);
4529 /* First, save all files which don't have handlers. If Emacs is
4530 crashing, the handlers may tweak what is causing Emacs to crash
4531 in the first place, and it would be a shame if Emacs failed to
4532 autosave perfectly ordinary files because it couldn't handle some
4534 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
4535 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
4537 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
4540 /* Record all the buffers that have auto save mode
4541 in the special file that lists them. For each of these buffers,
4542 Record visited name (if any) and auto save name. */
4543 if (STRINGP (b
->auto_save_file_name
)
4544 && stream
!= NULL
&& do_handled_files
== 0)
4546 if (!NILP (b
->filename
))
4548 fwrite (XSTRING (b
->filename
)->data
, 1,
4549 XSTRING (b
->filename
)->size
, stream
);
4551 putc ('\n', stream
);
4552 fwrite (XSTRING (b
->auto_save_file_name
)->data
, 1,
4553 XSTRING (b
->auto_save_file_name
)->size
, stream
);
4554 putc ('\n', stream
);
4557 if (!NILP (current_only
)
4558 && b
!= current_buffer
)
4561 /* Don't auto-save indirect buffers.
4562 The base buffer takes care of it. */
4566 /* Check for auto save enabled
4567 and file changed since last auto save
4568 and file changed since last real save. */
4569 if (STRINGP (b
->auto_save_file_name
)
4570 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
4571 && b
->auto_save_modified
< BUF_MODIFF (b
)
4572 /* -1 means we've turned off autosaving for a while--see below. */
4573 && XINT (b
->save_length
) >= 0
4574 && (do_handled_files
4575 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
4578 EMACS_TIME before_time
, after_time
;
4580 EMACS_GET_TIME (before_time
);
4582 /* If we had a failure, don't try again for 20 minutes. */
4583 if (b
->auto_save_failure_time
>= 0
4584 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
4587 if ((XFASTINT (b
->save_length
) * 10
4588 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
4589 /* A short file is likely to change a large fraction;
4590 spare the user annoying messages. */
4591 && XFASTINT (b
->save_length
) > 5000
4592 /* These messages are frequent and annoying for `*mail*'. */
4593 && !EQ (b
->filename
, Qnil
)
4594 && NILP (no_message
))
4596 /* It has shrunk too much; turn off auto-saving here. */
4597 message ("Buffer %s has shrunk a lot; auto save turned off there",
4598 XSTRING (b
->name
)->data
);
4599 /* Turn off auto-saving until there's a real save,
4600 and prevent any more warnings. */
4601 XSETINT (b
->save_length
, -1);
4602 Fsleep_for (make_number (1), Qnil
);
4605 set_buffer_internal (b
);
4606 if (!auto_saved
&& NILP (no_message
))
4607 message1 ("Auto-saving...");
4608 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
4610 b
->auto_save_modified
= BUF_MODIFF (b
);
4611 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4612 set_buffer_internal (old
);
4614 EMACS_GET_TIME (after_time
);
4616 /* If auto-save took more than 60 seconds,
4617 assume it was an NFS failure that got a timeout. */
4618 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
4619 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
4623 /* Prevent another auto save till enough input events come in. */
4624 record_auto_save ();
4626 if (auto_saved
&& NILP (no_message
))
4630 sit_for (1, 0, 0, 0, 0);
4631 message2 (omessage
, omessage_length
);
4634 message1 ("Auto-saving...done");
4639 unbind_to (count
, Qnil
);
4643 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
4644 Sset_buffer_auto_saved
, 0, 0, 0,
4645 "Mark current buffer as auto-saved with its current text.\n\
4646 No auto-save file will be written until the buffer changes again.")
4649 current_buffer
->auto_save_modified
= MODIFF
;
4650 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4651 current_buffer
->auto_save_failure_time
= -1;
4655 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
4656 Sclear_buffer_auto_save_failure
, 0, 0, 0,
4657 "Clear any record of a recent auto-save failure in the current buffer.")
4660 current_buffer
->auto_save_failure_time
= -1;
4664 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
4666 "Return t if buffer has been auto-saved since last read in or saved.")
4669 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
4672 /* Reading and completing file names */
4673 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
4675 /* In the string VAL, change each $ to $$ and return the result. */
4678 double_dollars (val
)
4681 register unsigned char *old
, *new;
4685 osize
= XSTRING (val
)->size
;
4686 /* Quote "$" as "$$" to get it past substitute-in-file-name */
4687 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
4688 if (*old
++ == '$') count
++;
4691 old
= XSTRING (val
)->data
;
4692 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
4693 new = XSTRING (val
)->data
;
4694 for (n
= osize
; n
> 0; n
--)
4707 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
4709 "Internal subroutine for read-file-name. Do not call this.")
4710 (string
, dir
, action
)
4711 Lisp_Object string
, dir
, action
;
4712 /* action is nil for complete, t for return list of completions,
4713 lambda for verify final value */
4715 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
4717 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4719 CHECK_STRING (string
, 0);
4726 /* No need to protect ACTION--we only compare it with t and nil. */
4727 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
4729 if (XSTRING (string
)->size
== 0)
4731 if (EQ (action
, Qlambda
))
4739 orig_string
= string
;
4740 string
= Fsubstitute_in_file_name (string
);
4741 changed
= NILP (Fstring_equal (string
, orig_string
));
4742 name
= Ffile_name_nondirectory (string
);
4743 val
= Ffile_name_directory (string
);
4745 realdir
= Fexpand_file_name (val
, realdir
);
4750 specdir
= Ffile_name_directory (string
);
4751 val
= Ffile_name_completion (name
, realdir
);
4756 return double_dollars (string
);
4760 if (!NILP (specdir
))
4761 val
= concat2 (specdir
, val
);
4763 return double_dollars (val
);
4766 #endif /* not VMS */
4770 if (EQ (action
, Qt
))
4771 return Ffile_name_all_completions (name
, realdir
);
4772 /* Only other case actually used is ACTION = lambda */
4774 /* Supposedly this helps commands such as `cd' that read directory names,
4775 but can someone explain how it helps them? -- RMS */
4776 if (XSTRING (name
)->size
== 0)
4779 return Ffile_exists_p (string
);
4782 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4783 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
4784 Value is not expanded---you must call `expand-file-name' yourself.\n\
4785 Default name to DEFAULT-FILENAME if user enters a null string.\n\
4786 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
4787 except that if INITIAL is specified, that combined with DIR is used.)\n\
4788 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
4789 Non-nil and non-t means also require confirmation after completion.\n\
4790 Fifth arg INITIAL specifies text to start with.\n\
4791 DIR defaults to current buffer's directory default.")
4792 (prompt
, dir
, default_filename
, mustmatch
, initial
)
4793 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
4795 Lisp_Object val
, insdef
, insdef1
, tem
;
4796 struct gcpro gcpro1
, gcpro2
;
4797 register char *homedir
;
4801 dir
= current_buffer
->directory
;
4802 if (NILP (default_filename
))
4804 if (! NILP (initial
))
4805 default_filename
= Fexpand_file_name (initial
, dir
);
4807 default_filename
= current_buffer
->filename
;
4810 /* If dir starts with user's homedir, change that to ~. */
4811 homedir
= (char *) egetenv ("HOME");
4813 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
4814 CORRECT_DIR_SEPS (homedir
);
4818 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4819 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
4821 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4822 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4823 XSTRING (dir
)->data
[0] = '~';
4826 if (insert_default_directory
&& STRINGP (dir
))
4829 if (!NILP (initial
))
4831 Lisp_Object args
[2], pos
;
4835 insdef
= Fconcat (2, args
);
4836 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
4837 insdef1
= Fcons (double_dollars (insdef
), pos
);
4840 insdef1
= double_dollars (insdef
);
4842 else if (STRINGP (initial
))
4845 insdef1
= Fcons (double_dollars (insdef
), 0);
4848 insdef
= Qnil
, insdef1
= Qnil
;
4851 count
= specpdl_ptr
- specpdl
;
4852 specbind (intern ("completion-ignore-case"), Qt
);
4855 GCPRO2 (insdef
, default_filename
);
4856 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4857 dir
, mustmatch
, insdef1
,
4858 Qfile_name_history
, default_filename
);
4861 unbind_to (count
, Qnil
);
4866 error ("No file name specified");
4867 tem
= Fstring_equal (val
, insdef
);
4868 if (!NILP (tem
) && !NILP (default_filename
))
4869 return default_filename
;
4870 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
4872 if (!NILP (default_filename
))
4873 return default_filename
;
4875 error ("No default file name");
4877 return Fsubstitute_in_file_name (val
);
4880 #if 0 /* Old version */
4881 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4882 /* Don't confuse make-docfile by having two doc strings for this function.
4883 make-docfile does not pay attention to #if, for good reason! */
4885 (prompt
, dir
, defalt
, mustmatch
, initial
)
4886 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4888 Lisp_Object val
, insdef
, tem
;
4889 struct gcpro gcpro1
, gcpro2
;
4890 register char *homedir
;
4894 dir
= current_buffer
->directory
;
4896 defalt
= current_buffer
->filename
;
4898 /* If dir starts with user's homedir, change that to ~. */
4899 homedir
= (char *) egetenv ("HOME");
4902 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4903 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
4905 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4906 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4907 XSTRING (dir
)->data
[0] = '~';
4910 if (!NILP (initial
))
4912 else if (insert_default_directory
)
4915 insdef
= build_string ("");
4918 count
= specpdl_ptr
- specpdl
;
4919 specbind (intern ("completion-ignore-case"), Qt
);
4922 GCPRO2 (insdef
, defalt
);
4923 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4925 insert_default_directory
? insdef
: Qnil
,
4926 Qfile_name_history
, Qnil
);
4929 unbind_to (count
, Qnil
);
4934 error ("No file name specified");
4935 tem
= Fstring_equal (val
, insdef
);
4936 if (!NILP (tem
) && !NILP (defalt
))
4938 return Fsubstitute_in_file_name (val
);
4940 #endif /* Old version */
4944 Qexpand_file_name
= intern ("expand-file-name");
4945 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
4946 Qdirectory_file_name
= intern ("directory-file-name");
4947 Qfile_name_directory
= intern ("file-name-directory");
4948 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
4949 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
4950 Qfile_name_as_directory
= intern ("file-name-as-directory");
4951 Qcopy_file
= intern ("copy-file");
4952 Qmake_directory_internal
= intern ("make-directory-internal");
4953 Qdelete_directory
= intern ("delete-directory");
4954 Qdelete_file
= intern ("delete-file");
4955 Qrename_file
= intern ("rename-file");
4956 Qadd_name_to_file
= intern ("add-name-to-file");
4957 Qmake_symbolic_link
= intern ("make-symbolic-link");
4958 Qfile_exists_p
= intern ("file-exists-p");
4959 Qfile_executable_p
= intern ("file-executable-p");
4960 Qfile_readable_p
= intern ("file-readable-p");
4961 Qfile_writable_p
= intern ("file-writable-p");
4962 Qfile_symlink_p
= intern ("file-symlink-p");
4963 Qaccess_file
= intern ("access-file");
4964 Qfile_directory_p
= intern ("file-directory-p");
4965 Qfile_regular_p
= intern ("file-regular-p");
4966 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
4967 Qfile_modes
= intern ("file-modes");
4968 Qset_file_modes
= intern ("set-file-modes");
4969 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
4970 Qinsert_file_contents
= intern ("insert-file-contents");
4971 Qwrite_region
= intern ("write-region");
4972 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
4973 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
4975 staticpro (&Qexpand_file_name
);
4976 staticpro (&Qsubstitute_in_file_name
);
4977 staticpro (&Qdirectory_file_name
);
4978 staticpro (&Qfile_name_directory
);
4979 staticpro (&Qfile_name_nondirectory
);
4980 staticpro (&Qunhandled_file_name_directory
);
4981 staticpro (&Qfile_name_as_directory
);
4982 staticpro (&Qcopy_file
);
4983 staticpro (&Qmake_directory_internal
);
4984 staticpro (&Qdelete_directory
);
4985 staticpro (&Qdelete_file
);
4986 staticpro (&Qrename_file
);
4987 staticpro (&Qadd_name_to_file
);
4988 staticpro (&Qmake_symbolic_link
);
4989 staticpro (&Qfile_exists_p
);
4990 staticpro (&Qfile_executable_p
);
4991 staticpro (&Qfile_readable_p
);
4992 staticpro (&Qfile_writable_p
);
4993 staticpro (&Qaccess_file
);
4994 staticpro (&Qfile_symlink_p
);
4995 staticpro (&Qfile_directory_p
);
4996 staticpro (&Qfile_regular_p
);
4997 staticpro (&Qfile_accessible_directory_p
);
4998 staticpro (&Qfile_modes
);
4999 staticpro (&Qset_file_modes
);
5000 staticpro (&Qfile_newer_than_file_p
);
5001 staticpro (&Qinsert_file_contents
);
5002 staticpro (&Qwrite_region
);
5003 staticpro (&Qverify_visited_file_modtime
);
5004 staticpro (&Qset_visited_file_modtime
);
5006 Qfile_name_history
= intern ("file-name-history");
5007 Fset (Qfile_name_history
, Qnil
);
5008 staticpro (&Qfile_name_history
);
5010 Qfile_error
= intern ("file-error");
5011 staticpro (&Qfile_error
);
5012 Qfile_already_exists
= intern ("file-already-exists");
5013 staticpro (&Qfile_already_exists
);
5014 Qfile_date_error
= intern ("file-date-error");
5015 staticpro (&Qfile_date_error
);
5018 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
5019 staticpro (&Qfind_buffer_file_type
);
5022 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
5023 "*Format in which to write auto-save files.\n\
5024 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
5025 If it is t, which is the default, auto-save files are written in the\n\
5026 same format as a regular save would use.");
5027 Vauto_save_file_format
= Qt
;
5029 Qformat_decode
= intern ("format-decode");
5030 staticpro (&Qformat_decode
);
5031 Qformat_annotate_function
= intern ("format-annotate-function");
5032 staticpro (&Qformat_annotate_function
);
5034 Qcar_less_than_car
= intern ("car-less-than-car");
5035 staticpro (&Qcar_less_than_car
);
5037 Fput (Qfile_error
, Qerror_conditions
,
5038 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
5039 Fput (Qfile_error
, Qerror_message
,
5040 build_string ("File error"));
5042 Fput (Qfile_already_exists
, Qerror_conditions
,
5043 Fcons (Qfile_already_exists
,
5044 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5045 Fput (Qfile_already_exists
, Qerror_message
,
5046 build_string ("File already exists"));
5048 Fput (Qfile_date_error
, Qerror_conditions
,
5049 Fcons (Qfile_date_error
,
5050 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5051 Fput (Qfile_date_error
, Qerror_message
,
5052 build_string ("Cannot set file date"));
5054 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
5055 "*Non-nil means when reading a filename start with default dir in minibuffer.");
5056 insert_default_directory
= 1;
5058 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
5059 "*Non-nil means write new files with record format `stmlf'.\n\
5060 nil means use format `var'. This variable is meaningful only on VMS.");
5061 vms_stmlf_recfm
= 0;
5063 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
5064 "Directory separator character for built-in functions that return file names.\n\
5065 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
5066 This variable affects the built-in functions only on Windows,\n\
5067 on other platforms, it is initialized so that Lisp code can find out\n\
5068 what the normal separator is.");
5069 Vdirectory_sep_char
= '/';
5071 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5072 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
5073 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
5076 The first argument given to HANDLER is the name of the I/O primitive\n\
5077 to be handled; the remaining arguments are the arguments that were\n\
5078 passed to that primitive. For example, if you do\n\
5079 (file-exists-p FILENAME)\n\
5080 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
5081 (funcall HANDLER 'file-exists-p FILENAME)\n\
5082 The function `find-file-name-handler' checks this list for a handler\n\
5083 for its argument.");
5084 Vfile_name_handler_alist
= Qnil
;
5086 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5087 "A list of functions to be called at the end of `insert-file-contents'.\n\
5088 Each is passed one argument, the number of bytes inserted. It should return\n\
5089 the new byte count, and leave point the same. If `insert-file-contents' is\n\
5090 intercepted by a handler from `file-name-handler-alist', that handler is\n\
5091 responsible for calling the after-insert-file-functions if appropriate.");
5092 Vafter_insert_file_functions
= Qnil
;
5094 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5095 "A list of functions to be called at the start of `write-region'.\n\
5096 Each is passed two arguments, START and END as for `write-region'.\n\
5097 These are usually two numbers but not always; see the documentation\n\
5098 for `write-region'. The function should return a list of pairs\n\
5099 of the form (POSITION . STRING), consisting of strings to be effectively\n\
5100 inserted at the specified positions of the file being written (1 means to\n\
5101 insert before the first byte written). The POSITIONs must be sorted into\n\
5102 increasing order. If there are several functions in the list, the several\n\
5103 lists are merged destructively.");
5104 Vwrite_region_annotate_functions
= Qnil
;
5106 DEFVAR_LISP ("write-region-annotations-so-far",
5107 &Vwrite_region_annotations_so_far
,
5108 "When an annotation function is called, this holds the previous annotations.\n\
5109 These are the annotations made by other annotation functions\n\
5110 that were already called. See also `write-region-annotate-functions'.");
5111 Vwrite_region_annotations_so_far
= Qnil
;
5113 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5114 "A list of file name handlers that temporarily should not be used.\n\
5115 This applies only to the operation `inhibit-file-name-operation'.");
5116 Vinhibit_file_name_handlers
= Qnil
;
5118 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5119 "The operation for which `inhibit-file-name-handlers' is applicable.");
5120 Vinhibit_file_name_operation
= Qnil
;
5122 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5123 "File name in which we write a list of all auto save file names.\n\
5124 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
5125 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
5127 Vauto_save_list_file_name
= Qnil
;
5129 defsubr (&Sfind_file_name_handler
);
5130 defsubr (&Sfile_name_directory
);
5131 defsubr (&Sfile_name_nondirectory
);
5132 defsubr (&Sunhandled_file_name_directory
);
5133 defsubr (&Sfile_name_as_directory
);
5134 defsubr (&Sdirectory_file_name
);
5135 defsubr (&Smake_temp_name
);
5136 defsubr (&Sexpand_file_name
);
5137 defsubr (&Ssubstitute_in_file_name
);
5138 defsubr (&Scopy_file
);
5139 defsubr (&Smake_directory_internal
);
5140 defsubr (&Sdelete_directory
);
5141 defsubr (&Sdelete_file
);
5142 defsubr (&Srename_file
);
5143 defsubr (&Sadd_name_to_file
);
5145 defsubr (&Smake_symbolic_link
);
5146 #endif /* S_IFLNK */
5148 defsubr (&Sdefine_logical_name
);
5151 defsubr (&Ssysnetunam
);
5152 #endif /* HPUX_NET */
5153 defsubr (&Sfile_name_absolute_p
);
5154 defsubr (&Sfile_exists_p
);
5155 defsubr (&Sfile_executable_p
);
5156 defsubr (&Sfile_readable_p
);
5157 defsubr (&Sfile_writable_p
);
5158 defsubr (&Saccess_file
);
5159 defsubr (&Sfile_symlink_p
);
5160 defsubr (&Sfile_directory_p
);
5161 defsubr (&Sfile_accessible_directory_p
);
5162 defsubr (&Sfile_regular_p
);
5163 defsubr (&Sfile_modes
);
5164 defsubr (&Sset_file_modes
);
5165 defsubr (&Sset_default_file_modes
);
5166 defsubr (&Sdefault_file_modes
);
5167 defsubr (&Sfile_newer_than_file_p
);
5168 defsubr (&Sinsert_file_contents
);
5169 defsubr (&Swrite_region
);
5170 defsubr (&Scar_less_than_car
);
5171 defsubr (&Sverify_visited_file_modtime
);
5172 defsubr (&Sclear_visited_file_modtime
);
5173 defsubr (&Svisited_file_modtime
);
5174 defsubr (&Sset_visited_file_modtime
);
5175 defsubr (&Sdo_auto_save
);
5176 defsubr (&Sset_buffer_auto_saved
);
5177 defsubr (&Sclear_buffer_auto_save_failure
);
5178 defsubr (&Srecent_auto_save_p
);
5180 defsubr (&Sread_file_name_internal
);
5181 defsubr (&Sread_file_name
);
5184 defsubr (&Sunix_sync
);