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