1 /* File IO for GNU Emacs.
2 Copyright (C) 1985,86,87,88,93,94,95,96 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
23 #include <sys/types.h>
30 #if !defined (S_ISLNK) && defined (S_IFLNK)
31 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
34 #if !defined (S_ISREG) && defined (S_IFREG)
35 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
46 #include <sys/param.h>
68 extern char *strerror ();
85 #include "intervals.h"
94 #endif /* not WINDOWSNT */
97 #define CORRECT_DIR_SEPS(s) \
98 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
99 else unixtodos_filename (s); \
101 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
102 redirector allows the six letters between 'Z' and 'a' as well. */
104 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
107 #define IS_DRIVE(x) isalpha (x)
109 /* Need to lower-case the drive letter, or else expanded
110 filenames will sometimes compare inequal, because
111 `expand-file-name' doesn't always down-case the drive letter. */
112 #define DRIVE_LETTER(x) (tolower (x))
141 #define min(a, b) ((a) < (b) ? (a) : (b))
142 #define max(a, b) ((a) > (b) ? (a) : (b))
144 /* Nonzero during writing of auto-save files */
147 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
148 a new file with the same mode as the original */
149 int auto_save_mode_bits
;
151 /* Alist of elements (REGEXP . HANDLER) for file names
152 whose I/O is done with a special handler. */
153 Lisp_Object Vfile_name_handler_alist
;
155 /* Format for auto-save files */
156 Lisp_Object Vauto_save_file_format
;
158 /* Lisp functions for translating file formats */
159 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
161 /* Functions to be called to process text properties in inserted file. */
162 Lisp_Object Vafter_insert_file_functions
;
164 /* Functions to be called to create text property annotations for file. */
165 Lisp_Object Vwrite_region_annotate_functions
;
167 /* During build_annotations, each time an annotation function is called,
168 this holds the annotations made by the previous functions. */
169 Lisp_Object Vwrite_region_annotations_so_far
;
171 /* File name in which we write a list of all our auto save files. */
172 Lisp_Object Vauto_save_list_file_name
;
174 /* Nonzero means, when reading a filename in the minibuffer,
175 start out by inserting the default directory into the minibuffer. */
176 int insert_default_directory
;
178 /* On VMS, nonzero means write new files with record format stmlf.
179 Zero means use var format. */
182 /* On NT, specifies the directory separator character, used (eg.) when
183 expanding file names. This can be bound to / or \. */
184 Lisp_Object Vdirectory_sep_char
;
186 /* These variables describe handlers that have "already" had a chance
187 to handle the current operation.
189 Vinhibit_file_name_handlers is a list of file name handlers.
190 Vinhibit_file_name_operation is the operation being handled.
191 If we try to handle that operation, we ignore those handlers. */
193 static Lisp_Object Vinhibit_file_name_handlers
;
194 static Lisp_Object Vinhibit_file_name_operation
;
196 Lisp_Object Qfile_error
, Qfile_already_exists
;
198 Lisp_Object Qfile_name_history
;
200 Lisp_Object Qcar_less_than_car
;
202 report_file_error (string
, data
)
206 Lisp_Object errstring
;
208 errstring
= build_string (strerror (errno
));
210 /* System error messages are capitalized. Downcase the initial
211 unless it is followed by a slash. */
212 if (XSTRING (errstring
)->data
[1] != '/')
213 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
216 Fsignal (Qfile_error
,
217 Fcons (build_string (string
), Fcons (errstring
, data
)));
220 close_file_unwind (fd
)
223 close (XFASTINT (fd
));
226 /* Restore point, having saved it as a marker. */
228 restore_point_unwind (location
)
229 Lisp_Object location
;
231 SET_PT (marker_position (location
));
232 Fset_marker (location
, Qnil
, Qnil
);
235 Lisp_Object Qexpand_file_name
;
236 Lisp_Object Qsubstitute_in_file_name
;
237 Lisp_Object Qdirectory_file_name
;
238 Lisp_Object Qfile_name_directory
;
239 Lisp_Object Qfile_name_nondirectory
;
240 Lisp_Object Qunhandled_file_name_directory
;
241 Lisp_Object Qfile_name_as_directory
;
242 Lisp_Object Qcopy_file
;
243 Lisp_Object Qmake_directory_internal
;
244 Lisp_Object Qdelete_directory
;
245 Lisp_Object Qdelete_file
;
246 Lisp_Object Qrename_file
;
247 Lisp_Object Qadd_name_to_file
;
248 Lisp_Object Qmake_symbolic_link
;
249 Lisp_Object Qfile_exists_p
;
250 Lisp_Object Qfile_executable_p
;
251 Lisp_Object Qfile_readable_p
;
252 Lisp_Object Qfile_writable_p
;
253 Lisp_Object Qfile_symlink_p
;
254 Lisp_Object Qaccess_file
;
255 Lisp_Object Qfile_directory_p
;
256 Lisp_Object Qfile_regular_p
;
257 Lisp_Object Qfile_accessible_directory_p
;
258 Lisp_Object Qfile_modes
;
259 Lisp_Object Qset_file_modes
;
260 Lisp_Object Qfile_newer_than_file_p
;
261 Lisp_Object Qinsert_file_contents
;
262 Lisp_Object Qwrite_region
;
263 Lisp_Object Qverify_visited_file_modtime
;
264 Lisp_Object Qset_visited_file_modtime
;
266 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
267 "Return FILENAME's handler function for OPERATION, if it has one.\n\
268 Otherwise, return nil.\n\
269 A file name is handled if one of the regular expressions in\n\
270 `file-name-handler-alist' matches it.\n\n\
271 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
272 any handlers that are members of `inhibit-file-name-handlers',\n\
273 but we still do run any other handlers. This lets handlers\n\
274 use the standard functions without calling themselves recursively.")
275 (filename
, operation
)
276 Lisp_Object filename
, operation
;
278 /* This function must not munge the match data. */
279 Lisp_Object chain
, inhibited_handlers
;
281 CHECK_STRING (filename
, 0);
283 if (EQ (operation
, Vinhibit_file_name_operation
))
284 inhibited_handlers
= Vinhibit_file_name_handlers
;
286 inhibited_handlers
= Qnil
;
288 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
289 chain
= XCONS (chain
)->cdr
)
292 elt
= XCONS (chain
)->car
;
296 string
= XCONS (elt
)->car
;
297 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
299 Lisp_Object handler
, tem
;
301 handler
= XCONS (elt
)->cdr
;
302 tem
= Fmemq (handler
, inhibited_handlers
);
313 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
315 "Return the directory component in file name FILENAME.\n\
316 Return nil if FILENAME does not include a directory.\n\
317 Otherwise return a directory spec.\n\
318 Given a Unix syntax file name, returns a string ending in slash;\n\
319 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
321 Lisp_Object filename
;
323 register unsigned char *beg
;
324 register unsigned char *p
;
327 CHECK_STRING (filename
, 0);
329 /* If the file name has special constructs in it,
330 call the corresponding file handler. */
331 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
333 return call2 (handler
, Qfile_name_directory
, filename
);
335 #ifdef FILE_SYSTEM_CASE
336 filename
= FILE_SYSTEM_CASE (filename
);
338 beg
= XSTRING (filename
)->data
;
340 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
342 p
= beg
+ XSTRING (filename
)->size
;
344 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
346 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
349 /* only recognise drive specifier at beginning */
350 && !(p
[-1] == ':' && p
== beg
+ 2)
357 /* Expansion of "c:" to drive and default directory. */
358 if (p
== beg
+ 2 && beg
[1] == ':')
360 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
361 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
362 if (getdefdir (toupper (*beg
) - 'A' + 1, res
))
364 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
367 p
= beg
+ strlen (beg
);
370 CORRECT_DIR_SEPS (beg
);
372 return make_string (beg
, p
- beg
);
375 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
377 "Return file name FILENAME sans its directory.\n\
378 For example, in a Unix-syntax file name,\n\
379 this is everything after the last slash,\n\
380 or the entire name if it contains no slash.")
382 Lisp_Object filename
;
384 register unsigned char *beg
, *p
, *end
;
387 CHECK_STRING (filename
, 0);
389 /* If the file name has special constructs in it,
390 call the corresponding file handler. */
391 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
393 return call2 (handler
, Qfile_name_nondirectory
, filename
);
395 beg
= XSTRING (filename
)->data
;
396 end
= p
= beg
+ XSTRING (filename
)->size
;
398 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
400 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
403 /* only recognise drive specifier at beginning */
404 && !(p
[-1] == ':' && p
== beg
+ 2)
408 return make_string (p
, end
- p
);
411 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
, Sunhandled_file_name_directory
, 1, 1, 0,
412 "Return a directly usable directory name somehow associated with FILENAME.\n\
413 A `directly usable' directory name is one that may be used without the\n\
414 intervention of any file handler.\n\
415 If FILENAME is a directly usable file itself, return\n\
416 (file-name-directory FILENAME).\n\
417 The `call-process' and `start-process' functions use this function to\n\
418 get a current directory to run processes in.")
420 Lisp_Object filename
;
424 /* If the file name has special constructs in it,
425 call the corresponding file handler. */
426 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
428 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
430 return Ffile_name_directory (filename
);
435 file_name_as_directory (out
, in
)
438 int size
= strlen (in
) - 1;
443 /* Is it already a directory string? */
444 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
446 /* Is it a VMS directory file name? If so, hack VMS syntax. */
447 else if (! index (in
, '/')
448 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
449 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
450 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
451 || ! strncmp (&in
[size
- 5], ".dir", 4))
452 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
453 && in
[size
] == '1')))
455 register char *p
, *dot
;
459 dir:x.dir --> dir:[x]
460 dir:[x]y.dir --> dir:[x.y] */
462 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
465 strncpy (out
, in
, p
- in
);
484 dot
= index (p
, '.');
487 /* blindly remove any extension */
488 size
= strlen (out
) + (dot
- p
);
489 strncat (out
, p
, dot
- p
);
500 /* For Unix syntax, Append a slash if necessary */
501 if (!IS_DIRECTORY_SEP (out
[size
]))
503 out
[size
+ 1] = DIRECTORY_SEP
;
504 out
[size
+ 2] = '\0';
507 CORRECT_DIR_SEPS (out
);
513 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
514 Sfile_name_as_directory
, 1, 1, 0,
515 "Return a string representing file FILENAME interpreted as a directory.\n\
516 This operation exists because a directory is also a file, but its name as\n\
517 a directory is different from its name as a file.\n\
518 The result can be used as the value of `default-directory'\n\
519 or passed as second argument to `expand-file-name'.\n\
520 For a Unix-syntax file name, just appends a slash.\n\
521 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
528 CHECK_STRING (file
, 0);
532 /* If the file name has special constructs in it,
533 call the corresponding file handler. */
534 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
536 return call2 (handler
, Qfile_name_as_directory
, file
);
538 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
539 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
543 * Convert from directory name to filename.
545 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
546 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
547 * On UNIX, it's simple: just make sure there isn't a terminating /
549 * Value is nonzero if the string output is different from the input.
552 directory_file_name (src
, dst
)
560 struct FAB fab
= cc$rms_fab
;
561 struct NAM nam
= cc$rms_nam
;
562 char esa
[NAM$C_MAXRSS
];
567 if (! index (src
, '/')
568 && (src
[slen
- 1] == ']'
569 || src
[slen
- 1] == ':'
570 || src
[slen
- 1] == '>'))
572 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
574 fab
.fab$b_fns
= slen
;
575 fab
.fab$l_nam
= &nam
;
576 fab
.fab$l_fop
= FAB$M_NAM
;
579 nam
.nam$b_ess
= sizeof esa
;
580 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
582 /* We call SYS$PARSE to handle such things as [--] for us. */
583 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
585 slen
= nam
.nam$b_esl
;
586 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
591 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
593 /* what about when we have logical_name:???? */
594 if (src
[slen
- 1] == ':')
595 { /* Xlate logical name and see what we get */
596 ptr
= strcpy (dst
, src
); /* upper case for getenv */
599 if ('a' <= *ptr
&& *ptr
<= 'z')
603 dst
[slen
- 1] = 0; /* remove colon */
604 if (!(src
= egetenv (dst
)))
606 /* should we jump to the beginning of this procedure?
607 Good points: allows us to use logical names that xlate
609 Bad points: can be a problem if we just translated to a device
611 For now, I'll punt and always expect VMS names, and hope for
614 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
615 { /* no recursion here! */
621 { /* not a directory spec */
626 bracket
= src
[slen
- 1];
628 /* If bracket is ']' or '>', bracket - 2 is the corresponding
630 ptr
= index (src
, bracket
- 2);
632 { /* no opening bracket */
636 if (!(rptr
= rindex (src
, '.')))
639 strncpy (dst
, src
, slen
);
643 dst
[slen
++] = bracket
;
648 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
649 then translate the device and recurse. */
650 if (dst
[slen
- 1] == ':'
651 && dst
[slen
- 2] != ':' /* skip decnet nodes */
652 && strcmp (src
+ slen
, "[000000]") == 0)
654 dst
[slen
- 1] = '\0';
655 if ((ptr
= egetenv (dst
))
656 && (rlen
= strlen (ptr
) - 1) > 0
657 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
658 && ptr
[rlen
- 1] == '.')
660 char * buf
= (char *) alloca (strlen (ptr
) + 1);
664 return directory_file_name (buf
, dst
);
669 strcat (dst
, "[000000]");
673 rlen
= strlen (rptr
) - 1;
674 strncat (dst
, rptr
, rlen
);
675 dst
[slen
+ rlen
] = '\0';
676 strcat (dst
, ".DIR.1");
680 /* Process as Unix format: just remove any final slash.
681 But leave "/" unchanged; do not change it to "". */
684 /* Handle // as root for apollo's. */
685 if ((slen
> 2 && dst
[slen
- 1] == '/')
686 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
690 && IS_DIRECTORY_SEP (dst
[slen
- 1])
692 && !IS_ANY_SEP (dst
[slen
- 2])
698 CORRECT_DIR_SEPS (dst
);
703 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
705 "Returns the file name of the directory named DIRECTORY.\n\
706 This is the name of the file that holds the data for the directory DIRECTORY.\n\
707 This operation exists because a directory is also a file, but its name as\n\
708 a directory is different from its name as a file.\n\
709 In Unix-syntax, this function just removes the final slash.\n\
710 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
711 it returns a file name such as \"[X]Y.DIR.1\".")
713 Lisp_Object directory
;
718 CHECK_STRING (directory
, 0);
720 if (NILP (directory
))
723 /* If the file name has special constructs in it,
724 call the corresponding file handler. */
725 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
727 return call2 (handler
, Qdirectory_file_name
, directory
);
730 /* 20 extra chars is insufficient for VMS, since we might perform a
731 logical name translation. an equivalence string can be up to 255
732 chars long, so grab that much extra space... - sss */
733 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
735 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
737 directory_file_name (XSTRING (directory
)->data
, buf
);
738 return build_string (buf
);
741 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
742 "Generate temporary file name (string) starting with PREFIX (a string).\n\
743 The Emacs process number forms part of the result,\n\
744 so there is no danger of generating a name being used by another process.")
750 /* Don't use too many characters of the restricted 8+3 DOS
752 val
= concat2 (prefix
, build_string ("a.XXX"));
754 val
= concat2 (prefix
, build_string ("XXXXXX"));
756 mktemp (XSTRING (val
)->data
);
758 CORRECT_DIR_SEPS (XSTRING (val
)->data
);
763 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
764 "Convert filename NAME to absolute, and canonicalize it.\n\
765 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative\n\
766 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,\n\
767 the current buffer's value of default-directory is used.\n\
768 File name components that are `.' are removed, and \n\
769 so are file name components followed by `..', along with the `..' itself;\n\
770 note that these simplifications are done without checking the resulting\n\
771 file names in the file system.\n\
772 An initial `~/' expands to your home directory.\n\
773 An initial `~USER/' expands to USER's home directory.\n\
774 See also the function `substitute-in-file-name'.")
775 (name
, default_directory
)
776 Lisp_Object name
, default_directory
;
780 register unsigned char *newdir
, *p
, *o
;
782 unsigned char *target
;
785 unsigned char * colon
= 0;
786 unsigned char * close
= 0;
787 unsigned char * slash
= 0;
788 unsigned char * brack
= 0;
789 int lbrack
= 0, rbrack
= 0;
794 int collapse_newdir
= 1;
799 CHECK_STRING (name
, 0);
801 /* If the file name has special constructs in it,
802 call the corresponding file handler. */
803 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
805 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
807 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
808 if (NILP (default_directory
))
809 default_directory
= current_buffer
->directory
;
810 CHECK_STRING (default_directory
, 1);
812 if (!NILP (default_directory
))
814 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
816 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
819 o
= XSTRING (default_directory
)->data
;
821 /* Make sure DEFAULT_DIRECTORY is properly expanded.
822 It would be better to do this down below where we actually use
823 default_directory. Unfortunately, calling Fexpand_file_name recursively
824 could invoke GC, and the strings might be relocated. This would
825 be annoying because we have pointers into strings lying around
826 that would need adjusting, and people would add new pointers to
827 the code and forget to adjust them, resulting in intermittent bugs.
828 Putting this call here avoids all that crud.
830 The EQ test avoids infinite recursion. */
831 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
832 /* Save time in some common cases - as long as default_directory
833 is not relative, it can be canonicalized with name below (if it
834 is needed at all) without requiring it to be expanded now. */
836 /* Detect MSDOS file names with drive specifiers. */
837 && ! (IS_DRIVE (o
[0]) && (IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2])))
839 /* Detect Windows file names in UNC format. */
840 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
842 #else /* not DOS_NT */
843 /* Detect Unix absolute file names (/... alone is not absolute on
845 && ! (IS_DIRECTORY_SEP (o
[0]))
846 #endif /* not DOS_NT */
852 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
857 /* Filenames on VMS are always upper case. */
858 name
= Fupcase (name
);
860 #ifdef FILE_SYSTEM_CASE
861 name
= FILE_SYSTEM_CASE (name
);
864 nm
= XSTRING (name
)->data
;
867 /* We will force directory separators to be either all \ or /, so make
868 a local copy to modify, even if there ends up being no change. */
869 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
871 /* Find and remove drive specifier if present; this makes nm absolute
872 even if the rest of the name appears to be relative. */
874 unsigned char *colon
= rindex (nm
, ':');
877 /* Only recognize colon as part of drive specifier if there is a
878 single alphabetic character preceeding the colon (and if the
879 character before the drive letter, if present, is a directory
880 separator); this is to support the remote system syntax used by
881 ange-ftp, and the "po:username" syntax for POP mailboxes. */
885 else if (IS_DRIVE (colon
[-1])
886 && (colon
== nm
+ 1 || IS_DIRECTORY_SEP (colon
[-2])))
893 while (--colon
>= nm
)
900 /* Handle // and /~ in middle of file name
901 by discarding everything through the first / of that sequence. */
905 /* Since we are expecting the name to be absolute, we can assume
906 that each element starts with a "/". */
908 if (IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1])
909 #if defined (APOLLO) || defined (WINDOWSNT)
910 /* // at start of filename is meaningful on Apollo
911 and WindowsNT systems */
913 #endif /* APOLLO || WINDOWSNT */
917 if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '~')
924 /* Discard any previous drive specifier if nm is now in UNC format. */
925 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
931 /* If nm is absolute, look for /./ or /../ sequences; if none are
932 found, we can probably return right away. We will avoid allocating
933 a new string if name is already fully expanded. */
935 IS_DIRECTORY_SEP (nm
[0])
940 && (drive
|| IS_DIRECTORY_SEP (nm
[1]))
947 /* If it turns out that the filename we want to return is just a
948 suffix of FILENAME, we don't need to go through and edit
949 things; we just need to construct a new string using data
950 starting at the middle of FILENAME. If we set lose to a
951 non-zero value, that means we've discovered that we can't do
958 /* Since we know the name is absolute, we can assume that each
959 element starts with a "/". */
961 /* "." and ".." are hairy. */
962 if (IS_DIRECTORY_SEP (p
[0])
964 && (IS_DIRECTORY_SEP (p
[2])
966 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
973 /* if dev:[dir]/, move nm to / */
974 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
975 nm
= (brack
? brack
+ 1 : colon
+ 1);
984 /* VMS pre V4.4,convert '-'s in filenames. */
985 if (lbrack
== rbrack
)
987 if (dots
< 2) /* this is to allow negative version numbers */
992 if (lbrack
> rbrack
&&
993 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
994 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1000 /* count open brackets, reset close bracket pointer */
1001 if (p
[0] == '[' || p
[0] == '<')
1002 lbrack
++, brack
= 0;
1003 /* count close brackets, set close bracket pointer */
1004 if (p
[0] == ']' || p
[0] == '>')
1005 rbrack
++, brack
= p
;
1006 /* detect ][ or >< */
1007 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1009 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1010 nm
= p
+ 1, lose
= 1;
1011 if (p
[0] == ':' && (colon
|| slash
))
1012 /* if dev1:[dir]dev2:, move nm to dev2: */
1018 /* if /name/dev:, move nm to dev: */
1021 /* if node::dev:, move colon following dev */
1022 else if (colon
&& colon
[-1] == ':')
1024 /* if dev1:dev2:, move nm to dev2: */
1025 else if (colon
&& colon
[-1] != ':')
1030 if (p
[0] == ':' && !colon
)
1036 if (lbrack
== rbrack
)
1039 else if (p
[0] == '.')
1047 if (index (nm
, '/'))
1048 return build_string (sys_translate_unix (nm
));
1051 /* Make sure directories are all separated with / or \ as
1052 desired, but avoid allocation of a new string when not
1054 CORRECT_DIR_SEPS (nm
);
1056 if (IS_DIRECTORY_SEP (nm
[1]))
1058 if (strcmp (nm
, XSTRING (name
)->data
) != 0)
1059 name
= build_string (nm
);
1063 /* drive must be set, so this is okay */
1064 if (strcmp (nm
- 2, XSTRING (name
)->data
) != 0)
1066 name
= make_string (nm
- 2, p
- nm
+ 2);
1067 XSTRING (name
)->data
[0] = DRIVE_LETTER (drive
);
1068 XSTRING (name
)->data
[1] = ':';
1071 #else /* not DOS_NT */
1072 if (nm
== XSTRING (name
)->data
)
1074 return build_string (nm
);
1075 #endif /* not DOS_NT */
1079 /* At this point, nm might or might not be an absolute file name. We
1080 need to expand ~ or ~user if present, otherwise prefix nm with
1081 default_directory if nm is not absolute, and finally collapse /./
1082 and /foo/../ sequences.
1084 We set newdir to be the appropriate prefix if one is needed:
1085 - the relevant user directory if nm starts with ~ or ~user
1086 - the specified drive's working dir (DOS/NT only) if nm does not
1088 - the value of default_directory.
1090 Note that these prefixes are not guaranteed to be absolute (except
1091 for the working dir of a drive). Therefore, to ensure we always
1092 return an absolute name, if the final prefix is not absolute we
1093 append it to the current working directory. */
1097 if (nm
[0] == '~') /* prefix ~ */
1099 if (IS_DIRECTORY_SEP (nm
[1])
1103 || nm
[1] == 0) /* ~ by itself */
1105 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1106 newdir
= (unsigned char *) "";
1109 collapse_newdir
= 0;
1112 nm
++; /* Don't leave the slash in nm. */
1115 else /* ~user/filename */
1117 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1122 o
= (unsigned char *) alloca (p
- nm
+ 1);
1123 bcopy ((char *) nm
, o
, p
- nm
);
1126 pw
= (struct passwd
*) getpwnam (o
+ 1);
1129 newdir
= (unsigned char *) pw
-> pw_dir
;
1131 nm
= p
+ 1; /* skip the terminator */
1135 collapse_newdir
= 0;
1140 /* If we don't find a user of that name, leave the name
1141 unchanged; don't move nm forward to p. */
1146 /* On DOS and Windows, nm is absolute if a drive name was specified;
1147 use the drive's current directory as the prefix if needed. */
1148 if (!newdir
&& drive
)
1150 /* Get default directory if needed to make nm absolute. */
1151 if (!IS_DIRECTORY_SEP (nm
[0]))
1153 newdir
= alloca (MAXPATHLEN
+ 1);
1154 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1159 /* Either nm starts with /, or drive isn't mounted. */
1160 newdir
= alloca (4);
1161 newdir
[0] = DRIVE_LETTER (drive
);
1169 /* Finally, if no prefix has been specified and nm is not absolute,
1170 then it must be expanded relative to default_directory. */
1174 /* /... alone is not absolute on DOS and Windows. */
1175 && !IS_DIRECTORY_SEP (nm
[0])
1178 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1185 newdir
= XSTRING (default_directory
)->data
;
1191 /* First ensure newdir is an absolute name. */
1193 /* Detect MSDOS file names with drive specifiers. */
1194 ! (IS_DRIVE (newdir
[0])
1195 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1197 /* Detect Windows file names in UNC format. */
1198 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1202 /* Effectively, let newdir be (expand-file-name newdir cwd).
1203 Because of the admonition against calling expand-file-name
1204 when we have pointers into lisp strings, we accomplish this
1205 indirectly by prepending newdir to nm if necessary, and using
1206 cwd (or the wd of newdir's drive) as the new newdir. */
1208 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1213 if (!IS_DIRECTORY_SEP (nm
[0]))
1215 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1216 file_name_as_directory (tmp
, newdir
);
1220 newdir
= alloca (MAXPATHLEN
+ 1);
1223 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1230 /* Strip off drive name from prefix, if present. */
1231 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1237 /* Keep only a prefix from newdir if nm starts with slash
1238 (//server/share for UNC, nothing otherwise). */
1239 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1242 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1244 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1246 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1248 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1260 /* Get rid of any slash at the end of newdir, unless newdir is
1261 just // (an incomplete UNC name). */
1262 length
= strlen (newdir
);
1263 if (IS_DIRECTORY_SEP (newdir
[length
- 1])
1265 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1269 unsigned char *temp
= (unsigned char *) alloca (length
);
1270 bcopy (newdir
, temp
, length
- 1);
1271 temp
[length
- 1] = 0;
1279 /* Now concatenate the directory and name to new space in the stack frame */
1280 tlen
+= strlen (nm
) + 1;
1282 /* Add reserved space for drive name. (The Microsoft x86 compiler
1283 produces incorrect code if the following two lines are combined.) */
1284 target
= (unsigned char *) alloca (tlen
+ 2);
1286 #else /* not DOS_NT */
1287 target
= (unsigned char *) alloca (tlen
);
1288 #endif /* not DOS_NT */
1294 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1295 strcpy (target
, newdir
);
1298 file_name_as_directory (target
, newdir
);
1301 strcat (target
, nm
);
1303 if (index (target
, '/'))
1304 strcpy (target
, sys_translate_unix (target
));
1307 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1309 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1317 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1323 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1324 /* brackets are offset from each other by 2 */
1327 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1328 /* convert [foo][bar] to [bar] */
1329 while (o
[-1] != '[' && o
[-1] != '<')
1331 else if (*p
== '-' && *o
!= '.')
1334 else if (p
[0] == '-' && o
[-1] == '.' &&
1335 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1336 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1340 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1341 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1343 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1345 /* else [foo.-] ==> [-] */
1351 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1352 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1358 if (!IS_DIRECTORY_SEP (*p
))
1362 else if (IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1])
1363 #if defined (APOLLO) || defined (WINDOWSNT)
1364 /* // at start of filename is meaningful in Apollo
1365 and WindowsNT systems */
1367 #endif /* APOLLO || WINDOWSNT */
1373 else if (IS_DIRECTORY_SEP (p
[0])
1375 && (IS_DIRECTORY_SEP (p
[2])
1378 /* If "/." is the entire filename, keep the "/". Otherwise,
1379 just delete the whole "/.". */
1380 if (o
== target
&& p
[2] == '\0')
1384 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1385 /* `/../' is the "superroot" on certain file systems. */
1387 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1389 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1391 if (o
== target
&& IS_ANY_SEP (*o
))
1399 #endif /* not VMS */
1403 /* At last, set drive name. */
1405 /* Except for network file name. */
1406 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1407 #endif /* WINDOWSNT */
1409 if (!drive
) abort ();
1411 target
[0] = DRIVE_LETTER (drive
);
1414 CORRECT_DIR_SEPS (target
);
1417 return make_string (target
, o
- target
);
1421 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1422 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1423 "Convert FILENAME to absolute, and canonicalize it.\n\
1424 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1425 (does not start with slash); if DEFAULT is nil or missing,\n\
1426 the current buffer's value of default-directory is used.\n\
1427 Filenames containing `.' or `..' as components are simplified;\n\
1428 initial `~/' expands to your home directory.\n\
1429 See also the function `substitute-in-file-name'.")
1431 Lisp_Object name
, defalt
;
1435 register unsigned char *newdir
, *p
, *o
;
1437 unsigned char *target
;
1441 unsigned char * colon
= 0;
1442 unsigned char * close
= 0;
1443 unsigned char * slash
= 0;
1444 unsigned char * brack
= 0;
1445 int lbrack
= 0, rbrack
= 0;
1449 CHECK_STRING (name
, 0);
1452 /* Filenames on VMS are always upper case. */
1453 name
= Fupcase (name
);
1456 nm
= XSTRING (name
)->data
;
1458 /* If nm is absolute, flush ...// and detect /./ and /../.
1459 If no /./ or /../ we can return right away. */
1471 if (p
[0] == '/' && p
[1] == '/'
1473 /* // at start of filename is meaningful on Apollo system */
1478 if (p
[0] == '/' && p
[1] == '~')
1479 nm
= p
+ 1, lose
= 1;
1480 if (p
[0] == '/' && p
[1] == '.'
1481 && (p
[2] == '/' || p
[2] == 0
1482 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1488 /* if dev:[dir]/, move nm to / */
1489 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1490 nm
= (brack
? brack
+ 1 : colon
+ 1);
1491 lbrack
= rbrack
= 0;
1499 /* VMS pre V4.4,convert '-'s in filenames. */
1500 if (lbrack
== rbrack
)
1502 if (dots
< 2) /* this is to allow negative version numbers */
1507 if (lbrack
> rbrack
&&
1508 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1509 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1515 /* count open brackets, reset close bracket pointer */
1516 if (p
[0] == '[' || p
[0] == '<')
1517 lbrack
++, brack
= 0;
1518 /* count close brackets, set close bracket pointer */
1519 if (p
[0] == ']' || p
[0] == '>')
1520 rbrack
++, brack
= p
;
1521 /* detect ][ or >< */
1522 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1524 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1525 nm
= p
+ 1, lose
= 1;
1526 if (p
[0] == ':' && (colon
|| slash
))
1527 /* if dev1:[dir]dev2:, move nm to dev2: */
1533 /* If /name/dev:, move nm to dev: */
1536 /* If node::dev:, move colon following dev */
1537 else if (colon
&& colon
[-1] == ':')
1539 /* If dev1:dev2:, move nm to dev2: */
1540 else if (colon
&& colon
[-1] != ':')
1545 if (p
[0] == ':' && !colon
)
1551 if (lbrack
== rbrack
)
1554 else if (p
[0] == '.')
1562 if (index (nm
, '/'))
1563 return build_string (sys_translate_unix (nm
));
1565 if (nm
== XSTRING (name
)->data
)
1567 return build_string (nm
);
1571 /* Now determine directory to start with and put it in NEWDIR */
1575 if (nm
[0] == '~') /* prefix ~ */
1580 || nm
[1] == 0)/* ~/filename */
1582 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1583 newdir
= (unsigned char *) "";
1586 nm
++; /* Don't leave the slash in nm. */
1589 else /* ~user/filename */
1591 /* Get past ~ to user */
1592 unsigned char *user
= nm
+ 1;
1593 /* Find end of name. */
1594 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1595 int len
= ptr
? ptr
- user
: strlen (user
);
1597 unsigned char *ptr1
= index (user
, ':');
1598 if (ptr1
!= 0 && ptr1
- user
< len
)
1601 /* Copy the user name into temp storage. */
1602 o
= (unsigned char *) alloca (len
+ 1);
1603 bcopy ((char *) user
, o
, len
);
1606 /* Look up the user name. */
1607 pw
= (struct passwd
*) getpwnam (o
+ 1);
1609 error ("\"%s\" isn't a registered user", o
+ 1);
1611 newdir
= (unsigned char *) pw
->pw_dir
;
1613 /* Discard the user name from NM. */
1620 #endif /* not VMS */
1624 defalt
= current_buffer
->directory
;
1625 CHECK_STRING (defalt
, 1);
1626 newdir
= XSTRING (defalt
)->data
;
1629 /* Now concatenate the directory and name to new space in the stack frame */
1631 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1632 target
= (unsigned char *) alloca (tlen
);
1638 if (nm
[0] == 0 || nm
[0] == '/')
1639 strcpy (target
, newdir
);
1642 file_name_as_directory (target
, newdir
);
1645 strcat (target
, nm
);
1647 if (index (target
, '/'))
1648 strcpy (target
, sys_translate_unix (target
));
1651 /* Now canonicalize by removing /. and /foo/.. if they appear */
1659 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1665 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1666 /* brackets are offset from each other by 2 */
1669 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1670 /* convert [foo][bar] to [bar] */
1671 while (o
[-1] != '[' && o
[-1] != '<')
1673 else if (*p
== '-' && *o
!= '.')
1676 else if (p
[0] == '-' && o
[-1] == '.' &&
1677 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1678 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1682 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1683 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1685 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1687 /* else [foo.-] ==> [-] */
1693 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1694 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1704 else if (!strncmp (p
, "//", 2)
1706 /* // at start of filename is meaningful in Apollo system */
1714 else if (p
[0] == '/' && p
[1] == '.' &&
1715 (p
[2] == '/' || p
[2] == 0))
1717 else if (!strncmp (p
, "/..", 3)
1718 /* `/../' is the "superroot" on certain file systems. */
1720 && (p
[3] == '/' || p
[3] == 0))
1722 while (o
!= target
&& *--o
!= '/')
1725 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1729 if (o
== target
&& *o
== '/')
1737 #endif /* not VMS */
1740 return make_string (target
, o
- target
);
1744 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1745 Ssubstitute_in_file_name
, 1, 1, 0,
1746 "Substitute environment variables referred to in FILENAME.\n\
1747 `$FOO' where FOO is an environment variable name means to substitute\n\
1748 the value of that variable. The variable name should be terminated\n\
1749 with a character not a letter, digit or underscore; otherwise, enclose\n\
1750 the entire variable name in braces.\n\
1751 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1752 On VMS, `$' substitution is not done; this function does little and only\n\
1753 duplicates what `expand-file-name' does.")
1755 Lisp_Object filename
;
1759 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1760 unsigned char *target
;
1762 int substituted
= 0;
1764 Lisp_Object handler
;
1766 CHECK_STRING (filename
, 0);
1768 /* If the file name has special constructs in it,
1769 call the corresponding file handler. */
1770 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1771 if (!NILP (handler
))
1772 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1774 nm
= XSTRING (filename
)->data
;
1776 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1777 CORRECT_DIR_SEPS (nm
);
1778 substituted
= (strcmp (nm
, XSTRING (filename
)->data
) != 0);
1780 endp
= nm
+ XSTRING (filename
)->size
;
1782 /* If /~ or // appears, discard everything through first slash. */
1784 for (p
= nm
; p
!= endp
; p
++)
1787 #if defined (APOLLO) || defined (WINDOWSNT)
1788 /* // at start of file name is meaningful in Apollo and
1789 WindowsNT systems */
1790 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1791 #else /* not (APOLLO || WINDOWSNT) */
1792 || IS_DIRECTORY_SEP (p
[0])
1793 #endif /* not (APOLLO || WINDOWSNT) */
1798 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1800 || IS_DIRECTORY_SEP (p
[-1])))
1806 /* see comment in expand-file-name about drive specifiers */
1807 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1808 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1817 return build_string (nm
);
1820 /* See if any variables are substituted into the string
1821 and find the total length of their values in `total' */
1823 for (p
= nm
; p
!= endp
;)
1833 /* "$$" means a single "$" */
1842 while (p
!= endp
&& *p
!= '}') p
++;
1843 if (*p
!= '}') goto missingclose
;
1849 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1853 /* Copy out the variable name */
1854 target
= (unsigned char *) alloca (s
- o
+ 1);
1855 strncpy (target
, o
, s
- o
);
1858 strupr (target
); /* $home == $HOME etc. */
1861 /* Get variable value */
1862 o
= (unsigned char *) egetenv (target
);
1863 if (!o
) goto badvar
;
1864 total
+= strlen (o
);
1871 /* If substitution required, recopy the string and do it */
1872 /* Make space in stack frame for the new copy */
1873 xnm
= (unsigned char *) alloca (XSTRING (filename
)->size
+ total
+ 1);
1876 /* Copy the rest of the name through, replacing $ constructs with values */
1893 while (p
!= endp
&& *p
!= '}') p
++;
1894 if (*p
!= '}') goto missingclose
;
1900 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1904 /* Copy out the variable name */
1905 target
= (unsigned char *) alloca (s
- o
+ 1);
1906 strncpy (target
, o
, s
- o
);
1909 strupr (target
); /* $home == $HOME etc. */
1912 /* Get variable value */
1913 o
= (unsigned char *) egetenv (target
);
1923 /* If /~ or // appears, discard everything through first slash. */
1925 for (p
= xnm
; p
!= x
; p
++)
1927 #if defined (APOLLO) || defined (WINDOWSNT)
1928 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
1929 #else /* not (APOLLO || WINDOWSNT) */
1930 || IS_DIRECTORY_SEP (p
[0])
1931 #endif /* not (APOLLO || WINDOWSNT) */
1933 && p
!= nm
&& IS_DIRECTORY_SEP (p
[-1]))
1936 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1937 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1941 return make_string (xnm
, x
- xnm
);
1944 error ("Bad format environment-variable substitution");
1946 error ("Missing \"}\" in environment-variable substitution");
1948 error ("Substituting nonexistent environment variable \"%s\"", target
);
1951 #endif /* not VMS */
1954 /* A slightly faster and more convenient way to get
1955 (directory-file-name (expand-file-name FOO)). */
1958 expand_and_dir_to_file (filename
, defdir
)
1959 Lisp_Object filename
, defdir
;
1961 register Lisp_Object absname
;
1963 absname
= Fexpand_file_name (filename
, defdir
);
1966 register int c
= XSTRING (absname
)->data
[XSTRING (absname
)->size
- 1];
1967 if (c
== ':' || c
== ']' || c
== '>')
1968 absname
= Fdirectory_file_name (absname
);
1971 /* Remove final slash, if any (unless this is the root dir).
1972 stat behaves differently depending! */
1973 if (XSTRING (absname
)->size
> 1
1974 && IS_DIRECTORY_SEP (XSTRING (absname
)->data
[XSTRING (absname
)->size
- 1])
1975 && !IS_DEVICE_SEP (XSTRING (absname
)->data
[XSTRING (absname
)->size
-2]))
1976 /* We cannot take shortcuts; they might be wrong for magic file names. */
1977 absname
= Fdirectory_file_name (absname
);
1982 /* Signal an error if the file ABSNAME already exists.
1983 If INTERACTIVE is nonzero, ask the user whether to proceed,
1984 and bypass the error if the user says to go ahead.
1985 QUERYSTRING is a name for the action that is being considered
1987 *STATPTR is used to store the stat information if the file exists.
1988 If the file does not exist, STATPTR->st_mode is set to 0. */
1991 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
)
1992 Lisp_Object absname
;
1993 unsigned char *querystring
;
1995 struct stat
*statptr
;
1997 register Lisp_Object tem
;
1998 struct stat statbuf
;
1999 struct gcpro gcpro1
;
2001 /* stat is a good way to tell whether the file exists,
2002 regardless of what access permissions it has. */
2003 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
2006 Fsignal (Qfile_already_exists
,
2007 Fcons (build_string ("File already exists"),
2008 Fcons (absname
, Qnil
)));
2010 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
2011 XSTRING (absname
)->data
, querystring
));
2014 Fsignal (Qfile_already_exists
,
2015 Fcons (build_string ("File already exists"),
2016 Fcons (absname
, Qnil
)));
2023 statptr
->st_mode
= 0;
2028 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2029 "fCopy file: \nFCopy %s to file: \np\nP",
2030 "Copy FILE to NEWNAME. Both args must be strings.\n\
2031 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
2032 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
2033 A number as third arg means request confirmation if NEWNAME already exists.\n\
2034 This is what happens in interactive use with M-x.\n\
2035 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
2036 last-modified time as the old one. (This works on only some systems.)\n\
2037 A prefix arg makes KEEP-TIME non-nil.")
2038 (file
, newname
, ok_if_already_exists
, keep_date
)
2039 Lisp_Object file
, newname
, ok_if_already_exists
, keep_date
;
2042 char buf
[16 * 1024];
2043 struct stat st
, out_st
;
2044 Lisp_Object handler
;
2045 struct gcpro gcpro1
, gcpro2
;
2046 int count
= specpdl_ptr
- specpdl
;
2047 int input_file_statable_p
;
2049 GCPRO2 (file
, newname
);
2050 CHECK_STRING (file
, 0);
2051 CHECK_STRING (newname
, 1);
2052 file
= Fexpand_file_name (file
, Qnil
);
2053 newname
= Fexpand_file_name (newname
, Qnil
);
2055 /* If the input file name has special constructs in it,
2056 call the corresponding file handler. */
2057 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2058 /* Likewise for output file name. */
2060 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2061 if (!NILP (handler
))
2062 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2063 ok_if_already_exists
, keep_date
));
2065 if (NILP (ok_if_already_exists
)
2066 || INTEGERP (ok_if_already_exists
))
2067 barf_or_query_if_file_exists (newname
, "copy to it",
2068 INTEGERP (ok_if_already_exists
), &out_st
);
2069 else if (stat (XSTRING (newname
)->data
, &out_st
) < 0)
2072 ifd
= open (XSTRING (file
)->data
, O_RDONLY
);
2074 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2076 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2078 /* We can only copy regular files and symbolic links. Other files are not
2080 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2082 #if !defined (MSDOS) || __DJGPP__ > 1
2083 if (out_st
.st_mode
!= 0
2084 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2087 report_file_error ("Input and output files are the same",
2088 Fcons (file
, Fcons (newname
, Qnil
)));
2092 #if defined (S_ISREG) && defined (S_ISLNK)
2093 if (input_file_statable_p
)
2095 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2097 #if defined (EISDIR)
2098 /* Get a better looking error message. */
2101 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2104 #endif /* S_ISREG && S_ISLNK */
2107 /* Create the copy file with the same record format as the input file */
2108 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
2111 /* System's default file type was set to binary by _fmode in emacs.c. */
2112 ofd
= creat (XSTRING (newname
)->data
, S_IREAD
| S_IWRITE
);
2113 #else /* not MSDOS */
2114 ofd
= creat (XSTRING (newname
)->data
, 0666);
2115 #endif /* not MSDOS */
2118 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2120 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2124 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
2125 if (write (ofd
, buf
, n
) != n
)
2126 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2129 /* Closing the output clobbers the file times on some systems. */
2130 if (close (ofd
) < 0)
2131 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2133 if (input_file_statable_p
)
2135 if (!NILP (keep_date
))
2137 EMACS_TIME atime
, mtime
;
2138 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2139 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2140 if (set_file_times (XSTRING (newname
)->data
, atime
, mtime
))
2141 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2144 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
2146 #if defined (__DJGPP__) && __DJGPP__ > 1
2147 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2148 and if it can't, it tells so. Otherwise, under MSDOS we usually
2149 get only the READ bit, which will make the copied file read-only,
2150 so it's better not to chmod at all. */
2151 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2152 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
2153 #endif /* DJGPP version 2 or newer */
2159 /* Discard the unwind protects. */
2160 specpdl_ptr
= specpdl
+ count
;
2166 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2167 Smake_directory_internal
, 1, 1, 0,
2168 "Create a new directory named DIRECTORY.")
2170 Lisp_Object directory
;
2173 Lisp_Object handler
;
2175 CHECK_STRING (directory
, 0);
2176 directory
= Fexpand_file_name (directory
, Qnil
);
2178 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2179 if (!NILP (handler
))
2180 return call2 (handler
, Qmake_directory_internal
, directory
);
2182 dir
= XSTRING (directory
)->data
;
2185 if (mkdir (dir
) != 0)
2187 if (mkdir (dir
, 0777) != 0)
2189 report_file_error ("Creating directory", Flist (1, &directory
));
2194 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2195 "Delete the directory named DIRECTORY.")
2197 Lisp_Object directory
;
2200 Lisp_Object handler
;
2202 CHECK_STRING (directory
, 0);
2203 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2204 dir
= XSTRING (directory
)->data
;
2206 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2207 if (!NILP (handler
))
2208 return call2 (handler
, Qdelete_directory
, directory
);
2210 if (rmdir (dir
) != 0)
2211 report_file_error ("Removing directory", Flist (1, &directory
));
2216 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2217 "Delete file named FILENAME.\n\
2218 If file has multiple names, it continues to exist with the other names.")
2220 Lisp_Object filename
;
2222 Lisp_Object handler
;
2223 CHECK_STRING (filename
, 0);
2224 filename
= Fexpand_file_name (filename
, Qnil
);
2226 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2227 if (!NILP (handler
))
2228 return call2 (handler
, Qdelete_file
, filename
);
2230 if (0 > unlink (XSTRING (filename
)->data
))
2231 report_file_error ("Removing old name", Flist (1, &filename
));
2236 internal_delete_file_1 (ignore
)
2242 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2245 internal_delete_file (filename
)
2246 Lisp_Object filename
;
2248 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2249 Qt
, internal_delete_file_1
));
2252 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2253 "fRename file: \nFRename %s to file: \np",
2254 "Rename FILE as NEWNAME. Both args strings.\n\
2255 If file has names other than FILE, it continues to have those names.\n\
2256 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2257 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2258 A number as third arg means request confirmation if NEWNAME already exists.\n\
2259 This is what happens in interactive use with M-x.")
2260 (file
, newname
, ok_if_already_exists
)
2261 Lisp_Object file
, newname
, ok_if_already_exists
;
2264 Lisp_Object args
[2];
2266 Lisp_Object handler
;
2267 struct gcpro gcpro1
, gcpro2
;
2269 GCPRO2 (file
, newname
);
2270 CHECK_STRING (file
, 0);
2271 CHECK_STRING (newname
, 1);
2272 file
= Fexpand_file_name (file
, Qnil
);
2273 newname
= Fexpand_file_name (newname
, Qnil
);
2275 /* If the file name has special constructs in it,
2276 call the corresponding file handler. */
2277 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2279 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2280 if (!NILP (handler
))
2281 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2282 file
, newname
, ok_if_already_exists
));
2284 if (NILP (ok_if_already_exists
)
2285 || INTEGERP (ok_if_already_exists
))
2286 barf_or_query_if_file_exists (newname
, "rename to it",
2287 INTEGERP (ok_if_already_exists
), 0);
2289 if (0 > rename (XSTRING (file
)->data
, XSTRING (newname
)->data
))
2291 if (0 > link (XSTRING (file
)->data
, XSTRING (newname
)->data
)
2292 || 0 > unlink (XSTRING (file
)->data
))
2297 Fcopy_file (file
, newname
,
2298 /* We have already prompted if it was an integer,
2299 so don't have copy-file prompt again. */
2300 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2301 Fdelete_file (file
);
2308 report_file_error ("Renaming", Flist (2, args
));
2311 report_file_error ("Renaming", Flist (2, &file
));
2318 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2319 "fAdd name to file: \nFName to add to %s: \np",
2320 "Give FILE additional name NEWNAME. Both args strings.\n\
2321 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2322 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2323 A number as third arg means request confirmation if NEWNAME already exists.\n\
2324 This is what happens in interactive use with M-x.")
2325 (file
, newname
, ok_if_already_exists
)
2326 Lisp_Object file
, newname
, ok_if_already_exists
;
2329 Lisp_Object args
[2];
2331 Lisp_Object handler
;
2332 struct gcpro gcpro1
, gcpro2
;
2334 GCPRO2 (file
, newname
);
2335 CHECK_STRING (file
, 0);
2336 CHECK_STRING (newname
, 1);
2337 file
= Fexpand_file_name (file
, Qnil
);
2338 newname
= Fexpand_file_name (newname
, Qnil
);
2340 /* If the file name has special constructs in it,
2341 call the corresponding file handler. */
2342 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2343 if (!NILP (handler
))
2344 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2345 newname
, ok_if_already_exists
));
2347 /* If the new name has special constructs in it,
2348 call the corresponding file handler. */
2349 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2350 if (!NILP (handler
))
2351 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2352 newname
, ok_if_already_exists
));
2354 if (NILP (ok_if_already_exists
)
2355 || INTEGERP (ok_if_already_exists
))
2356 barf_or_query_if_file_exists (newname
, "make it a new name",
2357 INTEGERP (ok_if_already_exists
), 0);
2359 /* Windows does not support this operation. */
2360 report_file_error ("Adding new name", Flist (2, &file
));
2361 #else /* not WINDOWSNT */
2363 unlink (XSTRING (newname
)->data
);
2364 if (0 > link (XSTRING (file
)->data
, XSTRING (newname
)->data
))
2369 report_file_error ("Adding new name", Flist (2, args
));
2371 report_file_error ("Adding new name", Flist (2, &file
));
2374 #endif /* not WINDOWSNT */
2381 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2382 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2383 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2384 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2385 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2386 A number as third arg means request confirmation if LINKNAME already exists.\n\
2387 This happens for interactive use with M-x.")
2388 (filename
, linkname
, ok_if_already_exists
)
2389 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2392 Lisp_Object args
[2];
2394 Lisp_Object handler
;
2395 struct gcpro gcpro1
, gcpro2
;
2397 GCPRO2 (filename
, linkname
);
2398 CHECK_STRING (filename
, 0);
2399 CHECK_STRING (linkname
, 1);
2400 /* If the link target has a ~, we must expand it to get
2401 a truly valid file name. Otherwise, do not expand;
2402 we want to permit links to relative file names. */
2403 if (XSTRING (filename
)->data
[0] == '~')
2404 filename
= Fexpand_file_name (filename
, Qnil
);
2405 linkname
= Fexpand_file_name (linkname
, Qnil
);
2407 /* If the file name has special constructs in it,
2408 call the corresponding file handler. */
2409 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2410 if (!NILP (handler
))
2411 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2412 linkname
, ok_if_already_exists
));
2414 /* If the new link name has special constructs in it,
2415 call the corresponding file handler. */
2416 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2417 if (!NILP (handler
))
2418 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2419 linkname
, ok_if_already_exists
));
2421 if (NILP (ok_if_already_exists
)
2422 || INTEGERP (ok_if_already_exists
))
2423 barf_or_query_if_file_exists (linkname
, "make it a link",
2424 INTEGERP (ok_if_already_exists
), 0);
2425 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2427 /* If we didn't complain already, silently delete existing file. */
2428 if (errno
== EEXIST
)
2430 unlink (XSTRING (linkname
)->data
);
2431 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2441 report_file_error ("Making symbolic link", Flist (2, args
));
2443 report_file_error ("Making symbolic link", Flist (2, &filename
));
2449 #endif /* S_IFLNK */
2453 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2454 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2455 "Define the job-wide logical name NAME to have the value STRING.\n\
2456 If STRING is nil or a null string, the logical name NAME is deleted.")
2461 CHECK_STRING (name
, 0);
2463 delete_logical_name (XSTRING (name
)->data
);
2466 CHECK_STRING (string
, 1);
2468 if (XSTRING (string
)->size
== 0)
2469 delete_logical_name (XSTRING (name
)->data
);
2471 define_logical_name (XSTRING (name
)->data
, XSTRING (string
)->data
);
2480 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2481 "Open a network connection to PATH using LOGIN as the login string.")
2483 Lisp_Object path
, login
;
2487 CHECK_STRING (path
, 0);
2488 CHECK_STRING (login
, 0);
2490 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2492 if (netresult
== -1)
2497 #endif /* HPUX_NET */
2499 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2501 "Return t if file FILENAME specifies an absolute file name.\n\
2502 On Unix, this is a name starting with a `/' or a `~'.")
2504 Lisp_Object filename
;
2508 CHECK_STRING (filename
, 0);
2509 ptr
= XSTRING (filename
)->data
;
2510 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2512 /* ??? This criterion is probably wrong for '<'. */
2513 || index (ptr
, ':') || index (ptr
, '<')
2514 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2518 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2526 /* Return nonzero if file FILENAME exists and can be executed. */
2529 check_executable (filename
)
2533 int len
= strlen (filename
);
2536 if (stat (filename
, &st
) < 0)
2538 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2539 return ((st
.st_mode
& S_IEXEC
) != 0);
2541 return (S_ISREG (st
.st_mode
)
2543 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2544 || stricmp (suffix
, ".exe") == 0
2545 || stricmp (suffix
, ".bat") == 0)
2546 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2547 #endif /* not WINDOWSNT */
2548 #else /* not DOS_NT */
2549 #ifdef HAVE_EUIDACCESS
2550 return (euidaccess (filename
, 1) >= 0);
2552 /* Access isn't quite right because it uses the real uid
2553 and we really want to test with the effective uid.
2554 But Unix doesn't give us a right way to do it. */
2555 return (access (filename
, 1) >= 0);
2557 #endif /* not DOS_NT */
2560 /* Return nonzero if file FILENAME exists and can be written. */
2563 check_writable (filename
)
2568 if (stat (filename
, &st
) < 0)
2570 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2571 #else /* not MSDOS */
2572 #ifdef HAVE_EUIDACCESS
2573 return (euidaccess (filename
, 2) >= 0);
2575 /* Access isn't quite right because it uses the real uid
2576 and we really want to test with the effective uid.
2577 But Unix doesn't give us a right way to do it.
2578 Opening with O_WRONLY could work for an ordinary file,
2579 but would lose for directories. */
2580 return (access (filename
, 2) >= 0);
2582 #endif /* not MSDOS */
2585 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2586 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2587 See also `file-readable-p' and `file-attributes'.")
2589 Lisp_Object filename
;
2591 Lisp_Object absname
;
2592 Lisp_Object handler
;
2593 struct stat statbuf
;
2595 CHECK_STRING (filename
, 0);
2596 absname
= Fexpand_file_name (filename
, Qnil
);
2598 /* If the file name has special constructs in it,
2599 call the corresponding file handler. */
2600 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2601 if (!NILP (handler
))
2602 return call2 (handler
, Qfile_exists_p
, absname
);
2604 return (stat (XSTRING (absname
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2607 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2608 "Return t if FILENAME can be executed by you.\n\
2609 For a directory, this means you can access files in that directory.")
2611 Lisp_Object filename
;
2614 Lisp_Object absname
;
2615 Lisp_Object handler
;
2617 CHECK_STRING (filename
, 0);
2618 absname
= Fexpand_file_name (filename
, Qnil
);
2620 /* If the file name has special constructs in it,
2621 call the corresponding file handler. */
2622 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2623 if (!NILP (handler
))
2624 return call2 (handler
, Qfile_executable_p
, absname
);
2626 return (check_executable (XSTRING (absname
)->data
) ? Qt
: Qnil
);
2629 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2630 "Return t if file FILENAME exists and you can read it.\n\
2631 See also `file-exists-p' and `file-attributes'.")
2633 Lisp_Object filename
;
2635 Lisp_Object absname
;
2636 Lisp_Object handler
;
2639 CHECK_STRING (filename
, 0);
2640 absname
= Fexpand_file_name (filename
, Qnil
);
2642 /* If the file name has special constructs in it,
2643 call the corresponding file handler. */
2644 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2645 if (!NILP (handler
))
2646 return call2 (handler
, Qfile_readable_p
, absname
);
2649 /* Under MS-DOS and Windows, open does not work for directories. */
2650 if (access (XSTRING (absname
)->data
, 0) == 0)
2653 #else /* not DOS_NT */
2654 desc
= open (XSTRING (absname
)->data
, O_RDONLY
);
2659 #endif /* not DOS_NT */
2662 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2664 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2665 "Return t if file FILENAME can be written or created by you.")
2667 Lisp_Object filename
;
2669 Lisp_Object absname
, dir
;
2670 Lisp_Object handler
;
2671 struct stat statbuf
;
2673 CHECK_STRING (filename
, 0);
2674 absname
= Fexpand_file_name (filename
, Qnil
);
2676 /* If the file name has special constructs in it,
2677 call the corresponding file handler. */
2678 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2679 if (!NILP (handler
))
2680 return call2 (handler
, Qfile_writable_p
, absname
);
2682 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
2683 return (check_writable (XSTRING (absname
)->data
)
2685 dir
= Ffile_name_directory (absname
);
2688 dir
= Fdirectory_file_name (dir
);
2692 dir
= Fdirectory_file_name (dir
);
2694 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2698 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2699 "Access file FILENAME, and get an error if that does not work.\n\
2700 The second argument STRING is used in the error message.\n\
2701 If there is no error, we return nil.")
2703 Lisp_Object filename
, string
;
2705 Lisp_Object handler
;
2708 CHECK_STRING (filename
, 0);
2710 /* If the file name has special constructs in it,
2711 call the corresponding file handler. */
2712 handler
= Ffind_file_name_handler (filename
, Qaccess_file
);
2713 if (!NILP (handler
))
2714 return call3 (handler
, Qaccess_file
, filename
, string
);
2716 fd
= open (XSTRING (filename
)->data
, O_RDONLY
);
2718 report_file_error (XSTRING (string
)->data
, Fcons (filename
, Qnil
));
2724 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2725 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2726 The value is the name of the file to which it is linked.\n\
2727 Otherwise returns nil.")
2729 Lisp_Object filename
;
2736 Lisp_Object handler
;
2738 CHECK_STRING (filename
, 0);
2739 filename
= Fexpand_file_name (filename
, Qnil
);
2741 /* If the file name has special constructs in it,
2742 call the corresponding file handler. */
2743 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2744 if (!NILP (handler
))
2745 return call2 (handler
, Qfile_symlink_p
, filename
);
2750 buf
= (char *) xmalloc (bufsize
);
2751 bzero (buf
, bufsize
);
2752 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2753 if (valsize
< bufsize
) break;
2754 /* Buffer was not long enough */
2763 val
= make_string (buf
, valsize
);
2766 #else /* not S_IFLNK */
2768 #endif /* not S_IFLNK */
2771 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2772 "Return t if file FILENAME is the name of a directory as a file.\n\
2773 A directory name spec may be given instead; then the value is t\n\
2774 if the directory so specified exists and really is a directory.")
2776 Lisp_Object filename
;
2778 register Lisp_Object absname
;
2780 Lisp_Object handler
;
2782 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2784 /* If the file name has special constructs in it,
2785 call the corresponding file handler. */
2786 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2787 if (!NILP (handler
))
2788 return call2 (handler
, Qfile_directory_p
, absname
);
2790 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2792 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2795 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2796 "Return t if file FILENAME is the name of a directory as a file,\n\
2797 and files in that directory can be opened by you. In order to use a\n\
2798 directory as a buffer's current directory, this predicate must return true.\n\
2799 A directory name spec may be given instead; then the value is t\n\
2800 if the directory so specified exists and really is a readable and\n\
2801 searchable directory.")
2803 Lisp_Object filename
;
2805 Lisp_Object handler
;
2807 struct gcpro gcpro1
;
2809 /* If the file name has special constructs in it,
2810 call the corresponding file handler. */
2811 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2812 if (!NILP (handler
))
2813 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2815 /* It's an unlikely combination, but yes we really do need to gcpro:
2816 Suppose that file-accessible-directory-p has no handler, but
2817 file-directory-p does have a handler; this handler causes a GC which
2818 relocates the string in `filename'; and finally file-directory-p
2819 returns non-nil. Then we would end up passing a garbaged string
2820 to file-executable-p. */
2822 tem
= (NILP (Ffile_directory_p (filename
))
2823 || NILP (Ffile_executable_p (filename
)));
2825 return tem
? Qnil
: Qt
;
2828 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2829 "Return t if file FILENAME is the name of a regular file.\n\
2830 This is the sort of file that holds an ordinary stream of data bytes.")
2832 Lisp_Object filename
;
2834 register Lisp_Object absname
;
2836 Lisp_Object handler
;
2838 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2840 /* If the file name has special constructs in it,
2841 call the corresponding file handler. */
2842 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
2843 if (!NILP (handler
))
2844 return call2 (handler
, Qfile_regular_p
, absname
);
2846 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2848 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2851 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2852 "Return mode bits of file named FILENAME, as an integer.")
2854 Lisp_Object filename
;
2856 Lisp_Object absname
;
2858 Lisp_Object handler
;
2860 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2862 /* If the file name has special constructs in it,
2863 call the corresponding file handler. */
2864 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
2865 if (!NILP (handler
))
2866 return call2 (handler
, Qfile_modes
, absname
);
2868 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2870 #if defined (MSDOS) && __DJGPP__ < 2
2871 if (check_executable (XSTRING (absname
)->data
))
2872 st
.st_mode
|= S_IEXEC
;
2873 #endif /* MSDOS && __DJGPP__ < 2 */
2875 return make_number (st
.st_mode
& 07777);
2878 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2879 "Set mode bits of file named FILENAME to MODE (an integer).\n\
2880 Only the 12 low bits of MODE are used.")
2882 Lisp_Object filename
, mode
;
2884 Lisp_Object absname
;
2885 Lisp_Object handler
;
2887 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
2888 CHECK_NUMBER (mode
, 1);
2890 /* If the file name has special constructs in it,
2891 call the corresponding file handler. */
2892 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
2893 if (!NILP (handler
))
2894 return call3 (handler
, Qset_file_modes
, absname
, mode
);
2896 if (chmod (XSTRING (absname
)->data
, XINT (mode
)) < 0)
2897 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
2902 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2903 "Set the file permission bits for newly created files.\n\
2904 The argument MODE should be an integer; only the low 9 bits are used.\n\
2905 This setting is inherited by subprocesses.")
2909 CHECK_NUMBER (mode
, 0);
2911 umask ((~ XINT (mode
)) & 0777);
2916 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2917 "Return the default file protection for created files.\n\
2918 The value is an integer.")
2924 realmask
= umask (0);
2927 XSETINT (value
, (~ realmask
) & 0777);
2933 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2934 "Tell Unix to finish all pending disk updates.")
2943 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2944 "Return t if file FILE1 is newer than file FILE2.\n\
2945 If FILE1 does not exist, the answer is nil;\n\
2946 otherwise, if FILE2 does not exist, the answer is t.")
2948 Lisp_Object file1
, file2
;
2950 Lisp_Object absname1
, absname2
;
2953 Lisp_Object handler
;
2954 struct gcpro gcpro1
, gcpro2
;
2956 CHECK_STRING (file1
, 0);
2957 CHECK_STRING (file2
, 0);
2960 GCPRO2 (absname1
, file2
);
2961 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2962 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2965 /* If the file name has special constructs in it,
2966 call the corresponding file handler. */
2967 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
2969 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
2970 if (!NILP (handler
))
2971 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
2973 if (stat (XSTRING (absname1
)->data
, &st
) < 0)
2976 mtime1
= st
.st_mtime
;
2978 if (stat (XSTRING (absname2
)->data
, &st
) < 0)
2981 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2985 Lisp_Object Qfind_buffer_file_type
;
2988 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2990 "Insert contents of file FILENAME after point.\n\
2991 Returns list of absolute file name and length of data inserted.\n\
2992 If second argument VISIT is non-nil, the buffer's visited filename\n\
2993 and last save file modtime are set, and it is marked unmodified.\n\
2994 If visiting and the file does not exist, visiting is completed\n\
2995 before the error is signaled.\n\n\
2996 The optional third and fourth arguments BEG and END\n\
2997 specify what portion of the file to insert.\n\
2998 If VISIT is non-nil, BEG and END must be nil.\n\
2999 If optional fifth argument REPLACE is non-nil,\n\
3000 it means replace the current buffer contents (in the accessible portion)\n\
3001 with the file contents. This is better than simply deleting and inserting\n\
3002 the whole thing because (1) it preserves some marker positions\n\
3003 and (2) it puts less data in the undo list.")
3004 (filename
, visit
, beg
, end
, replace
)
3005 Lisp_Object filename
, visit
, beg
, end
, replace
;
3009 register int inserted
= 0;
3010 register int how_much
;
3011 int count
= specpdl_ptr
- specpdl
;
3012 struct gcpro gcpro1
, gcpro2
, gcpro3
;
3013 Lisp_Object handler
, val
, insval
;
3016 int not_regular
= 0;
3018 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3019 error ("Cannot do file visiting in an indirect buffer");
3021 if (!NILP (current_buffer
->read_only
))
3022 Fbarf_if_buffer_read_only ();
3027 GCPRO3 (filename
, val
, p
);
3029 CHECK_STRING (filename
, 0);
3030 filename
= Fexpand_file_name (filename
, Qnil
);
3032 /* If the file name has special constructs in it,
3033 call the corresponding file handler. */
3034 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3035 if (!NILP (handler
))
3037 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3038 visit
, beg
, end
, replace
);
3045 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3047 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
3048 || fstat (fd
, &st
) < 0)
3049 #endif /* not APOLLO */
3051 if (fd
>= 0) close (fd
);
3054 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3061 /* This code will need to be changed in order to work on named
3062 pipes, and it's probably just not worth it. So we should at
3063 least signal an error. */
3064 if (!S_ISREG (st
.st_mode
))
3067 Fsignal (Qfile_error
,
3068 Fcons (build_string ("not a regular file"),
3069 Fcons (filename
, Qnil
)));
3077 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
3080 /* Replacement should preserve point as it preserves markers. */
3081 if (!NILP (replace
))
3082 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3084 record_unwind_protect (close_file_unwind
, make_number (fd
));
3086 /* Supposedly happens on VMS. */
3088 error ("File size is negative");
3090 if (!NILP (beg
) || !NILP (end
))
3092 error ("Attempt to visit less than an entire file");
3095 CHECK_NUMBER (beg
, 0);
3097 XSETFASTINT (beg
, 0);
3100 CHECK_NUMBER (end
, 0);
3103 XSETINT (end
, st
.st_size
);
3104 if (XINT (end
) != st
.st_size
)
3105 error ("maximum buffer size exceeded");
3108 /* If requested, replace the accessible part of the buffer
3109 with the file contents. Avoid replacing text at the
3110 beginning or end of the buffer that matches the file contents;
3111 that preserves markers pointing to the unchanged parts. */
3113 /* On MSDOS, replace mode doesn't really work, except for binary files,
3114 and it's not worth supporting just for them. */
3115 if (!NILP (replace
))
3118 XSETFASTINT (beg
, 0);
3119 XSETFASTINT (end
, st
.st_size
);
3120 del_range_1 (BEGV
, ZV
, 0);
3122 #else /* not DOS_NT */
3123 if (!NILP (replace
))
3125 unsigned char buffer
[1 << 14];
3126 int same_at_start
= BEGV
;
3127 int same_at_end
= ZV
;
3132 /* Count how many chars at the start of the file
3133 match the text at the beginning of the buffer. */
3138 nread
= read (fd
, buffer
, sizeof buffer
);
3140 error ("IO error reading %s: %s",
3141 XSTRING (filename
)->data
, strerror (errno
));
3142 else if (nread
== 0)
3145 while (bufpos
< nread
&& same_at_start
< ZV
3146 && FETCH_CHAR (same_at_start
) == buffer
[bufpos
])
3147 same_at_start
++, bufpos
++;
3148 /* If we found a discrepancy, stop the scan.
3149 Otherwise loop around and scan the next bufferful. */
3150 if (bufpos
!= nread
)
3154 /* If the file matches the buffer completely,
3155 there's no need to replace anything. */
3156 if (same_at_start
- BEGV
== st
.st_size
)
3160 /* Truncate the buffer to the size of the file. */
3161 del_range_1 (same_at_start
, same_at_end
, 0);
3166 /* Count how many chars at the end of the file
3167 match the text at the end of the buffer. */
3170 int total_read
, nread
, bufpos
, curpos
, trial
;
3172 /* At what file position are we now scanning? */
3173 curpos
= st
.st_size
- (ZV
- same_at_end
);
3174 /* If the entire file matches the buffer tail, stop the scan. */
3177 /* How much can we scan in the next step? */
3178 trial
= min (curpos
, sizeof buffer
);
3179 if (lseek (fd
, curpos
- trial
, 0) < 0)
3180 report_file_error ("Setting file position",
3181 Fcons (filename
, Qnil
));
3184 while (total_read
< trial
)
3186 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
3188 error ("IO error reading %s: %s",
3189 XSTRING (filename
)->data
, strerror (errno
));
3190 total_read
+= nread
;
3192 /* Scan this bufferful from the end, comparing with
3193 the Emacs buffer. */
3194 bufpos
= total_read
;
3195 /* Compare with same_at_start to avoid counting some buffer text
3196 as matching both at the file's beginning and at the end. */
3197 while (bufpos
> 0 && same_at_end
> same_at_start
3198 && FETCH_CHAR (same_at_end
- 1) == buffer
[bufpos
- 1])
3199 same_at_end
--, bufpos
--;
3200 /* If we found a discrepancy, stop the scan.
3201 Otherwise loop around and scan the preceding bufferful. */
3204 /* If display current starts at beginning of line,
3205 keep it that way. */
3206 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3207 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3211 /* Don't try to reuse the same piece of text twice. */
3212 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
3214 same_at_end
+= overlap
;
3216 /* Arrange to read only the nonmatching middle part of the file. */
3217 XSETFASTINT (beg
, same_at_start
- BEGV
);
3218 XSETFASTINT (end
, st
.st_size
- (ZV
- same_at_end
));
3220 del_range_1 (same_at_start
, same_at_end
, 0);
3221 /* Insert from the file at the proper position. */
3222 SET_PT (same_at_start
);
3224 #endif /* not DOS_NT */
3226 total
= XINT (end
) - XINT (beg
);
3229 register Lisp_Object temp
;
3231 /* Make sure point-max won't overflow after this insertion. */
3232 XSETINT (temp
, total
);
3233 if (total
!= XINT (temp
))
3234 error ("maximum buffer size exceeded");
3237 if (NILP (visit
) && total
> 0)
3238 prepare_to_modify_buffer (PT
, PT
);
3241 if (GAP_SIZE
< total
)
3242 make_gap (total
- GAP_SIZE
);
3244 if (XINT (beg
) != 0 || !NILP (replace
))
3246 if (lseek (fd
, XINT (beg
), 0) < 0)
3247 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
3251 while (inserted
< total
)
3253 /* try is reserved in some compilers (Microsoft C) */
3254 int trytry
= min (total
- inserted
, 64 << 10);
3257 /* Allow quitting out of the actual I/O. */
3260 this = read (fd
, &FETCH_CHAR (PT
+ inserted
- 1) + 1, trytry
);
3277 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
3278 /* Determine file type from name and remove LFs from CR-LFs if the file
3279 is deemed to be a text file. */
3281 current_buffer
->buffer_file_type
3282 = call1 (Qfind_buffer_file_type
, filename
);
3283 if (NILP (current_buffer
->buffer_file_type
))
3286 = inserted
- crlf_to_lf (inserted
, &FETCH_CHAR (PT
- 1) + 1);
3289 GPT
-= reduced_size
;
3290 GAP_SIZE
+= reduced_size
;
3291 inserted
-= reduced_size
;
3298 record_insert (PT
, inserted
);
3300 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
3301 offset_intervals (current_buffer
, PT
, inserted
);
3307 /* Discard the unwind protect for closing the file. */
3311 error ("IO error reading %s: %s",
3312 XSTRING (filename
)->data
, strerror (errno
));
3319 if (!EQ (current_buffer
->undo_list
, Qt
))
3320 current_buffer
->undo_list
= Qnil
;
3322 stat (XSTRING (filename
)->data
, &st
);
3327 current_buffer
->modtime
= st
.st_mtime
;
3328 current_buffer
->filename
= filename
;
3331 SAVE_MODIFF
= MODIFF
;
3332 current_buffer
->auto_save_modified
= MODIFF
;
3333 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3334 #ifdef CLASH_DETECTION
3337 if (!NILP (current_buffer
->file_truename
))
3338 unlock_file (current_buffer
->file_truename
);
3339 unlock_file (filename
);
3341 #endif /* CLASH_DETECTION */
3343 Fsignal (Qfile_error
,
3344 Fcons (build_string ("not a regular file"),
3345 Fcons (filename
, Qnil
)));
3347 /* If visiting nonexistent file, return nil. */
3348 if (current_buffer
->modtime
== -1)
3349 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3352 /* Decode file format */
3355 insval
= call3 (Qformat_decode
,
3356 Qnil
, make_number (inserted
), visit
);
3357 CHECK_NUMBER (insval
, 0);
3358 inserted
= XFASTINT (insval
);
3361 if (inserted
> 0 && NILP (visit
) && total
> 0)
3362 signal_after_change (PT
, 0, inserted
);
3366 p
= Vafter_insert_file_functions
;
3369 insval
= call1 (Fcar (p
), make_number (inserted
));
3372 CHECK_NUMBER (insval
, 0);
3373 inserted
= XFASTINT (insval
);
3381 val
= Fcons (filename
,
3382 Fcons (make_number (inserted
),
3385 RETURN_UNGCPRO (unbind_to (count
, val
));
3388 static Lisp_Object
build_annotations ();
3390 /* If build_annotations switched buffers, switch back to BUF.
3391 Kill the temporary buffer that was selected in the meantime. */
3394 build_annotations_unwind (buf
)
3399 if (XBUFFER (buf
) == current_buffer
)
3401 tembuf
= Fcurrent_buffer ();
3403 Fkill_buffer (tembuf
);
3407 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 6,
3408 "r\nFWrite region to file: ",
3409 "Write current region into specified file.\n\
3410 When called from a program, takes three arguments:\n\
3411 START, END and FILENAME. START and END are buffer positions.\n\
3412 Optional fourth argument APPEND if non-nil means\n\
3413 append to existing file contents (if any).\n\
3414 Optional fifth argument VISIT if t means\n\
3415 set the last-save-file-modtime of buffer to this file's modtime\n\
3416 and mark buffer not modified.\n\
3417 If VISIT is a string, it is a second file name;\n\
3418 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
3419 VISIT is also the file name to lock and unlock for clash detection.\n\
3420 If VISIT is neither t nor nil nor a string,\n\
3421 that means do not print the \"Wrote file\" message.\n\
3422 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
3423 use for locking and unlocking, overriding FILENAME and VISIT.\n\
3424 Kludgy feature: if START is a string, then that string is written\n\
3425 to the file, instead of any buffer contents, and END is ignored.")
3426 (start
, end
, filename
, append
, visit
, lockname
)
3427 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
3435 int count
= specpdl_ptr
- specpdl
;
3438 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3440 Lisp_Object handler
;
3441 Lisp_Object visit_file
;
3442 Lisp_Object annotations
;
3443 int visiting
, quietly
;
3444 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3445 struct buffer
*given_buffer
;
3447 int buffer_file_type
3448 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
3451 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3452 error ("Cannot do file visiting in an indirect buffer");
3454 if (!NILP (start
) && !STRINGP (start
))
3455 validate_region (&start
, &end
);
3457 GCPRO3 (filename
, visit
, lockname
);
3458 filename
= Fexpand_file_name (filename
, Qnil
);
3459 if (STRINGP (visit
))
3460 visit_file
= Fexpand_file_name (visit
, Qnil
);
3462 visit_file
= filename
;
3465 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
3466 quietly
= !NILP (visit
);
3470 if (NILP (lockname
))
3471 lockname
= visit_file
;
3473 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
3475 /* If the file name has special constructs in it,
3476 call the corresponding file handler. */
3477 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
3478 /* If FILENAME has no handler, see if VISIT has one. */
3479 if (NILP (handler
) && STRINGP (visit
))
3480 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
3482 if (!NILP (handler
))
3485 val
= call6 (handler
, Qwrite_region
, start
, end
,
3486 filename
, append
, visit
);
3490 SAVE_MODIFF
= MODIFF
;
3491 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3492 current_buffer
->filename
= visit_file
;
3498 /* Special kludge to simplify auto-saving. */
3501 XSETFASTINT (start
, BEG
);
3502 XSETFASTINT (end
, Z
);
3505 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
3506 count1
= specpdl_ptr
- specpdl
;
3508 given_buffer
= current_buffer
;
3509 annotations
= build_annotations (start
, end
);
3510 if (current_buffer
!= given_buffer
)
3516 #ifdef CLASH_DETECTION
3518 lock_file (lockname
);
3519 #endif /* CLASH_DETECTION */
3521 fn
= XSTRING (filename
)->data
;
3525 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
3526 #else /* not DOS_NT */
3527 desc
= open (fn
, O_WRONLY
);
3528 #endif /* not DOS_NT */
3532 if (auto_saving
) /* Overwrite any previous version of autosave file */
3534 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3535 desc
= open (fn
, O_RDWR
);
3537 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3538 ? XSTRING (current_buffer
->filename
)->data
: 0,
3541 else /* Write to temporary name and rename if no errors */
3543 Lisp_Object temp_name
;
3544 temp_name
= Ffile_name_directory (filename
);
3546 if (!NILP (temp_name
))
3548 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3549 build_string ("$$SAVE$$")));
3550 fname
= XSTRING (filename
)->data
;
3551 fn
= XSTRING (temp_name
)->data
;
3552 desc
= creat_copy_attrs (fname
, fn
);
3555 /* If we can't open the temporary file, try creating a new
3556 version of the original file. VMS "creat" creates a
3557 new version rather than truncating an existing file. */
3560 desc
= creat (fn
, 0666);
3561 #if 0 /* This can clobber an existing file and fail to replace it,
3562 if the user runs out of space. */
3565 /* We can't make a new version;
3566 try to truncate and rewrite existing version if any. */
3568 desc
= open (fn
, O_RDWR
);
3574 desc
= creat (fn
, 0666);
3579 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3580 S_IREAD
| S_IWRITE
);
3581 #else /* not DOS_NT */
3582 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3583 #endif /* not DOS_NT */
3584 #endif /* not VMS */
3590 #ifdef CLASH_DETECTION
3592 if (!auto_saving
) unlock_file (lockname
);
3594 #endif /* CLASH_DETECTION */
3595 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
3598 record_unwind_protect (close_file_unwind
, make_number (desc
));
3601 if (lseek (desc
, 0, 2) < 0)
3603 #ifdef CLASH_DETECTION
3604 if (!auto_saving
) unlock_file (lockname
);
3605 #endif /* CLASH_DETECTION */
3606 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
3611 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3612 * if we do writes that don't end with a carriage return. Furthermore
3613 * it cannot handle writes of more then 16K. The modified
3614 * version of "sys_write" in SYSDEP.C (see comment there) copes with
3615 * this EXCEPT for the last record (iff it doesn't end with a carriage
3616 * return). This implies that if your buffer doesn't end with a carriage
3617 * return, you get one free... tough. However it also means that if
3618 * we make two calls to sys_write (a la the following code) you can
3619 * get one at the gap as well. The easiest way to fix this (honest)
3620 * is to move the gap to the next newline (or the end of the buffer).
3625 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
3626 move_gap (find_next_newline (GPT
, 1));
3632 if (STRINGP (start
))
3634 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
3635 XSTRING (start
)->size
, 0, &annotations
);
3638 else if (XINT (start
) != XINT (end
))
3641 if (XINT (start
) < GPT
)
3643 register int end1
= XINT (end
);
3645 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
),
3646 min (GPT
, end1
) - tem
, tem
, &annotations
);
3647 nwritten
+= min (GPT
, end1
) - tem
;
3651 if (XINT (end
) > GPT
&& !failure
)
3654 tem
= max (tem
, GPT
);
3655 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
,
3657 nwritten
+= XINT (end
) - tem
;
3663 /* If file was empty, still need to write the annotations */
3664 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
);
3671 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3672 Disk full in NFS may be reported here. */
3673 /* mib says that closing the file will try to write as fast as NFS can do
3674 it, and that means the fsync here is not crucial for autosave files. */
3675 if (!auto_saving
&& fsync (desc
) < 0)
3677 /* If fsync fails with EINTR, don't treat that as serious. */
3679 failure
= 1, save_errno
= errno
;
3683 /* Spurious "file has changed on disk" warnings have been
3684 observed on Suns as well.
3685 It seems that `close' can change the modtime, under nfs.
3687 (This has supposedly been fixed in Sunos 4,
3688 but who knows about all the other machines with NFS?) */
3691 /* On VMS and APOLLO, must do the stat after the close
3692 since closing changes the modtime. */
3695 /* Recall that #if defined does not work on VMS. */
3702 /* NFS can report a write failure now. */
3703 if (close (desc
) < 0)
3704 failure
= 1, save_errno
= errno
;
3707 /* If we wrote to a temporary name and had no errors, rename to real name. */
3711 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
3719 /* Discard the unwind protect for close_file_unwind. */
3720 specpdl_ptr
= specpdl
+ count1
;
3721 /* Restore the original current buffer. */
3722 visit_file
= unbind_to (count
, visit_file
);
3724 #ifdef CLASH_DETECTION
3726 unlock_file (lockname
);
3727 #endif /* CLASH_DETECTION */
3729 /* Do this before reporting IO error
3730 to avoid a "file has changed on disk" warning on
3731 next attempt to save. */
3733 current_buffer
->modtime
= st
.st_mtime
;
3736 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
3740 SAVE_MODIFF
= MODIFF
;
3741 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3742 current_buffer
->filename
= visit_file
;
3743 update_mode_lines
++;
3749 message ("Wrote %s", XSTRING (visit_file
)->data
);
3754 Lisp_Object
merge ();
3756 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
3757 "Return t if (car A) is numerically less than (car B).")
3761 return Flss (Fcar (a
), Fcar (b
));
3764 /* Build the complete list of annotations appropriate for writing out
3765 the text between START and END, by calling all the functions in
3766 write-region-annotate-functions and merging the lists they return.
3767 If one of these functions switches to a different buffer, we assume
3768 that buffer contains altered text. Therefore, the caller must
3769 make sure to restore the current buffer in all cases,
3770 as save-excursion would do. */
3773 build_annotations (start
, end
)
3774 Lisp_Object start
, end
;
3776 Lisp_Object annotations
;
3778 struct gcpro gcpro1
, gcpro2
;
3779 Lisp_Object original_buffer
;
3781 XSETBUFFER (original_buffer
, current_buffer
);
3784 p
= Vwrite_region_annotate_functions
;
3785 GCPRO2 (annotations
, p
);
3788 struct buffer
*given_buffer
= current_buffer
;
3789 Vwrite_region_annotations_so_far
= annotations
;
3790 res
= call2 (Fcar (p
), start
, end
);
3791 /* If the function makes a different buffer current,
3792 assume that means this buffer contains altered text to be output.
3793 Reset START and END from the buffer bounds
3794 and discard all previous annotations because they should have
3795 been dealt with by this function. */
3796 if (current_buffer
!= given_buffer
)
3802 Flength (res
); /* Check basic validity of return value */
3803 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3807 /* Now do the same for annotation functions implied by the file-format */
3808 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
3809 p
= Vauto_save_file_format
;
3811 p
= current_buffer
->file_format
;
3814 struct buffer
*given_buffer
= current_buffer
;
3815 Vwrite_region_annotations_so_far
= annotations
;
3816 res
= call4 (Qformat_annotate_function
, Fcar (p
), start
, end
,
3818 if (current_buffer
!= given_buffer
)
3825 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3832 /* Write to descriptor DESC the LEN characters starting at ADDR,
3833 assuming they start at position POS in the buffer.
3834 Intersperse with them the annotations from *ANNOT
3835 (those which fall within the range of positions POS to POS + LEN),
3836 each at its appropriate position.
3838 Modify *ANNOT by discarding elements as we output them.
3839 The return value is negative in case of system call failure. */
3842 a_write (desc
, addr
, len
, pos
, annot
)
3844 register char *addr
;
3851 int lastpos
= pos
+ len
;
3853 while (NILP (*annot
) || CONSP (*annot
))
3855 tem
= Fcar_safe (Fcar (*annot
));
3856 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
3857 nextpos
= XFASTINT (tem
);
3859 return e_write (desc
, addr
, lastpos
- pos
);
3862 if (0 > e_write (desc
, addr
, nextpos
- pos
))
3864 addr
+= nextpos
- pos
;
3867 tem
= Fcdr (Fcar (*annot
));
3870 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
))
3873 *annot
= Fcdr (*annot
);
3878 e_write (desc
, addr
, len
)
3880 register char *addr
;
3883 char buf
[16 * 1024];
3884 register char *p
, *end
;
3886 if (!EQ (current_buffer
->selective_display
, Qt
))
3887 return write (desc
, addr
, len
) - len
;
3891 end
= p
+ sizeof buf
;
3896 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
3905 if (write (desc
, buf
, p
- buf
) != p
- buf
)
3911 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
3912 Sverify_visited_file_modtime
, 1, 1, 0,
3913 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
3914 This means that the file has not been changed since it was visited or saved.")
3920 Lisp_Object handler
;
3922 CHECK_BUFFER (buf
, 0);
3925 if (!STRINGP (b
->filename
)) return Qt
;
3926 if (b
->modtime
== 0) return Qt
;
3928 /* If the file name has special constructs in it,
3929 call the corresponding file handler. */
3930 handler
= Ffind_file_name_handler (b
->filename
,
3931 Qverify_visited_file_modtime
);
3932 if (!NILP (handler
))
3933 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
3935 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
3937 /* If the file doesn't exist now and didn't exist before,
3938 we say that it isn't modified, provided the error is a tame one. */
3939 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
3944 if (st
.st_mtime
== b
->modtime
3945 /* If both are positive, accept them if they are off by one second. */
3946 || (st
.st_mtime
> 0 && b
->modtime
> 0
3947 && (st
.st_mtime
== b
->modtime
+ 1
3948 || st
.st_mtime
== b
->modtime
- 1)))
3953 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
3954 Sclear_visited_file_modtime
, 0, 0, 0,
3955 "Clear out records of last mod time of visited file.\n\
3956 Next attempt to save will certainly not complain of a discrepancy.")
3959 current_buffer
->modtime
= 0;
3963 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
3964 Svisited_file_modtime
, 0, 0, 0,
3965 "Return the current buffer's recorded visited file modification time.\n\
3966 The value is a list of the form (HIGH . LOW), like the time values\n\
3967 that `file-attributes' returns.")
3970 return long_to_cons ((unsigned long) current_buffer
->modtime
);
3973 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
3974 Sset_visited_file_modtime
, 0, 1, 0,
3975 "Update buffer's recorded modification time from the visited file's time.\n\
3976 Useful if the buffer was not read from the file normally\n\
3977 or if the file itself has been changed for some known benign reason.\n\
3978 An argument specifies the modification time value to use\n\
3979 \(instead of that of the visited file), in the form of a list\n\
3980 \(HIGH . LOW) or (HIGH LOW).")
3982 Lisp_Object time_list
;
3984 if (!NILP (time_list
))
3985 current_buffer
->modtime
= cons_to_long (time_list
);
3988 register Lisp_Object filename
;
3990 Lisp_Object handler
;
3992 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
3994 /* If the file name has special constructs in it,
3995 call the corresponding file handler. */
3996 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
3997 if (!NILP (handler
))
3998 /* The handler can find the file name the same way we did. */
3999 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
4000 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
4001 current_buffer
->modtime
= st
.st_mtime
;
4011 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
4012 Fsleep_for (make_number (1), Qnil
);
4013 message ("Autosaving...error!for %s", XSTRING (current_buffer
->name
)->data
);
4014 Fsleep_for (make_number (1), Qnil
);
4015 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
4016 Fsleep_for (make_number (1), Qnil
);
4026 /* Get visited file's mode to become the auto save file's mode. */
4027 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
4028 /* But make sure we can overwrite it later! */
4029 auto_save_mode_bits
= st
.st_mode
| 0600;
4031 auto_save_mode_bits
= 0666;
4034 Fwrite_region (Qnil
, Qnil
,
4035 current_buffer
->auto_save_file_name
,
4036 Qnil
, Qlambda
, Qnil
);
4040 do_auto_save_unwind (desc
) /* used as unwind-protect function */
4044 if (XINT (desc
) >= 0)
4045 close (XINT (desc
));
4049 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
4050 "Auto-save all buffers that need it.\n\
4051 This is all buffers that have auto-saving enabled\n\
4052 and are changed since last auto-saved.\n\
4053 Auto-saving writes the buffer into a file\n\
4054 so that your editing is not lost if the system crashes.\n\
4055 This file is not the file you visited; that changes only when you save.\n\
4056 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
4057 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
4058 A non-nil CURRENT-ONLY argument means save only current buffer.")
4059 (no_message
, current_only
)
4060 Lisp_Object no_message
, current_only
;
4062 struct buffer
*old
= current_buffer
, *b
;
4063 Lisp_Object tail
, buf
;
4065 char *omessage
= echo_area_glyphs
;
4066 int omessage_length
= echo_area_glyphs_length
;
4067 extern int minibuf_level
;
4068 int do_handled_files
;
4071 int count
= specpdl_ptr
- specpdl
;
4074 /* Ordinarily don't quit within this function,
4075 but don't make it impossible to quit (in case we get hung in I/O). */
4079 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
4080 point to non-strings reached from Vbuffer_alist. */
4085 if (!NILP (Vrun_hooks
))
4086 call1 (Vrun_hooks
, intern ("auto-save-hook"));
4088 if (STRINGP (Vauto_save_list_file_name
))
4090 Lisp_Object listfile
;
4091 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
4093 listdesc
= open (XSTRING (listfile
)->data
,
4094 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
4095 S_IREAD
| S_IWRITE
);
4096 #else /* not DOS_NT */
4097 listdesc
= creat (XSTRING (listfile
)->data
, 0666);
4098 #endif /* not DOS_NT */
4103 /* Arrange to close that file whether or not we get an error.
4104 Also reset auto_saving to 0. */
4105 record_unwind_protect (do_auto_save_unwind
, make_number (listdesc
));
4109 /* First, save all files which don't have handlers. If Emacs is
4110 crashing, the handlers may tweak what is causing Emacs to crash
4111 in the first place, and it would be a shame if Emacs failed to
4112 autosave perfectly ordinary files because it couldn't handle some
4114 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
4115 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
4117 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
4120 /* Record all the buffers that have auto save mode
4121 in the special file that lists them. For each of these buffers,
4122 Record visited name (if any) and auto save name. */
4123 if (STRINGP (b
->auto_save_file_name
)
4124 && listdesc
>= 0 && do_handled_files
== 0)
4126 if (!NILP (b
->filename
))
4128 write (listdesc
, XSTRING (b
->filename
)->data
,
4129 XSTRING (b
->filename
)->size
);
4131 write (listdesc
, "\n", 1);
4132 write (listdesc
, XSTRING (b
->auto_save_file_name
)->data
,
4133 XSTRING (b
->auto_save_file_name
)->size
);
4134 write (listdesc
, "\n", 1);
4137 if (!NILP (current_only
)
4138 && b
!= current_buffer
)
4141 /* Don't auto-save indirect buffers.
4142 The base buffer takes care of it. */
4146 /* Check for auto save enabled
4147 and file changed since last auto save
4148 and file changed since last real save. */
4149 if (STRINGP (b
->auto_save_file_name
)
4150 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
4151 && b
->auto_save_modified
< BUF_MODIFF (b
)
4152 /* -1 means we've turned off autosaving for a while--see below. */
4153 && XINT (b
->save_length
) >= 0
4154 && (do_handled_files
4155 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
4158 EMACS_TIME before_time
, after_time
;
4160 EMACS_GET_TIME (before_time
);
4162 /* If we had a failure, don't try again for 20 minutes. */
4163 if (b
->auto_save_failure_time
>= 0
4164 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
4167 if ((XFASTINT (b
->save_length
) * 10
4168 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
4169 /* A short file is likely to change a large fraction;
4170 spare the user annoying messages. */
4171 && XFASTINT (b
->save_length
) > 5000
4172 /* These messages are frequent and annoying for `*mail*'. */
4173 && !EQ (b
->filename
, Qnil
)
4174 && NILP (no_message
))
4176 /* It has shrunk too much; turn off auto-saving here. */
4177 message ("Buffer %s has shrunk a lot; auto save turned off there",
4178 XSTRING (b
->name
)->data
);
4179 /* Turn off auto-saving until there's a real save,
4180 and prevent any more warnings. */
4181 XSETINT (b
->save_length
, -1);
4182 Fsleep_for (make_number (1), Qnil
);
4185 set_buffer_internal (b
);
4186 if (!auto_saved
&& NILP (no_message
))
4187 message1 ("Auto-saving...");
4188 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
4190 b
->auto_save_modified
= BUF_MODIFF (b
);
4191 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4192 set_buffer_internal (old
);
4194 EMACS_GET_TIME (after_time
);
4196 /* If auto-save took more than 60 seconds,
4197 assume it was an NFS failure that got a timeout. */
4198 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
4199 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
4203 /* Prevent another auto save till enough input events come in. */
4204 record_auto_save ();
4206 if (auto_saved
&& NILP (no_message
))
4210 sit_for (1, 0, 0, 0);
4211 message2 (omessage
, omessage_length
);
4214 message1 ("Auto-saving...done");
4219 unbind_to (count
, Qnil
);
4223 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
4224 Sset_buffer_auto_saved
, 0, 0, 0,
4225 "Mark current buffer as auto-saved with its current text.\n\
4226 No auto-save file will be written until the buffer changes again.")
4229 current_buffer
->auto_save_modified
= MODIFF
;
4230 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4231 current_buffer
->auto_save_failure_time
= -1;
4235 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
4236 Sclear_buffer_auto_save_failure
, 0, 0, 0,
4237 "Clear any record of a recent auto-save failure in the current buffer.")
4240 current_buffer
->auto_save_failure_time
= -1;
4244 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
4246 "Return t if buffer has been auto-saved since last read in or saved.")
4249 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
4252 /* Reading and completing file names */
4253 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
4255 /* In the string VAL, change each $ to $$ and return the result. */
4258 double_dollars (val
)
4261 register unsigned char *old
, *new;
4265 osize
= XSTRING (val
)->size
;
4266 /* Quote "$" as "$$" to get it past substitute-in-file-name */
4267 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
4268 if (*old
++ == '$') count
++;
4271 old
= XSTRING (val
)->data
;
4272 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
4273 new = XSTRING (val
)->data
;
4274 for (n
= osize
; n
> 0; n
--)
4287 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
4289 "Internal subroutine for read-file-name. Do not call this.")
4290 (string
, dir
, action
)
4291 Lisp_Object string
, dir
, action
;
4292 /* action is nil for complete, t for return list of completions,
4293 lambda for verify final value */
4295 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
4297 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4304 /* No need to protect ACTION--we only compare it with t and nil. */
4305 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
4307 if (XSTRING (string
)->size
== 0)
4309 if (EQ (action
, Qlambda
))
4317 orig_string
= string
;
4318 string
= Fsubstitute_in_file_name (string
);
4319 changed
= NILP (Fstring_equal (string
, orig_string
));
4320 name
= Ffile_name_nondirectory (string
);
4321 val
= Ffile_name_directory (string
);
4323 realdir
= Fexpand_file_name (val
, realdir
);
4328 specdir
= Ffile_name_directory (string
);
4329 val
= Ffile_name_completion (name
, realdir
);
4334 return double_dollars (string
);
4338 if (!NILP (specdir
))
4339 val
= concat2 (specdir
, val
);
4341 return double_dollars (val
);
4344 #endif /* not VMS */
4348 if (EQ (action
, Qt
))
4349 return Ffile_name_all_completions (name
, realdir
);
4350 /* Only other case actually used is ACTION = lambda */
4352 /* Supposedly this helps commands such as `cd' that read directory names,
4353 but can someone explain how it helps them? -- RMS */
4354 if (XSTRING (name
)->size
== 0)
4357 return Ffile_exists_p (string
);
4360 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4361 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
4362 Value is not expanded---you must call `expand-file-name' yourself.\n\
4363 Default name to DEFAULT-FILENAME if user enters a null string.\n\
4364 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
4365 except that if INITIAL is specified, that combined with DIR is used.)\n\
4366 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
4367 Non-nil and non-t means also require confirmation after completion.\n\
4368 Fifth arg INITIAL specifies text to start with.\n\
4369 DIR defaults to current buffer's directory default.")
4370 (prompt
, dir
, default_filename
, mustmatch
, initial
)
4371 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
4373 Lisp_Object val
, insdef
, insdef1
, tem
;
4374 struct gcpro gcpro1
, gcpro2
;
4375 register char *homedir
;
4379 dir
= current_buffer
->directory
;
4380 if (NILP (default_filename
))
4382 if (! NILP (initial
))
4383 default_filename
= Fexpand_file_name (initial
, dir
);
4385 default_filename
= current_buffer
->filename
;
4388 /* If dir starts with user's homedir, change that to ~. */
4389 homedir
= (char *) egetenv ("HOME");
4391 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
4392 CORRECT_DIR_SEPS (homedir
);
4396 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4397 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
4399 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4400 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4401 XSTRING (dir
)->data
[0] = '~';
4404 if (insert_default_directory
)
4407 if (!NILP (initial
))
4409 Lisp_Object args
[2], pos
;
4413 insdef
= Fconcat (2, args
);
4414 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
4415 insdef1
= Fcons (double_dollars (insdef
), pos
);
4418 insdef1
= double_dollars (insdef
);
4420 else if (!NILP (initial
))
4423 insdef1
= Fcons (double_dollars (insdef
), 0);
4426 insdef
= Qnil
, insdef1
= Qnil
;
4429 count
= specpdl_ptr
- specpdl
;
4430 specbind (intern ("completion-ignore-case"), Qt
);
4433 GCPRO2 (insdef
, default_filename
);
4434 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4435 dir
, mustmatch
, insdef1
,
4436 Qfile_name_history
);
4439 unbind_to (count
, Qnil
);
4444 error ("No file name specified");
4445 tem
= Fstring_equal (val
, insdef
);
4446 if (!NILP (tem
) && !NILP (default_filename
))
4447 return default_filename
;
4448 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
4450 if (!NILP (default_filename
))
4451 return default_filename
;
4453 error ("No default file name");
4455 return Fsubstitute_in_file_name (val
);
4458 #if 0 /* Old version */
4459 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4460 /* Don't confuse make-docfile by having two doc strings for this function.
4461 make-docfile does not pay attention to #if, for good reason! */
4463 (prompt
, dir
, defalt
, mustmatch
, initial
)
4464 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4466 Lisp_Object val
, insdef
, tem
;
4467 struct gcpro gcpro1
, gcpro2
;
4468 register char *homedir
;
4472 dir
= current_buffer
->directory
;
4474 defalt
= current_buffer
->filename
;
4476 /* If dir starts with user's homedir, change that to ~. */
4477 homedir
= (char *) egetenv ("HOME");
4480 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4481 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
4483 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4484 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4485 XSTRING (dir
)->data
[0] = '~';
4488 if (!NILP (initial
))
4490 else if (insert_default_directory
)
4493 insdef
= build_string ("");
4496 count
= specpdl_ptr
- specpdl
;
4497 specbind (intern ("completion-ignore-case"), Qt
);
4500 GCPRO2 (insdef
, defalt
);
4501 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4503 insert_default_directory
? insdef
: Qnil
,
4504 Qfile_name_history
);
4507 unbind_to (count
, Qnil
);
4512 error ("No file name specified");
4513 tem
= Fstring_equal (val
, insdef
);
4514 if (!NILP (tem
) && !NILP (defalt
))
4516 return Fsubstitute_in_file_name (val
);
4518 #endif /* Old version */
4522 Qexpand_file_name
= intern ("expand-file-name");
4523 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
4524 Qdirectory_file_name
= intern ("directory-file-name");
4525 Qfile_name_directory
= intern ("file-name-directory");
4526 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
4527 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
4528 Qfile_name_as_directory
= intern ("file-name-as-directory");
4529 Qcopy_file
= intern ("copy-file");
4530 Qmake_directory_internal
= intern ("make-directory-internal");
4531 Qdelete_directory
= intern ("delete-directory");
4532 Qdelete_file
= intern ("delete-file");
4533 Qrename_file
= intern ("rename-file");
4534 Qadd_name_to_file
= intern ("add-name-to-file");
4535 Qmake_symbolic_link
= intern ("make-symbolic-link");
4536 Qfile_exists_p
= intern ("file-exists-p");
4537 Qfile_executable_p
= intern ("file-executable-p");
4538 Qfile_readable_p
= intern ("file-readable-p");
4539 Qfile_writable_p
= intern ("file-writable-p");
4540 Qfile_symlink_p
= intern ("file-symlink-p");
4541 Qaccess_file
= intern ("access-file");
4542 Qfile_directory_p
= intern ("file-directory-p");
4543 Qfile_regular_p
= intern ("file-regular-p");
4544 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
4545 Qfile_modes
= intern ("file-modes");
4546 Qset_file_modes
= intern ("set-file-modes");
4547 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
4548 Qinsert_file_contents
= intern ("insert-file-contents");
4549 Qwrite_region
= intern ("write-region");
4550 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
4551 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
4553 staticpro (&Qexpand_file_name
);
4554 staticpro (&Qsubstitute_in_file_name
);
4555 staticpro (&Qdirectory_file_name
);
4556 staticpro (&Qfile_name_directory
);
4557 staticpro (&Qfile_name_nondirectory
);
4558 staticpro (&Qunhandled_file_name_directory
);
4559 staticpro (&Qfile_name_as_directory
);
4560 staticpro (&Qcopy_file
);
4561 staticpro (&Qmake_directory_internal
);
4562 staticpro (&Qdelete_directory
);
4563 staticpro (&Qdelete_file
);
4564 staticpro (&Qrename_file
);
4565 staticpro (&Qadd_name_to_file
);
4566 staticpro (&Qmake_symbolic_link
);
4567 staticpro (&Qfile_exists_p
);
4568 staticpro (&Qfile_executable_p
);
4569 staticpro (&Qfile_readable_p
);
4570 staticpro (&Qfile_writable_p
);
4571 staticpro (&Qaccess_file
);
4572 staticpro (&Qfile_symlink_p
);
4573 staticpro (&Qfile_directory_p
);
4574 staticpro (&Qfile_regular_p
);
4575 staticpro (&Qfile_accessible_directory_p
);
4576 staticpro (&Qfile_modes
);
4577 staticpro (&Qset_file_modes
);
4578 staticpro (&Qfile_newer_than_file_p
);
4579 staticpro (&Qinsert_file_contents
);
4580 staticpro (&Qwrite_region
);
4581 staticpro (&Qverify_visited_file_modtime
);
4582 staticpro (&Qset_visited_file_modtime
);
4584 Qfile_name_history
= intern ("file-name-history");
4585 Fset (Qfile_name_history
, Qnil
);
4586 staticpro (&Qfile_name_history
);
4588 Qfile_error
= intern ("file-error");
4589 staticpro (&Qfile_error
);
4590 Qfile_already_exists
= intern ("file-already-exists");
4591 staticpro (&Qfile_already_exists
);
4594 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
4595 staticpro (&Qfind_buffer_file_type
);
4598 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
4599 "*Format in which to write auto-save files.\n\
4600 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
4601 If it is t, which is the default, auto-save files are written in the\n\
4602 same format as a regular save would use.");
4603 Vauto_save_file_format
= Qt
;
4605 Qformat_decode
= intern ("format-decode");
4606 staticpro (&Qformat_decode
);
4607 Qformat_annotate_function
= intern ("format-annotate-function");
4608 staticpro (&Qformat_annotate_function
);
4610 Qcar_less_than_car
= intern ("car-less-than-car");
4611 staticpro (&Qcar_less_than_car
);
4613 Fput (Qfile_error
, Qerror_conditions
,
4614 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
4615 Fput (Qfile_error
, Qerror_message
,
4616 build_string ("File error"));
4618 Fput (Qfile_already_exists
, Qerror_conditions
,
4619 Fcons (Qfile_already_exists
,
4620 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
4621 Fput (Qfile_already_exists
, Qerror_message
,
4622 build_string ("File already exists"));
4624 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
4625 "*Non-nil means when reading a filename start with default dir in minibuffer.");
4626 insert_default_directory
= 1;
4628 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
4629 "*Non-nil means write new files with record format `stmlf'.\n\
4630 nil means use format `var'. This variable is meaningful only on VMS.");
4631 vms_stmlf_recfm
= 0;
4633 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
4634 "Directory separator character for built-in functions that return file names.\n\
4635 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
4636 This variable affects the built-in functions only on Windows,\n\
4637 on other platforms, it is initialized so that Lisp code can find out\n\
4638 what the normal separator is.");
4639 Vdirectory_sep_char
= '/';
4641 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
4642 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
4643 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
4646 The first argument given to HANDLER is the name of the I/O primitive\n\
4647 to be handled; the remaining arguments are the arguments that were\n\
4648 passed to that primitive. For example, if you do\n\
4649 (file-exists-p FILENAME)\n\
4650 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
4651 (funcall HANDLER 'file-exists-p FILENAME)\n\
4652 The function `find-file-name-handler' checks this list for a handler\n\
4653 for its argument.");
4654 Vfile_name_handler_alist
= Qnil
;
4656 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
4657 "A list of functions to be called at the end of `insert-file-contents'.\n\
4658 Each is passed one argument, the number of bytes inserted. It should return\n\
4659 the new byte count, and leave point the same. If `insert-file-contents' is\n\
4660 intercepted by a handler from `file-name-handler-alist', that handler is\n\
4661 responsible for calling the after-insert-file-functions if appropriate.");
4662 Vafter_insert_file_functions
= Qnil
;
4664 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
4665 "A list of functions to be called at the start of `write-region'.\n\
4666 Each is passed two arguments, START and END as for `write-region'.\n\
4667 These are usually two numbers but not always; see the documentation\n\
4668 for `write-region'. The function should return a list of pairs\n\
4669 of the form (POSITION . STRING), consisting of strings to be effectively\n\
4670 inserted at the specified positions of the file being written (1 means to\n\
4671 insert before the first byte written). The POSITIONs must be sorted into\n\
4672 increasing order. If there are several functions in the list, the several\n\
4673 lists are merged destructively.");
4674 Vwrite_region_annotate_functions
= Qnil
;
4676 DEFVAR_LISP ("write-region-annotations-so-far",
4677 &Vwrite_region_annotations_so_far
,
4678 "When an annotation function is called, this holds the previous annotations.\n\
4679 These are the annotations made by other annotation functions\n\
4680 that were already called. See also `write-region-annotate-functions'.");
4681 Vwrite_region_annotations_so_far
= Qnil
;
4683 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
4684 "A list of file name handlers that temporarily should not be used.\n\
4685 This applies only to the operation `inhibit-file-name-operation'.");
4686 Vinhibit_file_name_handlers
= Qnil
;
4688 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
4689 "The operation for which `inhibit-file-name-handlers' is applicable.");
4690 Vinhibit_file_name_operation
= Qnil
;
4692 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
4693 "File name in which we write a list of all auto save file names.\n\
4694 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
4695 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
4697 Vauto_save_list_file_name
= Qnil
;
4699 defsubr (&Sfind_file_name_handler
);
4700 defsubr (&Sfile_name_directory
);
4701 defsubr (&Sfile_name_nondirectory
);
4702 defsubr (&Sunhandled_file_name_directory
);
4703 defsubr (&Sfile_name_as_directory
);
4704 defsubr (&Sdirectory_file_name
);
4705 defsubr (&Smake_temp_name
);
4706 defsubr (&Sexpand_file_name
);
4707 defsubr (&Ssubstitute_in_file_name
);
4708 defsubr (&Scopy_file
);
4709 defsubr (&Smake_directory_internal
);
4710 defsubr (&Sdelete_directory
);
4711 defsubr (&Sdelete_file
);
4712 defsubr (&Srename_file
);
4713 defsubr (&Sadd_name_to_file
);
4715 defsubr (&Smake_symbolic_link
);
4716 #endif /* S_IFLNK */
4718 defsubr (&Sdefine_logical_name
);
4721 defsubr (&Ssysnetunam
);
4722 #endif /* HPUX_NET */
4723 defsubr (&Sfile_name_absolute_p
);
4724 defsubr (&Sfile_exists_p
);
4725 defsubr (&Sfile_executable_p
);
4726 defsubr (&Sfile_readable_p
);
4727 defsubr (&Sfile_writable_p
);
4728 defsubr (&Saccess_file
);
4729 defsubr (&Sfile_symlink_p
);
4730 defsubr (&Sfile_directory_p
);
4731 defsubr (&Sfile_accessible_directory_p
);
4732 defsubr (&Sfile_regular_p
);
4733 defsubr (&Sfile_modes
);
4734 defsubr (&Sset_file_modes
);
4735 defsubr (&Sset_default_file_modes
);
4736 defsubr (&Sdefault_file_modes
);
4737 defsubr (&Sfile_newer_than_file_p
);
4738 defsubr (&Sinsert_file_contents
);
4739 defsubr (&Swrite_region
);
4740 defsubr (&Scar_less_than_car
);
4741 defsubr (&Sverify_visited_file_modtime
);
4742 defsubr (&Sclear_visited_file_modtime
);
4743 defsubr (&Svisited_file_modtime
);
4744 defsubr (&Sset_visited_file_modtime
);
4745 defsubr (&Sdo_auto_save
);
4746 defsubr (&Sset_buffer_auto_saved
);
4747 defsubr (&Sclear_buffer_auto_save_failure
);
4748 defsubr (&Srecent_auto_save_p
);
4750 defsubr (&Sread_file_name_internal
);
4751 defsubr (&Sread_file_name
);
4754 defsubr (&Sunix_sync
);