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
);
3089 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3091 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
3092 || fstat (fd
, &st
) < 0)
3093 #endif /* not APOLLO */
3095 if (fd
>= 0) close (fd
);
3098 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3105 /* This code will need to be changed in order to work on named
3106 pipes, and it's probably just not worth it. So we should at
3107 least signal an error. */
3108 if (!S_ISREG (st
.st_mode
))
3115 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3116 Fsignal (Qfile_error
,
3117 Fcons (build_string ("not a regular file"),
3118 Fcons (filename
, Qnil
)));
3123 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
3126 /* Replacement should preserve point as it preserves markers. */
3127 if (!NILP (replace
))
3128 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3130 record_unwind_protect (close_file_unwind
, make_number (fd
));
3132 /* Supposedly happens on VMS. */
3133 if (! not_regular
&& st
.st_size
< 0)
3134 error ("File size is negative");
3136 if (!NILP (beg
) || !NILP (end
))
3138 error ("Attempt to visit less than an entire file");
3141 CHECK_NUMBER (beg
, 0);
3143 XSETFASTINT (beg
, 0);
3146 CHECK_NUMBER (end
, 0);
3151 XSETINT (end
, st
.st_size
);
3152 if (XINT (end
) != st
.st_size
)
3153 error ("Maximum buffer size exceeded");
3157 /* If requested, replace the accessible part of the buffer
3158 with the file contents. Avoid replacing text at the
3159 beginning or end of the buffer that matches the file contents;
3160 that preserves markers pointing to the unchanged parts.
3162 Here we implement this feature in an optimized way
3163 for the case where code conversion is NOT needed.
3164 The following if-statement handles the case of conversion
3165 in a less optimal way.
3167 If the code conversion is "automatic" then we try using this
3168 method and hope for the best.
3169 But if we discover the need for conversion, we give up on this method
3170 and let the following if-statement handle the replace job. */
3172 && CODING_MAY_REQUIRE_NO_CONVERSION (&coding
))
3174 int same_at_start
= BEGV
;
3175 int same_at_end
= ZV
;
3177 /* There is still a possibility we will find the need to do code
3178 conversion. If that happens, we set this variable to 1 to
3179 give up on handling REPLACE in the optimized way. */
3180 int giveup_match_end
= 0;
3182 if (XINT (beg
) != 0)
3184 if (lseek (fd
, XINT (beg
), 0) < 0)
3185 report_file_error ("Setting file position",
3186 Fcons (filename
, Qnil
));
3191 /* Count how many chars at the start of the file
3192 match the text at the beginning of the buffer. */
3197 nread
= read (fd
, buffer
, sizeof buffer
);
3199 error ("IO error reading %s: %s",
3200 XSTRING (filename
)->data
, strerror (errno
));
3201 else if (nread
== 0)
3204 if (coding
.type
== coding_type_undecided
)
3205 detect_coding (&coding
, buffer
, nread
);
3206 if (coding
.type
!= coding_type_undecided
3207 && coding
.type
!= coding_type_no_conversion
3208 && coding
.type
!= coding_type_emacs_mule
)
3209 /* We found that the file should be decoded somehow.
3210 Let's give up here. */
3212 giveup_match_end
= 1;
3216 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3217 detect_eol (&coding
, buffer
, nread
);
3218 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3219 && coding
.eol_type
!= CODING_EOL_LF
)
3220 /* We found that the format of eol should be decoded.
3221 Let's give up here. */
3223 giveup_match_end
= 1;
3228 while (bufpos
< nread
&& same_at_start
< ZV
3229 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3230 same_at_start
++, bufpos
++;
3231 /* If we found a discrepancy, stop the scan.
3232 Otherwise loop around and scan the next bufferful. */
3233 if (bufpos
!= nread
)
3237 /* If the file matches the buffer completely,
3238 there's no need to replace anything. */
3239 if (same_at_start
- BEGV
== XINT (end
))
3243 /* Truncate the buffer to the size of the file. */
3244 del_range_1 (same_at_start
, same_at_end
, 0);
3249 /* Count how many chars at the end of the file
3250 match the text at the end of the buffer. But, if we have
3251 already found that decoding is necessary, don't waste time. */
3252 while (!giveup_match_end
)
3254 int total_read
, nread
, bufpos
, curpos
, trial
;
3256 /* At what file position are we now scanning? */
3257 curpos
= XINT (end
) - (ZV
- same_at_end
);
3258 /* If the entire file matches the buffer tail, stop the scan. */
3261 /* How much can we scan in the next step? */
3262 trial
= min (curpos
, sizeof buffer
);
3263 if (lseek (fd
, curpos
- trial
, 0) < 0)
3264 report_file_error ("Setting file position",
3265 Fcons (filename
, Qnil
));
3268 while (total_read
< trial
)
3270 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
3272 error ("IO error reading %s: %s",
3273 XSTRING (filename
)->data
, strerror (errno
));
3274 total_read
+= nread
;
3276 /* Scan this bufferful from the end, comparing with
3277 the Emacs buffer. */
3278 bufpos
= total_read
;
3279 /* Compare with same_at_start to avoid counting some buffer text
3280 as matching both at the file's beginning and at the end. */
3281 while (bufpos
> 0 && same_at_end
> same_at_start
3282 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3283 same_at_end
--, bufpos
--;
3285 /* If we found a discrepancy, stop the scan.
3286 Otherwise loop around and scan the preceding bufferful. */
3289 /* If this discrepancy is because of code conversion,
3290 we cannot use this method; giveup and try the other. */
3291 if (same_at_end
> same_at_start
3292 && FETCH_BYTE (same_at_end
- 1) >= 0200
3293 && ! NILP (current_buffer
->enable_multibyte_characters
)
3294 && ! CODING_REQUIRE_NO_CONVERSION (&coding
))
3295 giveup_match_end
= 1;
3301 if (! giveup_match_end
)
3303 /* We win! We can handle REPLACE the optimized way. */
3305 /* Extends the end of non-matching text area to multibyte
3306 character boundary. */
3307 if (! NILP (current_buffer
->enable_multibyte_characters
))
3308 while (same_at_end
< ZV
&& ! CHAR_HEAD_P (POS_ADDR (same_at_end
)))
3311 /* Don't try to reuse the same piece of text twice. */
3312 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
3314 same_at_end
+= overlap
;
3316 /* Arrange to read only the nonmatching middle part of the file. */
3317 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV
));
3318 XSETFASTINT (end
, XINT (end
) - (ZV
- same_at_end
));
3320 del_range_1 (same_at_start
, same_at_end
, 0);
3321 /* Insert from the file at the proper position. */
3322 SET_PT (same_at_start
);
3324 /* If display currently starts at beginning of line,
3325 keep it that way. */
3326 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3327 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3329 replace_handled
= 1;
3333 /* If requested, replace the accessible part of the buffer
3334 with the file contents. Avoid replacing text at the
3335 beginning or end of the buffer that matches the file contents;
3336 that preserves markers pointing to the unchanged parts.
3338 Here we implement this feature for the case where code conversion
3339 is needed, in a simple way that needs a lot of memory.
3340 The preceding if-statement handles the case of no conversion
3341 in a more optimized way. */
3342 if (!NILP (replace
) && ! replace_handled
)
3344 int same_at_start
= BEGV
;
3345 int same_at_end
= ZV
;
3348 /* Make sure that the gap is large enough. */
3349 int bufsize
= 2 * st
.st_size
;
3350 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
3352 /* First read the whole file, performing code conversion into
3353 CONVERSION_BUFFER. */
3355 if (lseek (fd
, XINT (beg
), 0) < 0)
3357 free (conversion_buffer
);
3358 report_file_error ("Setting file position",
3359 Fcons (filename
, Qnil
));
3362 total
= st
.st_size
; /* Total bytes in the file. */
3363 how_much
= 0; /* Bytes read from file so far. */
3364 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3365 unprocessed
= 0; /* Bytes not processed in previous loop. */
3367 while (how_much
< total
)
3369 /* try is reserved in some compilers (Microsoft C) */
3370 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3371 char *destination
= read_buf
+ unprocessed
;
3374 /* Allow quitting out of the actual I/O. */
3377 this = read (fd
, destination
, trytry
);
3380 if (this < 0 || this + unprocessed
== 0)
3388 if (! CODING_REQUIRE_NO_CONVERSION (&coding
))
3390 int require
, produced
, consumed
;
3392 this += unprocessed
;
3394 /* If we are using more space than estimated,
3395 make CONVERSION_BUFFER bigger. */
3396 require
= decoding_buffer_size (&coding
, this);
3397 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
3399 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
3400 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
3403 /* Convert this batch with results in CONVERSION_BUFFER. */
3404 if (how_much
>= total
) /* This is the last block. */
3405 coding
.last_block
= 1;
3406 produced
= decode_coding (&coding
, read_buf
,
3407 conversion_buffer
+ inserted
,
3408 this, bufsize
- inserted
,
3411 /* Save for next iteration whatever we didn't convert. */
3412 unprocessed
= this - consumed
;
3413 bcopy (read_buf
+ consumed
, read_buf
, unprocessed
);
3420 /* At this point, INSERTED is how many characters
3421 are present in CONVERSION_BUFFER.
3422 HOW_MUCH should equal TOTAL,
3423 or should be <= 0 if we couldn't read the file. */
3427 free (conversion_buffer
);
3430 error ("IO error reading %s: %s",
3431 XSTRING (filename
)->data
, strerror (errno
));
3432 else if (how_much
== -2)
3433 error ("maximum buffer size exceeded");
3436 /* Compare the beginning of the converted file
3437 with the buffer text. */
3440 while (bufpos
< inserted
&& same_at_start
< same_at_end
3441 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
3442 same_at_start
++, bufpos
++;
3444 /* If the file matches the buffer completely,
3445 there's no need to replace anything. */
3447 if (bufpos
== inserted
)
3449 free (conversion_buffer
);
3452 /* Truncate the buffer to the size of the file. */
3453 del_range_1 (same_at_start
, same_at_end
, 0);
3457 /* Scan this bufferful from the end, comparing with
3458 the Emacs buffer. */
3461 /* Compare with same_at_start to avoid counting some buffer text
3462 as matching both at the file's beginning and at the end. */
3463 while (bufpos
> 0 && same_at_end
> same_at_start
3464 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
3465 same_at_end
--, bufpos
--;
3467 /* Don't try to reuse the same piece of text twice. */
3468 overlap
= same_at_start
- BEGV
- (same_at_end
+ inserted
- ZV
);
3470 same_at_end
+= overlap
;
3472 /* If display currently starts at beginning of line,
3473 keep it that way. */
3474 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3475 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3477 /* Replace the chars that we need to replace,
3478 and update INSERTED to equal the number of bytes
3479 we are taking from the file. */
3480 inserted
-= (Z
- same_at_end
) + (same_at_start
- BEG
);
3481 move_gap (same_at_start
);
3482 del_range_1 (same_at_start
, same_at_end
, 0);
3483 SET_PT (same_at_start
);
3484 insert_1 (conversion_buffer
+ same_at_start
- BEG
, inserted
, 0, 0);
3486 free (conversion_buffer
);
3495 register Lisp_Object temp
;
3497 total
= XINT (end
) - XINT (beg
);
3499 /* Make sure point-max won't overflow after this insertion. */
3500 XSETINT (temp
, total
);
3501 if (total
!= XINT (temp
))
3502 error ("Maximum buffer size exceeded");
3505 /* For a special file, all we can do is guess. */
3506 total
= READ_BUF_SIZE
;
3508 if (NILP (visit
) && total
> 0)
3509 prepare_to_modify_buffer (PT
, PT
, NULL
);
3512 if (GAP_SIZE
< total
)
3513 make_gap (total
- GAP_SIZE
);
3515 if (XINT (beg
) != 0 || !NILP (replace
))
3517 if (lseek (fd
, XINT (beg
), 0) < 0)
3518 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
3521 /* In the following loop, HOW_MUCH contains the total bytes read so
3522 far. Before exiting the loop, it is set to -1 if I/O error
3523 occurs, set to -2 if the maximum buffer size is exceeded. */
3525 /* Total bytes inserted. */
3527 /* Bytes not processed in the previous loop because short gap size. */
3529 while (how_much
< total
)
3531 /* try is reserved in some compilers (Microsoft C) */
3532 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3533 char *destination
= (CODING_REQUIRE_NO_CONVERSION (&coding
)
3534 ? (char *) (POS_ADDR (PT
+ inserted
- 1) + 1)
3535 : read_buf
+ unprocessed
);
3538 /* Allow quitting out of the actual I/O. */
3541 this = read (fd
, destination
, trytry
);
3544 if (this < 0 || this + unprocessed
== 0)
3550 /* For a regular file, where TOTAL is the real size,
3551 count HOW_MUCH to compare with it.
3552 For a special file, where TOTAL is just a buffer size,
3553 so don't bother counting in HOW_MUCH.
3554 (INSERTED is where we count the number of characters inserted.) */
3558 if (! CODING_REQUIRE_NO_CONVERSION (&coding
))
3560 int require
, produced
, consumed
;
3562 this += unprocessed
;
3563 /* Make sure that the gap is large enough. */
3564 require
= decoding_buffer_size (&coding
, this);
3565 if (GAP_SIZE
< require
)
3566 make_gap (require
- GAP_SIZE
);
3570 if (how_much
>= total
) /* This is the last block. */
3571 coding
.last_block
= 1;
3575 /* If we encounter EOF, say it is the last block. (The
3576 data this will apply to is the UNPROCESSED characters
3577 carried over from the last batch.) */
3579 coding
.last_block
= 1;
3582 produced
= decode_coding (&coding
, read_buf
,
3583 POS_ADDR (PT
+ inserted
- 1) + 1,
3584 this, GAP_SIZE
, &consumed
);
3589 XSET (temp
, Lisp_Int
, Z
+ produced
);
3590 if (Z
+ produced
!= XINT (temp
))
3596 unprocessed
= this - consumed
;
3597 bcopy (read_buf
+ consumed
, read_buf
, unprocessed
);
3606 /* Put an anchor to ensure multi-byte form ends at gap. */
3613 /* Use the conversion type to determine buffer-file-type
3614 (find-buffer-file-type is now used to help determine the
3616 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3617 && coding
.eol_type
!= CODING_EOL_LF
)
3618 current_buffer
->buffer_file_type
= Qnil
;
3620 current_buffer
->buffer_file_type
= Qt
;
3623 /* We don't have to consider file type of MSDOS because all files
3624 are read as binary and end-of-line format has already been
3625 decoded appropriately. */
3628 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
3629 /* Determine file type from name and remove LFs from CR-LFs if the file
3630 is deemed to be a text file. */
3632 current_buffer
->buffer_file_type
3633 = call1 (Qfind_buffer_file_type
, filename
);
3634 if (NILP (current_buffer
->buffer_file_type
))
3637 = inserted
- crlf_to_lf (inserted
, POS_ADDR (PT
- 1) + 1);
3640 GPT
-= reduced_size
;
3641 GAP_SIZE
+= reduced_size
;
3642 inserted
-= reduced_size
;
3650 record_insert (PT
, inserted
);
3652 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
3653 offset_intervals (current_buffer
, PT
, inserted
);
3659 /* Discard the unwind protect for closing the file. */
3663 error ("IO error reading %s: %s",
3664 XSTRING (filename
)->data
, strerror (errno
));
3665 else if (how_much
== -2)
3666 error ("maximum buffer size exceeded");
3673 if (!EQ (current_buffer
->undo_list
, Qt
))
3674 current_buffer
->undo_list
= Qnil
;
3676 stat (XSTRING (filename
)->data
, &st
);
3681 current_buffer
->modtime
= st
.st_mtime
;
3682 current_buffer
->filename
= filename
;
3685 SAVE_MODIFF
= MODIFF
;
3686 current_buffer
->auto_save_modified
= MODIFF
;
3687 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3688 #ifdef CLASH_DETECTION
3691 if (!NILP (current_buffer
->file_truename
))
3692 unlock_file (current_buffer
->file_truename
);
3693 unlock_file (filename
);
3695 #endif /* CLASH_DETECTION */
3697 Fsignal (Qfile_error
,
3698 Fcons (build_string ("not a regular file"),
3699 Fcons (filename
, Qnil
)));
3701 /* If visiting nonexistent file, return nil. */
3702 if (current_buffer
->modtime
== -1)
3703 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3706 /* Decode file format */
3709 insval
= call3 (Qformat_decode
,
3710 Qnil
, make_number (inserted
), visit
);
3711 CHECK_NUMBER (insval
, 0);
3712 inserted
= XFASTINT (insval
);
3715 /* Call after-change hooks for the inserted text, aside from the case
3716 of normal visiting (not with REPLACE), which is done in a new buffer
3717 "before" the buffer is changed. */
3718 if (inserted
> 0 && total
> 0
3719 && (NILP (visit
) || !NILP (replace
)))
3720 signal_after_change (PT
, 0, inserted
);
3724 p
= Vafter_insert_file_functions
;
3725 if (!NILP (coding
.post_read_conversion
))
3726 p
= Fcons (coding
.post_read_conversion
, p
);
3730 insval
= call1 (Fcar (p
), make_number (inserted
));
3733 CHECK_NUMBER (insval
, 0);
3734 inserted
= XFASTINT (insval
);
3742 val
= Fcons (filename
,
3743 Fcons (make_number (inserted
),
3746 RETURN_UNGCPRO (unbind_to (count
, val
));
3749 static Lisp_Object
build_annotations ();
3750 extern Lisp_Object
Ffile_locked_p ();
3752 /* If build_annotations switched buffers, switch back to BUF.
3753 Kill the temporary buffer that was selected in the meantime.
3755 Since this kill only the last temporary buffer, some buffers remain
3756 not killed if build_annotations switched buffers more than once.
3760 build_annotations_unwind (buf
)
3765 if (XBUFFER (buf
) == current_buffer
)
3767 tembuf
= Fcurrent_buffer ();
3769 Fkill_buffer (tembuf
);
3773 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 6,
3774 "r\nFWrite region to file: ",
3775 "Write current region into specified file.\n\
3776 When called from a program, takes three arguments:\n\
3777 START, END and FILENAME. START and END are buffer positions.\n\
3778 Optional fourth argument APPEND if non-nil means\n\
3779 append to existing file contents (if any).\n\
3780 Optional fifth argument VISIT if t means\n\
3781 set the last-save-file-modtime of buffer to this file's modtime\n\
3782 and mark buffer not modified.\n\
3783 If VISIT is a string, it is a second file name;\n\
3784 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
3785 VISIT is also the file name to lock and unlock for clash detection.\n\
3786 If VISIT is neither t nor nil nor a string,\n\
3787 that means do not print the \"Wrote file\" message.\n\
3788 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
3789 use for locking and unlocking, overriding FILENAME and VISIT.\n\
3790 Kludgy feature: if START is a string, then that string is written\n\
3791 to the file, instead of any buffer contents, and END is ignored.")
3792 (start
, end
, filename
, append
, visit
, lockname
)
3793 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
3801 int count
= specpdl_ptr
- specpdl
;
3804 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3806 Lisp_Object handler
;
3807 Lisp_Object visit_file
;
3808 Lisp_Object annotations
;
3809 int visiting
, quietly
;
3810 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3811 struct buffer
*given_buffer
;
3813 int buffer_file_type
= O_BINARY
;
3815 struct coding_system coding
;
3817 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3818 error ("Cannot do file visiting in an indirect buffer");
3820 if (!NILP (start
) && !STRINGP (start
))
3821 validate_region (&start
, &end
);
3823 GCPRO4 (start
, filename
, visit
, lockname
);
3825 /* Decide the coding-system to be encoded to. */
3831 else if (!NILP (Vcoding_system_for_write
))
3832 val
= Vcoding_system_for_write
;
3833 else if (NILP (current_buffer
->enable_multibyte_characters
))
3834 val
= (NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
))
3836 : Fsymbol_value (Qbuffer_file_coding_system
));
3839 Lisp_Object args
[7], coding_systems
;
3841 args
[0] = Qwrite_region
, args
[1] = start
, args
[2] = end
,
3842 args
[3] = filename
, args
[4] = append
, args
[5] = visit
,
3844 coding_systems
= Ffind_operation_coding_system (7, args
);
3845 val
= (CONSP (coding_systems
) && !NILP (XCONS (coding_systems
)->cdr
)
3846 ? XCONS (coding_systems
)->cdr
3847 : current_buffer
->buffer_file_coding_system
);
3849 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3850 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
3851 coding
.selective
= 1;
3854 filename
= Fexpand_file_name (filename
, Qnil
);
3855 if (STRINGP (visit
))
3856 visit_file
= Fexpand_file_name (visit
, Qnil
);
3858 visit_file
= filename
;
3861 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
3862 quietly
= !NILP (visit
);
3866 if (NILP (lockname
))
3867 lockname
= visit_file
;
3869 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
3871 /* If the file name has special constructs in it,
3872 call the corresponding file handler. */
3873 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
3874 /* If FILENAME has no handler, see if VISIT has one. */
3875 if (NILP (handler
) && STRINGP (visit
))
3876 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
3878 if (!NILP (handler
))
3881 val
= call6 (handler
, Qwrite_region
, start
, end
,
3882 filename
, append
, visit
);
3886 SAVE_MODIFF
= MODIFF
;
3887 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3888 current_buffer
->filename
= visit_file
;
3894 /* Special kludge to simplify auto-saving. */
3897 XSETFASTINT (start
, BEG
);
3898 XSETFASTINT (end
, Z
);
3901 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
3902 count1
= specpdl_ptr
- specpdl
;
3904 given_buffer
= current_buffer
;
3905 annotations
= build_annotations (start
, end
, coding
.pre_write_conversion
);
3906 if (current_buffer
!= given_buffer
)
3908 XSETFASTINT (start
, BEGV
);
3909 XSETFASTINT (end
, ZV
);
3912 #ifdef CLASH_DETECTION
3915 #if 0 /* This causes trouble for GNUS. */
3916 /* If we've locked this file for some other buffer,
3917 query before proceeding. */
3918 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
3919 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
3922 lock_file (lockname
);
3924 #endif /* CLASH_DETECTION */
3926 fn
= XSTRING (filename
)->data
;
3930 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
3931 #else /* not DOS_NT */
3932 desc
= open (fn
, O_WRONLY
);
3933 #endif /* not DOS_NT */
3935 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
) )
3937 if (auto_saving
) /* Overwrite any previous version of autosave file */
3939 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3940 desc
= open (fn
, O_RDWR
);
3942 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3943 ? XSTRING (current_buffer
->filename
)->data
: 0,
3946 else /* Write to temporary name and rename if no errors */
3948 Lisp_Object temp_name
;
3949 temp_name
= Ffile_name_directory (filename
);
3951 if (!NILP (temp_name
))
3953 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3954 build_string ("$$SAVE$$")));
3955 fname
= XSTRING (filename
)->data
;
3956 fn
= XSTRING (temp_name
)->data
;
3957 desc
= creat_copy_attrs (fname
, fn
);
3960 /* If we can't open the temporary file, try creating a new
3961 version of the original file. VMS "creat" creates a
3962 new version rather than truncating an existing file. */
3965 desc
= creat (fn
, 0666);
3966 #if 0 /* This can clobber an existing file and fail to replace it,
3967 if the user runs out of space. */
3970 /* We can't make a new version;
3971 try to truncate and rewrite existing version if any. */
3973 desc
= open (fn
, O_RDWR
);
3979 desc
= creat (fn
, 0666);
3984 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3985 S_IREAD
| S_IWRITE
);
3986 #else /* not DOS_NT */
3987 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3988 #endif /* not DOS_NT */
3989 #endif /* not VMS */
3995 #ifdef CLASH_DETECTION
3997 if (!auto_saving
) unlock_file (lockname
);
3999 #endif /* CLASH_DETECTION */
4000 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4003 record_unwind_protect (close_file_unwind
, make_number (desc
));
4006 if (lseek (desc
, 0, 2) < 0)
4008 #ifdef CLASH_DETECTION
4009 if (!auto_saving
) unlock_file (lockname
);
4010 #endif /* CLASH_DETECTION */
4011 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4016 * Kludge Warning: The VMS C RTL likes to insert carriage returns
4017 * if we do writes that don't end with a carriage return. Furthermore
4018 * it cannot handle writes of more then 16K. The modified
4019 * version of "sys_write" in SYSDEP.C (see comment there) copes with
4020 * this EXCEPT for the last record (iff it doesn't end with a carriage
4021 * return). This implies that if your buffer doesn't end with a carriage
4022 * return, you get one free... tough. However it also means that if
4023 * we make two calls to sys_write (a la the following code) you can
4024 * get one at the gap as well. The easiest way to fix this (honest)
4025 * is to move the gap to the next newline (or the end of the buffer).
4030 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4031 move_gap (find_next_newline (GPT
, 1));
4033 /* Whether VMS or not, we must move the gap to the next of newline
4034 when we must put designation sequences at beginning of line. */
4035 if (INTEGERP (start
)
4036 && coding
.type
== coding_type_iso2022
4037 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
4038 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4039 move_gap (find_next_newline (GPT
, 1));
4045 if (STRINGP (start
))
4047 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
4048 XSTRING (start
)->size
, 0, &annotations
, &coding
);
4051 else if (XINT (start
) != XINT (end
))
4054 if (XINT (start
) < GPT
)
4056 register int end1
= XINT (end
);
4058 failure
= 0 > a_write (desc
, POS_ADDR (tem
),
4059 min (GPT
, end1
) - tem
, tem
, &annotations
,
4061 nwritten
+= min (GPT
, end1
) - tem
;
4065 if (XINT (end
) > GPT
&& !failure
)
4068 tem
= max (tem
, GPT
);
4069 failure
= 0 > a_write (desc
, POS_ADDR (tem
), XINT (end
) - tem
,
4070 tem
, &annotations
, &coding
);
4071 nwritten
+= XINT (end
) - tem
;
4077 /* If file was empty, still need to write the annotations */
4078 coding
.last_block
= 1;
4079 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
, &coding
);
4083 if (coding
.require_flushing
&& !coding
.last_block
)
4085 /* We have to flush out a data. */
4086 coding
.last_block
= 1;
4087 failure
= 0 > e_write (desc
, "", 0, &coding
);
4094 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4095 Disk full in NFS may be reported here. */
4096 /* mib says that closing the file will try to write as fast as NFS can do
4097 it, and that means the fsync here is not crucial for autosave files. */
4098 if (!auto_saving
&& fsync (desc
) < 0)
4100 /* If fsync fails with EINTR, don't treat that as serious. */
4102 failure
= 1, save_errno
= errno
;
4106 /* Spurious "file has changed on disk" warnings have been
4107 observed on Suns as well.
4108 It seems that `close' can change the modtime, under nfs.
4110 (This has supposedly been fixed in Sunos 4,
4111 but who knows about all the other machines with NFS?) */
4114 /* On VMS and APOLLO, must do the stat after the close
4115 since closing changes the modtime. */
4118 /* Recall that #if defined does not work on VMS. */
4125 /* NFS can report a write failure now. */
4126 if (close (desc
) < 0)
4127 failure
= 1, save_errno
= errno
;
4130 /* If we wrote to a temporary name and had no errors, rename to real name. */
4134 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
4142 /* Discard the unwind protect for close_file_unwind. */
4143 specpdl_ptr
= specpdl
+ count1
;
4144 /* Restore the original current buffer. */
4145 visit_file
= unbind_to (count
, visit_file
);
4147 #ifdef CLASH_DETECTION
4149 unlock_file (lockname
);
4150 #endif /* CLASH_DETECTION */
4152 /* Do this before reporting IO error
4153 to avoid a "file has changed on disk" warning on
4154 next attempt to save. */
4156 current_buffer
->modtime
= st
.st_mtime
;
4159 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
4163 SAVE_MODIFF
= MODIFF
;
4164 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4165 current_buffer
->filename
= visit_file
;
4166 update_mode_lines
++;
4172 message ("Wrote %s", XSTRING (visit_file
)->data
);
4177 Lisp_Object
merge ();
4179 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4180 "Return t if (car A) is numerically less than (car B).")
4184 return Flss (Fcar (a
), Fcar (b
));
4187 /* Build the complete list of annotations appropriate for writing out
4188 the text between START and END, by calling all the functions in
4189 write-region-annotate-functions and merging the lists they return.
4190 If one of these functions switches to a different buffer, we assume
4191 that buffer contains altered text. Therefore, the caller must
4192 make sure to restore the current buffer in all cases,
4193 as save-excursion would do. */
4196 build_annotations (start
, end
, pre_write_conversion
)
4197 Lisp_Object start
, end
, pre_write_conversion
;
4199 Lisp_Object annotations
;
4201 struct gcpro gcpro1
, gcpro2
;
4202 Lisp_Object original_buffer
;
4204 XSETBUFFER (original_buffer
, current_buffer
);
4207 p
= Vwrite_region_annotate_functions
;
4208 GCPRO2 (annotations
, p
);
4211 struct buffer
*given_buffer
= current_buffer
;
4212 Vwrite_region_annotations_so_far
= annotations
;
4213 res
= call2 (Fcar (p
), start
, end
);
4214 /* If the function makes a different buffer current,
4215 assume that means this buffer contains altered text to be output.
4216 Reset START and END from the buffer bounds
4217 and discard all previous annotations because they should have
4218 been dealt with by this function. */
4219 if (current_buffer
!= given_buffer
)
4221 XSETFASTINT (start
, BEGV
);
4222 XSETFASTINT (end
, ZV
);
4225 Flength (res
); /* Check basic validity of return value */
4226 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4230 /* Now do the same for annotation functions implied by the file-format */
4231 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
4232 p
= Vauto_save_file_format
;
4234 p
= current_buffer
->file_format
;
4237 struct buffer
*given_buffer
= current_buffer
;
4238 Vwrite_region_annotations_so_far
= annotations
;
4239 res
= call4 (Qformat_annotate_function
, Fcar (p
), start
, end
,
4241 if (current_buffer
!= given_buffer
)
4243 XSETFASTINT (start
, BEGV
);
4244 XSETFASTINT (end
, ZV
);
4248 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4252 /* At last, do the same for the function PRE_WRITE_CONVERSION
4253 implied by the current coding-system. */
4254 if (!NILP (pre_write_conversion
))
4256 struct buffer
*given_buffer
= current_buffer
;
4257 Vwrite_region_annotations_so_far
= annotations
;
4258 res
= call2 (pre_write_conversion
, start
, end
);
4260 annotations
= (current_buffer
!= given_buffer
4262 : merge (annotations
, res
, Qcar_less_than_car
));
4269 /* Write to descriptor DESC the LEN characters starting at ADDR,
4270 assuming they start at position POS in the buffer.
4271 Intersperse with them the annotations from *ANNOT
4272 (those which fall within the range of positions POS to POS + LEN),
4273 each at its appropriate position.
4275 Modify *ANNOT by discarding elements as we output them.
4276 The return value is negative in case of system call failure. */
4279 a_write (desc
, addr
, len
, pos
, annot
, coding
)
4281 register char *addr
;
4285 struct coding_system
*coding
;
4289 int lastpos
= pos
+ len
;
4291 while (NILP (*annot
) || CONSP (*annot
))
4293 tem
= Fcar_safe (Fcar (*annot
));
4294 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
4295 nextpos
= XFASTINT (tem
);
4297 return e_write (desc
, addr
, lastpos
- pos
, coding
);
4300 if (0 > e_write (desc
, addr
, nextpos
- pos
, coding
))
4302 addr
+= nextpos
- pos
;
4305 tem
= Fcdr (Fcar (*annot
));
4308 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
,
4312 *annot
= Fcdr (*annot
);
4316 #ifndef WRITE_BUF_SIZE
4317 #define WRITE_BUF_SIZE (16 * 1024)
4321 e_write (desc
, addr
, len
, coding
)
4323 register char *addr
;
4325 struct coding_system
*coding
;
4327 char buf
[WRITE_BUF_SIZE
];
4328 int produced
, consumed
;
4330 /* We used to have a code for handling selective display here. But,
4331 now it is handled within encode_coding. */
4334 produced
= encode_coding (coding
, addr
, buf
, len
, WRITE_BUF_SIZE
,
4336 len
-= consumed
, addr
+= consumed
;
4339 produced
-= write (desc
, buf
, produced
);
4340 if (produced
) return -1;
4348 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
4349 Sverify_visited_file_modtime
, 1, 1, 0,
4350 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
4351 This means that the file has not been changed since it was visited or saved.")
4357 Lisp_Object handler
;
4359 CHECK_BUFFER (buf
, 0);
4362 if (!STRINGP (b
->filename
)) return Qt
;
4363 if (b
->modtime
== 0) return Qt
;
4365 /* If the file name has special constructs in it,
4366 call the corresponding file handler. */
4367 handler
= Ffind_file_name_handler (b
->filename
,
4368 Qverify_visited_file_modtime
);
4369 if (!NILP (handler
))
4370 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
4372 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
4374 /* If the file doesn't exist now and didn't exist before,
4375 we say that it isn't modified, provided the error is a tame one. */
4376 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
4381 if (st
.st_mtime
== b
->modtime
4382 /* If both are positive, accept them if they are off by one second. */
4383 || (st
.st_mtime
> 0 && b
->modtime
> 0
4384 && (st
.st_mtime
== b
->modtime
+ 1
4385 || st
.st_mtime
== b
->modtime
- 1)))
4390 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
4391 Sclear_visited_file_modtime
, 0, 0, 0,
4392 "Clear out records of last mod time of visited file.\n\
4393 Next attempt to save will certainly not complain of a discrepancy.")
4396 current_buffer
->modtime
= 0;
4400 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
4401 Svisited_file_modtime
, 0, 0, 0,
4402 "Return the current buffer's recorded visited file modification time.\n\
4403 The value is a list of the form (HIGH . LOW), like the time values\n\
4404 that `file-attributes' returns.")
4407 return long_to_cons ((unsigned long) current_buffer
->modtime
);
4410 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
4411 Sset_visited_file_modtime
, 0, 1, 0,
4412 "Update buffer's recorded modification time from the visited file's time.\n\
4413 Useful if the buffer was not read from the file normally\n\
4414 or if the file itself has been changed for some known benign reason.\n\
4415 An argument specifies the modification time value to use\n\
4416 \(instead of that of the visited file), in the form of a list\n\
4417 \(HIGH . LOW) or (HIGH LOW).")
4419 Lisp_Object time_list
;
4421 if (!NILP (time_list
))
4422 current_buffer
->modtime
= cons_to_long (time_list
);
4425 register Lisp_Object filename
;
4427 Lisp_Object handler
;
4429 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
4431 /* If the file name has special constructs in it,
4432 call the corresponding file handler. */
4433 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
4434 if (!NILP (handler
))
4435 /* The handler can find the file name the same way we did. */
4436 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
4437 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
4438 current_buffer
->modtime
= st
.st_mtime
;
4448 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
4449 Fsleep_for (make_number (1), Qnil
);
4450 message ("Autosaving...error!for %s", XSTRING (current_buffer
->name
)->data
);
4451 Fsleep_for (make_number (1), Qnil
);
4452 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
4453 Fsleep_for (make_number (1), Qnil
);
4463 /* Get visited file's mode to become the auto save file's mode. */
4464 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
4465 /* But make sure we can overwrite it later! */
4466 auto_save_mode_bits
= st
.st_mode
| 0600;
4468 auto_save_mode_bits
= 0666;
4471 Fwrite_region (Qnil
, Qnil
,
4472 current_buffer
->auto_save_file_name
,
4473 Qnil
, Qlambda
, Qnil
);
4477 do_auto_save_unwind (stream
) /* used as unwind-protect function */
4482 fclose ((FILE *) (XFASTINT (XCONS (stream
)->car
) << 16
4483 | XFASTINT (XCONS (stream
)->cdr
)));
4488 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
4491 minibuffer_auto_raise
= XINT (value
);
4495 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
4496 "Auto-save all buffers that need it.\n\
4497 This is all buffers that have auto-saving enabled\n\
4498 and are changed since last auto-saved.\n\
4499 Auto-saving writes the buffer into a file\n\
4500 so that your editing is not lost if the system crashes.\n\
4501 This file is not the file you visited; that changes only when you save.\n\
4502 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
4503 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
4504 A non-nil CURRENT-ONLY argument means save only current buffer.")
4505 (no_message
, current_only
)
4506 Lisp_Object no_message
, current_only
;
4508 struct buffer
*old
= current_buffer
, *b
;
4509 Lisp_Object tail
, buf
;
4511 char *omessage
= echo_area_glyphs
;
4512 int omessage_length
= echo_area_glyphs_length
;
4513 int do_handled_files
;
4516 Lisp_Object lispstream
;
4517 int count
= specpdl_ptr
- specpdl
;
4519 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
4521 /* Ordinarily don't quit within this function,
4522 but don't make it impossible to quit (in case we get hung in I/O). */
4526 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
4527 point to non-strings reached from Vbuffer_alist. */
4532 if (!NILP (Vrun_hooks
))
4533 call1 (Vrun_hooks
, intern ("auto-save-hook"));
4535 if (STRINGP (Vauto_save_list_file_name
))
4537 Lisp_Object listfile
;
4538 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
4539 stream
= fopen (XSTRING (listfile
)->data
, "w");
4542 /* Arrange to close that file whether or not we get an error.
4543 Also reset auto_saving to 0. */
4544 lispstream
= Fcons (Qnil
, Qnil
);
4545 XSETFASTINT (XCONS (lispstream
)->car
, (EMACS_UINT
)stream
>> 16);
4546 XSETFASTINT (XCONS (lispstream
)->cdr
, (EMACS_UINT
)stream
& 0xffff);
4557 record_unwind_protect (do_auto_save_unwind
, lispstream
);
4558 record_unwind_protect (do_auto_save_unwind_1
,
4559 make_number (minibuffer_auto_raise
));
4560 minibuffer_auto_raise
= 0;
4563 /* First, save all files which don't have handlers. If Emacs is
4564 crashing, the handlers may tweak what is causing Emacs to crash
4565 in the first place, and it would be a shame if Emacs failed to
4566 autosave perfectly ordinary files because it couldn't handle some
4568 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
4569 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
4571 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
4574 /* Record all the buffers that have auto save mode
4575 in the special file that lists them. For each of these buffers,
4576 Record visited name (if any) and auto save name. */
4577 if (STRINGP (b
->auto_save_file_name
)
4578 && stream
!= NULL
&& do_handled_files
== 0)
4580 if (!NILP (b
->filename
))
4582 fwrite (XSTRING (b
->filename
)->data
, 1,
4583 XSTRING (b
->filename
)->size
, stream
);
4585 putc ('\n', stream
);
4586 fwrite (XSTRING (b
->auto_save_file_name
)->data
, 1,
4587 XSTRING (b
->auto_save_file_name
)->size
, stream
);
4588 putc ('\n', stream
);
4591 if (!NILP (current_only
)
4592 && b
!= current_buffer
)
4595 /* Don't auto-save indirect buffers.
4596 The base buffer takes care of it. */
4600 /* Check for auto save enabled
4601 and file changed since last auto save
4602 and file changed since last real save. */
4603 if (STRINGP (b
->auto_save_file_name
)
4604 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
4605 && b
->auto_save_modified
< BUF_MODIFF (b
)
4606 /* -1 means we've turned off autosaving for a while--see below. */
4607 && XINT (b
->save_length
) >= 0
4608 && (do_handled_files
4609 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
4612 EMACS_TIME before_time
, after_time
;
4614 EMACS_GET_TIME (before_time
);
4616 /* If we had a failure, don't try again for 20 minutes. */
4617 if (b
->auto_save_failure_time
>= 0
4618 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
4621 if ((XFASTINT (b
->save_length
) * 10
4622 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
4623 /* A short file is likely to change a large fraction;
4624 spare the user annoying messages. */
4625 && XFASTINT (b
->save_length
) > 5000
4626 /* These messages are frequent and annoying for `*mail*'. */
4627 && !EQ (b
->filename
, Qnil
)
4628 && NILP (no_message
))
4630 /* It has shrunk too much; turn off auto-saving here. */
4631 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
4632 message ("Buffer %s has shrunk a lot; auto save turned off there",
4633 XSTRING (b
->name
)->data
);
4634 minibuffer_auto_raise
= 0;
4635 /* Turn off auto-saving until there's a real save,
4636 and prevent any more warnings. */
4637 XSETINT (b
->save_length
, -1);
4638 Fsleep_for (make_number (1), Qnil
);
4641 set_buffer_internal (b
);
4642 if (!auto_saved
&& NILP (no_message
))
4643 message1 ("Auto-saving...");
4644 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
4646 b
->auto_save_modified
= BUF_MODIFF (b
);
4647 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4648 set_buffer_internal (old
);
4650 EMACS_GET_TIME (after_time
);
4652 /* If auto-save took more than 60 seconds,
4653 assume it was an NFS failure that got a timeout. */
4654 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
4655 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
4659 /* Prevent another auto save till enough input events come in. */
4660 record_auto_save ();
4662 if (auto_saved
&& NILP (no_message
))
4666 sit_for (1, 0, 0, 0, 0);
4667 message2 (omessage
, omessage_length
);
4670 message1 ("Auto-saving...done");
4675 unbind_to (count
, Qnil
);
4679 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
4680 Sset_buffer_auto_saved
, 0, 0, 0,
4681 "Mark current buffer as auto-saved with its current text.\n\
4682 No auto-save file will be written until the buffer changes again.")
4685 current_buffer
->auto_save_modified
= MODIFF
;
4686 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4687 current_buffer
->auto_save_failure_time
= -1;
4691 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
4692 Sclear_buffer_auto_save_failure
, 0, 0, 0,
4693 "Clear any record of a recent auto-save failure in the current buffer.")
4696 current_buffer
->auto_save_failure_time
= -1;
4700 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
4702 "Return t if buffer has been auto-saved since last read in or saved.")
4705 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
4708 /* Reading and completing file names */
4709 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
4711 /* In the string VAL, change each $ to $$ and return the result. */
4714 double_dollars (val
)
4717 register unsigned char *old
, *new;
4721 osize
= XSTRING (val
)->size
;
4722 /* Quote "$" as "$$" to get it past substitute-in-file-name */
4723 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
4724 if (*old
++ == '$') count
++;
4727 old
= XSTRING (val
)->data
;
4728 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
4729 new = XSTRING (val
)->data
;
4730 for (n
= osize
; n
> 0; n
--)
4743 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
4745 "Internal subroutine for read-file-name. Do not call this.")
4746 (string
, dir
, action
)
4747 Lisp_Object string
, dir
, action
;
4748 /* action is nil for complete, t for return list of completions,
4749 lambda for verify final value */
4751 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
4753 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4755 CHECK_STRING (string
, 0);
4762 /* No need to protect ACTION--we only compare it with t and nil. */
4763 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
4765 if (XSTRING (string
)->size
== 0)
4767 if (EQ (action
, Qlambda
))
4775 orig_string
= string
;
4776 string
= Fsubstitute_in_file_name (string
);
4777 changed
= NILP (Fstring_equal (string
, orig_string
));
4778 name
= Ffile_name_nondirectory (string
);
4779 val
= Ffile_name_directory (string
);
4781 realdir
= Fexpand_file_name (val
, realdir
);
4786 specdir
= Ffile_name_directory (string
);
4787 val
= Ffile_name_completion (name
, realdir
);
4792 return double_dollars (string
);
4796 if (!NILP (specdir
))
4797 val
= concat2 (specdir
, val
);
4799 return double_dollars (val
);
4802 #endif /* not VMS */
4806 if (EQ (action
, Qt
))
4807 return Ffile_name_all_completions (name
, realdir
);
4808 /* Only other case actually used is ACTION = lambda */
4810 /* Supposedly this helps commands such as `cd' that read directory names,
4811 but can someone explain how it helps them? -- RMS */
4812 if (XSTRING (name
)->size
== 0)
4815 return Ffile_exists_p (string
);
4818 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4819 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
4820 Value is not expanded---you must call `expand-file-name' yourself.\n\
4821 Default name to DEFAULT-FILENAME if user enters a null string.\n\
4822 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
4823 except that if INITIAL is specified, that combined with DIR is used.)\n\
4824 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
4825 Non-nil and non-t means also require confirmation after completion.\n\
4826 Fifth arg INITIAL specifies text to start with.\n\
4827 DIR defaults to current buffer's directory default.")
4828 (prompt
, dir
, default_filename
, mustmatch
, initial
)
4829 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
4831 Lisp_Object val
, insdef
, insdef1
, tem
;
4832 struct gcpro gcpro1
, gcpro2
;
4833 register char *homedir
;
4837 dir
= current_buffer
->directory
;
4838 if (NILP (default_filename
))
4840 if (! NILP (initial
))
4841 default_filename
= Fexpand_file_name (initial
, dir
);
4843 default_filename
= current_buffer
->filename
;
4846 /* If dir starts with user's homedir, change that to ~. */
4847 homedir
= (char *) egetenv ("HOME");
4849 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
4850 CORRECT_DIR_SEPS (homedir
);
4854 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4855 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
4857 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4858 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4859 XSTRING (dir
)->data
[0] = '~';
4862 if (insert_default_directory
&& STRINGP (dir
))
4865 if (!NILP (initial
))
4867 Lisp_Object args
[2], pos
;
4871 insdef
= Fconcat (2, args
);
4872 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
4873 insdef1
= Fcons (double_dollars (insdef
), pos
);
4876 insdef1
= double_dollars (insdef
);
4878 else if (STRINGP (initial
))
4881 insdef1
= Fcons (double_dollars (insdef
), make_number (0));
4884 insdef
= Qnil
, insdef1
= Qnil
;
4887 count
= specpdl_ptr
- specpdl
;
4888 specbind (intern ("completion-ignore-case"), Qt
);
4891 GCPRO2 (insdef
, default_filename
);
4892 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4893 dir
, mustmatch
, insdef1
,
4894 Qfile_name_history
, default_filename
);
4895 /* If Fcompleting_read returned the default string itself
4896 (rather than a new string with the same contents),
4897 it has to mean that the user typed RET with the minibuffer empty.
4898 In that case, we really want to return ""
4899 so that commands such as set-visited-file-name can distinguish. */
4900 if (EQ (val
, default_filename
))
4901 val
= build_string ("");
4904 unbind_to (count
, Qnil
);
4909 error ("No file name specified");
4910 tem
= Fstring_equal (val
, insdef
);
4911 if (!NILP (tem
) && !NILP (default_filename
))
4912 return default_filename
;
4913 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
4915 if (!NILP (default_filename
))
4916 return default_filename
;
4918 error ("No default file name");
4920 return Fsubstitute_in_file_name (val
);
4923 #if 0 /* Old version */
4924 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4925 /* Don't confuse make-docfile by having two doc strings for this function.
4926 make-docfile does not pay attention to #if, for good reason! */
4928 (prompt
, dir
, defalt
, mustmatch
, initial
)
4929 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4931 Lisp_Object val
, insdef
, tem
;
4932 struct gcpro gcpro1
, gcpro2
;
4933 register char *homedir
;
4937 dir
= current_buffer
->directory
;
4939 defalt
= current_buffer
->filename
;
4941 /* If dir starts with user's homedir, change that to ~. */
4942 homedir
= (char *) egetenv ("HOME");
4945 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4946 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
4948 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4949 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4950 XSTRING (dir
)->data
[0] = '~';
4953 if (!NILP (initial
))
4955 else if (insert_default_directory
)
4958 insdef
= build_string ("");
4961 count
= specpdl_ptr
- specpdl
;
4962 specbind (intern ("completion-ignore-case"), Qt
);
4965 GCPRO2 (insdef
, defalt
);
4966 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4968 insert_default_directory
? insdef
: Qnil
,
4969 Qfile_name_history
, Qnil
);
4972 unbind_to (count
, Qnil
);
4977 error ("No file name specified");
4978 tem
= Fstring_equal (val
, insdef
);
4979 if (!NILP (tem
) && !NILP (defalt
))
4981 return Fsubstitute_in_file_name (val
);
4983 #endif /* Old version */
4987 Qexpand_file_name
= intern ("expand-file-name");
4988 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
4989 Qdirectory_file_name
= intern ("directory-file-name");
4990 Qfile_name_directory
= intern ("file-name-directory");
4991 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
4992 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
4993 Qfile_name_as_directory
= intern ("file-name-as-directory");
4994 Qcopy_file
= intern ("copy-file");
4995 Qmake_directory_internal
= intern ("make-directory-internal");
4996 Qdelete_directory
= intern ("delete-directory");
4997 Qdelete_file
= intern ("delete-file");
4998 Qrename_file
= intern ("rename-file");
4999 Qadd_name_to_file
= intern ("add-name-to-file");
5000 Qmake_symbolic_link
= intern ("make-symbolic-link");
5001 Qfile_exists_p
= intern ("file-exists-p");
5002 Qfile_executable_p
= intern ("file-executable-p");
5003 Qfile_readable_p
= intern ("file-readable-p");
5004 Qfile_writable_p
= intern ("file-writable-p");
5005 Qfile_symlink_p
= intern ("file-symlink-p");
5006 Qaccess_file
= intern ("access-file");
5007 Qfile_directory_p
= intern ("file-directory-p");
5008 Qfile_regular_p
= intern ("file-regular-p");
5009 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
5010 Qfile_modes
= intern ("file-modes");
5011 Qset_file_modes
= intern ("set-file-modes");
5012 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
5013 Qinsert_file_contents
= intern ("insert-file-contents");
5014 Qwrite_region
= intern ("write-region");
5015 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
5016 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
5018 staticpro (&Qexpand_file_name
);
5019 staticpro (&Qsubstitute_in_file_name
);
5020 staticpro (&Qdirectory_file_name
);
5021 staticpro (&Qfile_name_directory
);
5022 staticpro (&Qfile_name_nondirectory
);
5023 staticpro (&Qunhandled_file_name_directory
);
5024 staticpro (&Qfile_name_as_directory
);
5025 staticpro (&Qcopy_file
);
5026 staticpro (&Qmake_directory_internal
);
5027 staticpro (&Qdelete_directory
);
5028 staticpro (&Qdelete_file
);
5029 staticpro (&Qrename_file
);
5030 staticpro (&Qadd_name_to_file
);
5031 staticpro (&Qmake_symbolic_link
);
5032 staticpro (&Qfile_exists_p
);
5033 staticpro (&Qfile_executable_p
);
5034 staticpro (&Qfile_readable_p
);
5035 staticpro (&Qfile_writable_p
);
5036 staticpro (&Qaccess_file
);
5037 staticpro (&Qfile_symlink_p
);
5038 staticpro (&Qfile_directory_p
);
5039 staticpro (&Qfile_regular_p
);
5040 staticpro (&Qfile_accessible_directory_p
);
5041 staticpro (&Qfile_modes
);
5042 staticpro (&Qset_file_modes
);
5043 staticpro (&Qfile_newer_than_file_p
);
5044 staticpro (&Qinsert_file_contents
);
5045 staticpro (&Qwrite_region
);
5046 staticpro (&Qverify_visited_file_modtime
);
5047 staticpro (&Qset_visited_file_modtime
);
5049 Qfile_name_history
= intern ("file-name-history");
5050 Fset (Qfile_name_history
, Qnil
);
5051 staticpro (&Qfile_name_history
);
5053 Qfile_error
= intern ("file-error");
5054 staticpro (&Qfile_error
);
5055 Qfile_already_exists
= intern ("file-already-exists");
5056 staticpro (&Qfile_already_exists
);
5057 Qfile_date_error
= intern ("file-date-error");
5058 staticpro (&Qfile_date_error
);
5061 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
5062 staticpro (&Qfind_buffer_file_type
);
5065 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
5066 "*Format in which to write auto-save files.\n\
5067 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
5068 If it is t, which is the default, auto-save files are written in the\n\
5069 same format as a regular save would use.");
5070 Vauto_save_file_format
= Qt
;
5072 Qformat_decode
= intern ("format-decode");
5073 staticpro (&Qformat_decode
);
5074 Qformat_annotate_function
= intern ("format-annotate-function");
5075 staticpro (&Qformat_annotate_function
);
5077 Qcar_less_than_car
= intern ("car-less-than-car");
5078 staticpro (&Qcar_less_than_car
);
5080 Fput (Qfile_error
, Qerror_conditions
,
5081 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
5082 Fput (Qfile_error
, Qerror_message
,
5083 build_string ("File error"));
5085 Fput (Qfile_already_exists
, Qerror_conditions
,
5086 Fcons (Qfile_already_exists
,
5087 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5088 Fput (Qfile_already_exists
, Qerror_message
,
5089 build_string ("File already exists"));
5091 Fput (Qfile_date_error
, Qerror_conditions
,
5092 Fcons (Qfile_date_error
,
5093 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5094 Fput (Qfile_date_error
, Qerror_message
,
5095 build_string ("Cannot set file date"));
5097 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
5098 "*Non-nil means when reading a filename start with default dir in minibuffer.");
5099 insert_default_directory
= 1;
5101 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
5102 "*Non-nil means write new files with record format `stmlf'.\n\
5103 nil means use format `var'. This variable is meaningful only on VMS.");
5104 vms_stmlf_recfm
= 0;
5106 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
5107 "Directory separator character for built-in functions that return file names.\n\
5108 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
5109 This variable affects the built-in functions only on Windows,\n\
5110 on other platforms, it is initialized so that Lisp code can find out\n\
5111 what the normal separator is.");
5112 XSETFASTINT (Vdirectory_sep_char
, '/');
5114 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5115 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
5116 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
5119 The first argument given to HANDLER is the name of the I/O primitive\n\
5120 to be handled; the remaining arguments are the arguments that were\n\
5121 passed to that primitive. For example, if you do\n\
5122 (file-exists-p FILENAME)\n\
5123 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
5124 (funcall HANDLER 'file-exists-p FILENAME)\n\
5125 The function `find-file-name-handler' checks this list for a handler\n\
5126 for its argument.");
5127 Vfile_name_handler_alist
= Qnil
;
5129 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5130 "A list of functions to be called at the end of `insert-file-contents'.\n\
5131 Each is passed one argument, the number of bytes inserted. It should return\n\
5132 the new byte count, and leave point the same. If `insert-file-contents' is\n\
5133 intercepted by a handler from `file-name-handler-alist', that handler is\n\
5134 responsible for calling the after-insert-file-functions if appropriate.");
5135 Vafter_insert_file_functions
= Qnil
;
5137 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5138 "A list of functions to be called at the start of `write-region'.\n\
5139 Each is passed two arguments, START and END as for `write-region'.\n\
5140 These are usually two numbers but not always; see the documentation\n\
5141 for `write-region'. The function should return a list of pairs\n\
5142 of the form (POSITION . STRING), consisting of strings to be effectively\n\
5143 inserted at the specified positions of the file being written (1 means to\n\
5144 insert before the first byte written). The POSITIONs must be sorted into\n\
5145 increasing order. If there are several functions in the list, the several\n\
5146 lists are merged destructively.");
5147 Vwrite_region_annotate_functions
= Qnil
;
5149 DEFVAR_LISP ("write-region-annotations-so-far",
5150 &Vwrite_region_annotations_so_far
,
5151 "When an annotation function is called, this holds the previous annotations.\n\
5152 These are the annotations made by other annotation functions\n\
5153 that were already called. See also `write-region-annotate-functions'.");
5154 Vwrite_region_annotations_so_far
= Qnil
;
5156 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5157 "A list of file name handlers that temporarily should not be used.\n\
5158 This applies only to the operation `inhibit-file-name-operation'.");
5159 Vinhibit_file_name_handlers
= Qnil
;
5161 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5162 "The operation for which `inhibit-file-name-handlers' is applicable.");
5163 Vinhibit_file_name_operation
= Qnil
;
5165 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5166 "File name in which we write a list of all auto save file names.\n\
5167 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
5168 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
5170 Vauto_save_list_file_name
= Qnil
;
5172 defsubr (&Sfind_file_name_handler
);
5173 defsubr (&Sfile_name_directory
);
5174 defsubr (&Sfile_name_nondirectory
);
5175 defsubr (&Sunhandled_file_name_directory
);
5176 defsubr (&Sfile_name_as_directory
);
5177 defsubr (&Sdirectory_file_name
);
5178 defsubr (&Smake_temp_name
);
5179 defsubr (&Sexpand_file_name
);
5180 defsubr (&Ssubstitute_in_file_name
);
5181 defsubr (&Scopy_file
);
5182 defsubr (&Smake_directory_internal
);
5183 defsubr (&Sdelete_directory
);
5184 defsubr (&Sdelete_file
);
5185 defsubr (&Srename_file
);
5186 defsubr (&Sadd_name_to_file
);
5188 defsubr (&Smake_symbolic_link
);
5189 #endif /* S_IFLNK */
5191 defsubr (&Sdefine_logical_name
);
5194 defsubr (&Ssysnetunam
);
5195 #endif /* HPUX_NET */
5196 defsubr (&Sfile_name_absolute_p
);
5197 defsubr (&Sfile_exists_p
);
5198 defsubr (&Sfile_executable_p
);
5199 defsubr (&Sfile_readable_p
);
5200 defsubr (&Sfile_writable_p
);
5201 defsubr (&Saccess_file
);
5202 defsubr (&Sfile_symlink_p
);
5203 defsubr (&Sfile_directory_p
);
5204 defsubr (&Sfile_accessible_directory_p
);
5205 defsubr (&Sfile_regular_p
);
5206 defsubr (&Sfile_modes
);
5207 defsubr (&Sset_file_modes
);
5208 defsubr (&Sset_default_file_modes
);
5209 defsubr (&Sdefault_file_modes
);
5210 defsubr (&Sfile_newer_than_file_p
);
5211 defsubr (&Sinsert_file_contents
);
5212 defsubr (&Swrite_region
);
5213 defsubr (&Scar_less_than_car
);
5214 defsubr (&Sverify_visited_file_modtime
);
5215 defsubr (&Sclear_visited_file_modtime
);
5216 defsubr (&Svisited_file_modtime
);
5217 defsubr (&Sset_visited_file_modtime
);
5218 defsubr (&Sdo_auto_save
);
5219 defsubr (&Sset_buffer_auto_saved
);
5220 defsubr (&Sclear_buffer_auto_save_failure
);
5221 defsubr (&Srecent_auto_save_p
);
5223 defsubr (&Sread_file_name_internal
);
5224 defsubr (&Sread_file_name
);
5227 defsubr (&Sunix_sync
);