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)
137 #define min(a, b) ((a) < (b) ? (a) : (b))
138 #define max(a, b) ((a) > (b) ? (a) : (b))
140 /* Nonzero during writing of auto-save files */
143 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
144 a new file with the same mode as the original */
145 int auto_save_mode_bits
;
147 /* Alist of elements (REGEXP . HANDLER) for file names
148 whose I/O is done with a special handler. */
149 Lisp_Object Vfile_name_handler_alist
;
151 /* Format for auto-save files */
152 Lisp_Object Vauto_save_file_format
;
154 /* Lisp functions for translating file formats */
155 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
157 /* Functions to be called to process text properties in inserted file. */
158 Lisp_Object Vafter_insert_file_functions
;
160 /* Functions to be called to create text property annotations for file. */
161 Lisp_Object Vwrite_region_annotate_functions
;
163 /* During build_annotations, each time an annotation function is called,
164 this holds the annotations made by the previous functions. */
165 Lisp_Object Vwrite_region_annotations_so_far
;
167 /* File name in which we write a list of all our auto save files. */
168 Lisp_Object Vauto_save_list_file_name
;
170 /* Nonzero means, when reading a filename in the minibuffer,
171 start out by inserting the default directory into the minibuffer. */
172 int insert_default_directory
;
174 /* On VMS, nonzero means write new files with record format stmlf.
175 Zero means use var format. */
178 /* On NT, specifies the directory separator character, used (eg.) when
179 expanding file names. This can be bound to / or \. */
180 Lisp_Object Vdirectory_sep_char
;
182 /* These variables describe handlers that have "already" had a chance
183 to handle the current operation.
185 Vinhibit_file_name_handlers is a list of file name handlers.
186 Vinhibit_file_name_operation is the operation being handled.
187 If we try to handle that operation, we ignore those handlers. */
189 static Lisp_Object Vinhibit_file_name_handlers
;
190 static Lisp_Object Vinhibit_file_name_operation
;
192 Lisp_Object Qfile_error
, Qfile_already_exists
;
194 Lisp_Object Qfile_name_history
;
196 Lisp_Object Qcar_less_than_car
;
198 report_file_error (string
, data
)
202 Lisp_Object errstring
;
204 errstring
= build_string (strerror (errno
));
206 /* System error messages are capitalized. Downcase the initial
207 unless it is followed by a slash. */
208 if (XSTRING (errstring
)->data
[1] != '/')
209 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
212 Fsignal (Qfile_error
,
213 Fcons (build_string (string
), Fcons (errstring
, data
)));
216 close_file_unwind (fd
)
219 close (XFASTINT (fd
));
222 /* Restore point, having saved it as a marker. */
224 restore_point_unwind (location
)
225 Lisp_Object location
;
227 SET_PT (marker_position (location
));
228 Fset_marker (location
, Qnil
, Qnil
);
231 Lisp_Object Qexpand_file_name
;
232 Lisp_Object Qsubstitute_in_file_name
;
233 Lisp_Object Qdirectory_file_name
;
234 Lisp_Object Qfile_name_directory
;
235 Lisp_Object Qfile_name_nondirectory
;
236 Lisp_Object Qunhandled_file_name_directory
;
237 Lisp_Object Qfile_name_as_directory
;
238 Lisp_Object Qcopy_file
;
239 Lisp_Object Qmake_directory_internal
;
240 Lisp_Object Qdelete_directory
;
241 Lisp_Object Qdelete_file
;
242 Lisp_Object Qrename_file
;
243 Lisp_Object Qadd_name_to_file
;
244 Lisp_Object Qmake_symbolic_link
;
245 Lisp_Object Qfile_exists_p
;
246 Lisp_Object Qfile_executable_p
;
247 Lisp_Object Qfile_readable_p
;
248 Lisp_Object Qfile_symlink_p
;
249 Lisp_Object Qfile_writable_p
;
250 Lisp_Object Qfile_directory_p
;
251 Lisp_Object Qfile_regular_p
;
252 Lisp_Object Qfile_accessible_directory_p
;
253 Lisp_Object Qfile_modes
;
254 Lisp_Object Qset_file_modes
;
255 Lisp_Object Qfile_newer_than_file_p
;
256 Lisp_Object Qinsert_file_contents
;
257 Lisp_Object Qwrite_region
;
258 Lisp_Object Qverify_visited_file_modtime
;
259 Lisp_Object Qset_visited_file_modtime
;
261 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
262 "Return FILENAME's handler function for OPERATION, if it has one.\n\
263 Otherwise, return nil.\n\
264 A file name is handled if one of the regular expressions in\n\
265 `file-name-handler-alist' matches it.\n\n\
266 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
267 any handlers that are members of `inhibit-file-name-handlers',\n\
268 but we still do run any other handlers. This lets handlers\n\
269 use the standard functions without calling themselves recursively.")
270 (filename
, operation
)
271 Lisp_Object filename
, operation
;
273 /* This function must not munge the match data. */
274 Lisp_Object chain
, inhibited_handlers
;
276 CHECK_STRING (filename
, 0);
278 if (EQ (operation
, Vinhibit_file_name_operation
))
279 inhibited_handlers
= Vinhibit_file_name_handlers
;
281 inhibited_handlers
= Qnil
;
283 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
284 chain
= XCONS (chain
)->cdr
)
287 elt
= XCONS (chain
)->car
;
291 string
= XCONS (elt
)->car
;
292 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
294 Lisp_Object handler
, tem
;
296 handler
= XCONS (elt
)->cdr
;
297 tem
= Fmemq (handler
, inhibited_handlers
);
308 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
310 "Return the directory component in file name FILENAME.\n\
311 Return nil if FILENAME does not include a directory.\n\
312 Otherwise return a directory spec.\n\
313 Given a Unix syntax file name, returns a string ending in slash;\n\
314 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
316 Lisp_Object filename
;
318 register unsigned char *beg
;
319 register unsigned char *p
;
322 CHECK_STRING (filename
, 0);
324 /* If the file name has special constructs in it,
325 call the corresponding file handler. */
326 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
328 return call2 (handler
, Qfile_name_directory
, filename
);
330 #ifdef FILE_SYSTEM_CASE
331 filename
= FILE_SYSTEM_CASE (filename
);
333 beg
= XSTRING (filename
)->data
;
335 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
337 p
= beg
+ XSTRING (filename
)->size
;
339 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
341 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
344 /* only recognise drive specifier at beginning */
345 && !(p
[-1] == ':' && p
== beg
+ 2)
352 /* Expansion of "c:" to drive and default directory. */
353 if (p
== beg
+ 2 && beg
[1] == ':')
355 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
356 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
357 if (getdefdir (toupper (*beg
) - 'A' + 1, res
))
359 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
362 p
= beg
+ strlen (beg
);
365 CORRECT_DIR_SEPS (beg
);
367 return make_string (beg
, p
- beg
);
370 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
372 "Return file name FILENAME sans its directory.\n\
373 For example, in a Unix-syntax file name,\n\
374 this is everything after the last slash,\n\
375 or the entire name if it contains no slash.")
377 Lisp_Object filename
;
379 register unsigned char *beg
, *p
, *end
;
382 CHECK_STRING (filename
, 0);
384 /* If the file name has special constructs in it,
385 call the corresponding file handler. */
386 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
388 return call2 (handler
, Qfile_name_nondirectory
, filename
);
390 beg
= XSTRING (filename
)->data
;
391 end
= p
= beg
+ XSTRING (filename
)->size
;
393 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
395 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
398 /* only recognise drive specifier at beginning */
399 && !(p
[-1] == ':' && p
== beg
+ 2)
403 return make_string (p
, end
- p
);
406 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
, Sunhandled_file_name_directory
, 1, 1, 0,
407 "Return a directly usable directory name somehow associated with FILENAME.\n\
408 A `directly usable' directory name is one that may be used without the\n\
409 intervention of any file handler.\n\
410 If FILENAME is a directly usable file itself, return\n\
411 (file-name-directory FILENAME).\n\
412 The `call-process' and `start-process' functions use this function to\n\
413 get a current directory to run processes in.")
415 Lisp_Object filename
;
419 /* If the file name has special constructs in it,
420 call the corresponding file handler. */
421 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
423 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
425 return Ffile_name_directory (filename
);
430 file_name_as_directory (out
, in
)
433 int size
= strlen (in
) - 1;
438 /* Is it already a directory string? */
439 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
441 /* Is it a VMS directory file name? If so, hack VMS syntax. */
442 else if (! index (in
, '/')
443 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
444 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
445 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
446 || ! strncmp (&in
[size
- 5], ".dir", 4))
447 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
448 && in
[size
] == '1')))
450 register char *p
, *dot
;
454 dir:x.dir --> dir:[x]
455 dir:[x]y.dir --> dir:[x.y] */
457 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
460 strncpy (out
, in
, p
- in
);
479 dot
= index (p
, '.');
482 /* blindly remove any extension */
483 size
= strlen (out
) + (dot
- p
);
484 strncat (out
, p
, dot
- p
);
495 /* For Unix syntax, Append a slash if necessary */
496 if (!IS_DIRECTORY_SEP (out
[size
]))
498 out
[size
+ 1] = DIRECTORY_SEP
;
499 out
[size
+ 2] = '\0';
502 CORRECT_DIR_SEPS (out
);
508 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
509 Sfile_name_as_directory
, 1, 1, 0,
510 "Return a string representing file FILENAME interpreted as a directory.\n\
511 This operation exists because a directory is also a file, but its name as\n\
512 a directory is different from its name as a file.\n\
513 The result can be used as the value of `default-directory'\n\
514 or passed as second argument to `expand-file-name'.\n\
515 For a Unix-syntax file name, just appends a slash.\n\
516 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
523 CHECK_STRING (file
, 0);
527 /* If the file name has special constructs in it,
528 call the corresponding file handler. */
529 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
531 return call2 (handler
, Qfile_name_as_directory
, file
);
533 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
534 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
538 * Convert from directory name to filename.
540 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
541 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
542 * On UNIX, it's simple: just make sure there isn't a terminating /
544 * Value is nonzero if the string output is different from the input.
547 directory_file_name (src
, dst
)
555 struct FAB fab
= cc$rms_fab
;
556 struct NAM nam
= cc$rms_nam
;
557 char esa
[NAM$C_MAXRSS
];
562 if (! index (src
, '/')
563 && (src
[slen
- 1] == ']'
564 || src
[slen
- 1] == ':'
565 || src
[slen
- 1] == '>'))
567 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
569 fab
.fab$b_fns
= slen
;
570 fab
.fab$l_nam
= &nam
;
571 fab
.fab$l_fop
= FAB$M_NAM
;
574 nam
.nam$b_ess
= sizeof esa
;
575 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
577 /* We call SYS$PARSE to handle such things as [--] for us. */
578 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
580 slen
= nam
.nam$b_esl
;
581 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
586 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
588 /* what about when we have logical_name:???? */
589 if (src
[slen
- 1] == ':')
590 { /* Xlate logical name and see what we get */
591 ptr
= strcpy (dst
, src
); /* upper case for getenv */
594 if ('a' <= *ptr
&& *ptr
<= 'z')
598 dst
[slen
- 1] = 0; /* remove colon */
599 if (!(src
= egetenv (dst
)))
601 /* should we jump to the beginning of this procedure?
602 Good points: allows us to use logical names that xlate
604 Bad points: can be a problem if we just translated to a device
606 For now, I'll punt and always expect VMS names, and hope for
609 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
610 { /* no recursion here! */
616 { /* not a directory spec */
621 bracket
= src
[slen
- 1];
623 /* If bracket is ']' or '>', bracket - 2 is the corresponding
625 ptr
= index (src
, bracket
- 2);
627 { /* no opening bracket */
631 if (!(rptr
= rindex (src
, '.')))
634 strncpy (dst
, src
, slen
);
638 dst
[slen
++] = bracket
;
643 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
644 then translate the device and recurse. */
645 if (dst
[slen
- 1] == ':'
646 && dst
[slen
- 2] != ':' /* skip decnet nodes */
647 && strcmp (src
+ slen
, "[000000]") == 0)
649 dst
[slen
- 1] = '\0';
650 if ((ptr
= egetenv (dst
))
651 && (rlen
= strlen (ptr
) - 1) > 0
652 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
653 && ptr
[rlen
- 1] == '.')
655 char * buf
= (char *) alloca (strlen (ptr
) + 1);
659 return directory_file_name (buf
, dst
);
664 strcat (dst
, "[000000]");
668 rlen
= strlen (rptr
) - 1;
669 strncat (dst
, rptr
, rlen
);
670 dst
[slen
+ rlen
] = '\0';
671 strcat (dst
, ".DIR.1");
675 /* Process as Unix format: just remove any final slash.
676 But leave "/" unchanged; do not change it to "". */
679 /* Handle // as root for apollo's. */
680 if ((slen
> 2 && dst
[slen
- 1] == '/')
681 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
685 && IS_DIRECTORY_SEP (dst
[slen
- 1])
687 && !IS_ANY_SEP (dst
[slen
- 2])
693 CORRECT_DIR_SEPS (dst
);
698 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
700 "Returns the file name of the directory named DIRECTORY.\n\
701 This is the name of the file that holds the data for the directory DIRECTORY.\n\
702 This operation exists because a directory is also a file, but its name as\n\
703 a directory is different from its name as a file.\n\
704 In Unix-syntax, this function just removes the final slash.\n\
705 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
706 it returns a file name such as \"[X]Y.DIR.1\".")
708 Lisp_Object directory
;
713 CHECK_STRING (directory
, 0);
715 if (NILP (directory
))
718 /* If the file name has special constructs in it,
719 call the corresponding file handler. */
720 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
722 return call2 (handler
, Qdirectory_file_name
, directory
);
725 /* 20 extra chars is insufficient for VMS, since we might perform a
726 logical name translation. an equivalence string can be up to 255
727 chars long, so grab that much extra space... - sss */
728 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
730 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
732 directory_file_name (XSTRING (directory
)->data
, buf
);
733 return build_string (buf
);
736 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
737 "Generate temporary file name (string) starting with PREFIX (a string).\n\
738 The Emacs process number forms part of the result,\n\
739 so there is no danger of generating a name being used by another process.")
745 /* Don't use too many characters of the restricted 8+3 DOS
747 val
= concat2 (prefix
, build_string ("a.XXX"));
749 val
= concat2 (prefix
, build_string ("XXXXXX"));
751 mktemp (XSTRING (val
)->data
);
753 CORRECT_DIR_SEPS (XSTRING (val
)->data
);
758 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
759 "Convert filename NAME to absolute, and canonicalize it.\n\
760 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative\n\
761 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,\n\
762 the current buffer's value of default-directory is used.\n\
763 File name components that are `.' are removed, and \n\
764 so are file name components followed by `..', along with the `..' itself;\n\
765 note that these simplifications are done without checking the resulting\n\
766 file names in the file system.\n\
767 An initial `~/' expands to your home directory.\n\
768 An initial `~USER/' expands to USER's home directory.\n\
769 See also the function `substitute-in-file-name'.")
770 (name
, default_directory
)
771 Lisp_Object name
, default_directory
;
775 register unsigned char *newdir
, *p
, *o
;
777 unsigned char *target
;
780 unsigned char * colon
= 0;
781 unsigned char * close
= 0;
782 unsigned char * slash
= 0;
783 unsigned char * brack
= 0;
784 int lbrack
= 0, rbrack
= 0;
789 int collapse_newdir
= 1;
794 CHECK_STRING (name
, 0);
796 /* If the file name has special constructs in it,
797 call the corresponding file handler. */
798 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
800 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
802 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
803 if (NILP (default_directory
))
804 default_directory
= current_buffer
->directory
;
805 CHECK_STRING (default_directory
, 1);
807 if (!NILP (default_directory
))
809 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
811 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
814 o
= XSTRING (default_directory
)->data
;
816 /* Make sure DEFAULT_DIRECTORY is properly expanded.
817 It would be better to do this down below where we actually use
818 default_directory. Unfortunately, calling Fexpand_file_name recursively
819 could invoke GC, and the strings might be relocated. This would
820 be annoying because we have pointers into strings lying around
821 that would need adjusting, and people would add new pointers to
822 the code and forget to adjust them, resulting in intermittent bugs.
823 Putting this call here avoids all that crud.
825 The EQ test avoids infinite recursion. */
826 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
827 /* Save time in some common cases - as long as default_directory
828 is not relative, it can be canonicalized with name below (if it
829 is needed at all) without requiring it to be expanded now. */
831 /* Detect MSDOS file names with drive specifiers. */
832 && ! (IS_DRIVE (o
[0]) && (IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2])))
834 /* Detect Windows file names in UNC format. */
835 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
837 #else /* not DOS_NT */
838 /* Detect Unix absolute file names (/... alone is not absolute on
840 && ! (IS_DIRECTORY_SEP (o
[0]))
841 #endif /* not DOS_NT */
847 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
852 /* Filenames on VMS are always upper case. */
853 name
= Fupcase (name
);
855 #ifdef FILE_SYSTEM_CASE
856 name
= FILE_SYSTEM_CASE (name
);
859 nm
= XSTRING (name
)->data
;
862 /* We will force directory separators to be either all \ or /, so make
863 a local copy to modify, even if there ends up being no change. */
864 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
866 /* Find and remove drive specifier if present; this makes nm absolute
867 even if the rest of the name appears to be relative. */
869 unsigned char *colon
= rindex (nm
, ':');
872 /* Only recognize colon as part of drive specifier if there is a
873 single alphabetic character preceeding the colon (and if the
874 character before the drive letter, if present, is a directory
875 separator); this is to support the remote system syntax used by
876 ange-ftp, and the "po:username" syntax for POP mailboxes. */
880 else if (IS_DRIVE (colon
[-1])
881 && (colon
== nm
+ 1 || IS_DIRECTORY_SEP (colon
[-2])))
888 while (--colon
>= nm
)
895 /* Handle // and /~ in middle of file name
896 by discarding everything through the first / of that sequence. */
900 /* Since we are expecting the name to be absolute, we can assume
901 that each element starts with a "/". */
903 if (IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1])
904 #if defined (APOLLO) || defined (WINDOWSNT)
905 /* // at start of filename is meaningful on Apollo
906 and WindowsNT systems */
908 #endif /* APOLLO || WINDOWSNT */
912 if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '~')
919 /* Discard any previous drive specifier if nm is now in UNC format. */
920 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
926 /* If nm is absolute, look for /./ or /../ sequences; if none are
927 found, we can probably return right away. We will avoid allocating
928 a new string if name is already fully expanded. */
930 IS_DIRECTORY_SEP (nm
[0])
935 && (drive
|| IS_DIRECTORY_SEP (nm
[1]))
942 /* If it turns out that the filename we want to return is just a
943 suffix of FILENAME, we don't need to go through and edit
944 things; we just need to construct a new string using data
945 starting at the middle of FILENAME. If we set lose to a
946 non-zero value, that means we've discovered that we can't do
953 /* Since we know the name is absolute, we can assume that each
954 element starts with a "/". */
956 /* "." and ".." are hairy. */
957 if (IS_DIRECTORY_SEP (p
[0])
959 && (IS_DIRECTORY_SEP (p
[2])
961 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
968 /* if dev:[dir]/, move nm to / */
969 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
970 nm
= (brack
? brack
+ 1 : colon
+ 1);
979 /* VMS pre V4.4,convert '-'s in filenames. */
980 if (lbrack
== rbrack
)
982 if (dots
< 2) /* this is to allow negative version numbers */
987 if (lbrack
> rbrack
&&
988 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
989 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
995 /* count open brackets, reset close bracket pointer */
996 if (p
[0] == '[' || p
[0] == '<')
998 /* count close brackets, set close bracket pointer */
999 if (p
[0] == ']' || p
[0] == '>')
1000 rbrack
++, brack
= p
;
1001 /* detect ][ or >< */
1002 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1004 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1005 nm
= p
+ 1, lose
= 1;
1006 if (p
[0] == ':' && (colon
|| slash
))
1007 /* if dev1:[dir]dev2:, move nm to dev2: */
1013 /* if /name/dev:, move nm to dev: */
1016 /* if node::dev:, move colon following dev */
1017 else if (colon
&& colon
[-1] == ':')
1019 /* if dev1:dev2:, move nm to dev2: */
1020 else if (colon
&& colon
[-1] != ':')
1025 if (p
[0] == ':' && !colon
)
1031 if (lbrack
== rbrack
)
1034 else if (p
[0] == '.')
1042 if (index (nm
, '/'))
1043 return build_string (sys_translate_unix (nm
));
1046 /* Make sure directories are all separated with / or \ as
1047 desired, but avoid allocation of a new string when not
1049 CORRECT_DIR_SEPS (nm
);
1051 if (IS_DIRECTORY_SEP (nm
[1]))
1053 if (strcmp (nm
, XSTRING (name
)->data
) != 0)
1054 name
= build_string (nm
);
1058 /* drive must be set, so this is okay */
1059 if (strcmp (nm
- 2, XSTRING (name
)->data
) != 0)
1061 name
= make_string (nm
- 2, p
- nm
+ 2);
1062 XSTRING (name
)->data
[0] = drive
;
1063 XSTRING (name
)->data
[1] = ':';
1066 #else /* not DOS_NT */
1067 if (nm
== XSTRING (name
)->data
)
1069 return build_string (nm
);
1070 #endif /* not DOS_NT */
1074 /* At this point, nm might or might not be an absolute file name. We
1075 need to expand ~ or ~user if present, otherwise prefix nm with
1076 default_directory if nm is not absolute, and finally collapse /./
1077 and /foo/../ sequences.
1079 We set newdir to be the appropriate prefix if one is needed:
1080 - the relevant user directory if nm starts with ~ or ~user
1081 - the specified drive's working dir (DOS/NT only) if nm does not
1083 - the value of default_directory.
1085 Note that these prefixes are not guaranteed to be absolute (except
1086 for the working dir of a drive). Therefore, to ensure we always
1087 return an absolute name, if the final prefix is not absolute we
1088 append it to the current working directory. */
1092 if (nm
[0] == '~') /* prefix ~ */
1094 if (IS_DIRECTORY_SEP (nm
[1])
1098 || nm
[1] == 0) /* ~ by itself */
1100 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1101 newdir
= (unsigned char *) "";
1104 collapse_newdir
= 0;
1107 nm
++; /* Don't leave the slash in nm. */
1110 else /* ~user/filename */
1112 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1117 o
= (unsigned char *) alloca (p
- nm
+ 1);
1118 bcopy ((char *) nm
, o
, p
- nm
);
1121 pw
= (struct passwd
*) getpwnam (o
+ 1);
1124 newdir
= (unsigned char *) pw
-> pw_dir
;
1126 nm
= p
+ 1; /* skip the terminator */
1130 collapse_newdir
= 0;
1135 /* If we don't find a user of that name, leave the name
1136 unchanged; don't move nm forward to p. */
1141 /* On DOS and Windows, nm is absolute if a drive name was specified;
1142 use the drive's current directory as the prefix if needed. */
1143 if (!newdir
&& drive
)
1145 /* Get default directory if needed to make nm absolute. */
1146 if (!IS_DIRECTORY_SEP (nm
[0]))
1148 newdir
= alloca (MAXPATHLEN
+ 1);
1149 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1154 /* Either nm starts with /, or drive isn't mounted. */
1155 newdir
= alloca (4);
1164 /* Finally, if no prefix has been specified and nm is not absolute,
1165 then it must be expanded relative to default_directory. */
1169 /* /... alone is not absolute on DOS and Windows. */
1170 && !IS_DIRECTORY_SEP (nm
[0])
1173 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1180 newdir
= XSTRING (default_directory
)->data
;
1186 /* First ensure newdir is an absolute name. */
1188 /* Detect MSDOS file names with drive specifiers. */
1189 ! (IS_DRIVE (newdir
[0])
1190 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1192 /* Detect Windows file names in UNC format. */
1193 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1197 /* Effectively, let newdir be (expand-file-name newdir cwd).
1198 Because of the admonition against calling expand-file-name
1199 when we have pointers into lisp strings, we accomplish this
1200 indirectly by prepending newdir to nm if necessary, and using
1201 cwd (or the wd of newdir's drive) as the new newdir. */
1203 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1208 if (!IS_DIRECTORY_SEP (nm
[0]))
1210 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1211 file_name_as_directory (tmp
, newdir
);
1215 newdir
= alloca (MAXPATHLEN
+ 1);
1218 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1225 /* Strip off drive name from prefix, if present. */
1226 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1232 /* Keep only a prefix from newdir if nm starts with slash
1233 (//server/share for UNC, nothing otherwise). */
1234 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1237 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1239 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1241 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1243 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1255 /* Get rid of any slash at the end of newdir. */
1256 length
= strlen (newdir
);
1257 if (IS_DIRECTORY_SEP (newdir
[length
- 1]))
1259 unsigned char *temp
= (unsigned char *) alloca (length
);
1260 bcopy (newdir
, temp
, length
- 1);
1261 temp
[length
- 1] = 0;
1269 /* Now concatenate the directory and name to new space in the stack frame */
1270 tlen
+= strlen (nm
) + 1;
1272 /* Add reserved space for drive name. (The Microsoft x86 compiler
1273 produces incorrect code if the following two lines are combined.) */
1274 target
= (unsigned char *) alloca (tlen
+ 2);
1276 #else /* not DOS_NT */
1277 target
= (unsigned char *) alloca (tlen
);
1278 #endif /* not DOS_NT */
1284 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1285 strcpy (target
, newdir
);
1288 file_name_as_directory (target
, newdir
);
1291 strcat (target
, nm
);
1293 if (index (target
, '/'))
1294 strcpy (target
, sys_translate_unix (target
));
1297 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1299 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1307 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1313 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1314 /* brackets are offset from each other by 2 */
1317 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1318 /* convert [foo][bar] to [bar] */
1319 while (o
[-1] != '[' && o
[-1] != '<')
1321 else if (*p
== '-' && *o
!= '.')
1324 else if (p
[0] == '-' && o
[-1] == '.' &&
1325 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1326 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1330 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1331 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1333 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1335 /* else [foo.-] ==> [-] */
1341 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1342 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1348 if (!IS_DIRECTORY_SEP (*p
))
1352 else if (IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1])
1353 #if defined (APOLLO) || defined (WINDOWSNT)
1354 /* // at start of filename is meaningful in Apollo
1355 and WindowsNT systems */
1357 #endif /* APOLLO || WINDOWSNT */
1363 else if (IS_DIRECTORY_SEP (p
[0])
1365 && (IS_DIRECTORY_SEP (p
[2])
1368 /* If "/." is the entire filename, keep the "/". Otherwise,
1369 just delete the whole "/.". */
1370 if (o
== target
&& p
[2] == '\0')
1374 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1375 /* `/../' is the "superroot" on certain file systems. */
1377 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1379 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1387 #endif /* not VMS */
1391 /* At last, set drive name. */
1393 /* Except for network file name. */
1394 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1395 #endif /* WINDOWSNT */
1397 if (!drive
) abort ();
1402 CORRECT_DIR_SEPS (target
);
1405 return make_string (target
, o
- target
);
1409 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1410 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1411 "Convert FILENAME to absolute, and canonicalize it.\n\
1412 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1413 (does not start with slash); if DEFAULT is nil or missing,\n\
1414 the current buffer's value of default-directory is used.\n\
1415 Filenames containing `.' or `..' as components are simplified;\n\
1416 initial `~/' expands to your home directory.\n\
1417 See also the function `substitute-in-file-name'.")
1419 Lisp_Object name
, defalt
;
1423 register unsigned char *newdir
, *p
, *o
;
1425 unsigned char *target
;
1429 unsigned char * colon
= 0;
1430 unsigned char * close
= 0;
1431 unsigned char * slash
= 0;
1432 unsigned char * brack
= 0;
1433 int lbrack
= 0, rbrack
= 0;
1437 CHECK_STRING (name
, 0);
1440 /* Filenames on VMS are always upper case. */
1441 name
= Fupcase (name
);
1444 nm
= XSTRING (name
)->data
;
1446 /* If nm is absolute, flush ...// and detect /./ and /../.
1447 If no /./ or /../ we can return right away. */
1459 if (p
[0] == '/' && p
[1] == '/'
1461 /* // at start of filename is meaningful on Apollo system */
1466 if (p
[0] == '/' && p
[1] == '~')
1467 nm
= p
+ 1, lose
= 1;
1468 if (p
[0] == '/' && p
[1] == '.'
1469 && (p
[2] == '/' || p
[2] == 0
1470 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1476 /* if dev:[dir]/, move nm to / */
1477 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1478 nm
= (brack
? brack
+ 1 : colon
+ 1);
1479 lbrack
= rbrack
= 0;
1487 /* VMS pre V4.4,convert '-'s in filenames. */
1488 if (lbrack
== rbrack
)
1490 if (dots
< 2) /* this is to allow negative version numbers */
1495 if (lbrack
> rbrack
&&
1496 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1497 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1503 /* count open brackets, reset close bracket pointer */
1504 if (p
[0] == '[' || p
[0] == '<')
1505 lbrack
++, brack
= 0;
1506 /* count close brackets, set close bracket pointer */
1507 if (p
[0] == ']' || p
[0] == '>')
1508 rbrack
++, brack
= p
;
1509 /* detect ][ or >< */
1510 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1512 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1513 nm
= p
+ 1, lose
= 1;
1514 if (p
[0] == ':' && (colon
|| slash
))
1515 /* if dev1:[dir]dev2:, move nm to dev2: */
1521 /* If /name/dev:, move nm to dev: */
1524 /* If node::dev:, move colon following dev */
1525 else if (colon
&& colon
[-1] == ':')
1527 /* If dev1:dev2:, move nm to dev2: */
1528 else if (colon
&& colon
[-1] != ':')
1533 if (p
[0] == ':' && !colon
)
1539 if (lbrack
== rbrack
)
1542 else if (p
[0] == '.')
1550 if (index (nm
, '/'))
1551 return build_string (sys_translate_unix (nm
));
1553 if (nm
== XSTRING (name
)->data
)
1555 return build_string (nm
);
1559 /* Now determine directory to start with and put it in NEWDIR */
1563 if (nm
[0] == '~') /* prefix ~ */
1568 || nm
[1] == 0)/* ~/filename */
1570 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1571 newdir
= (unsigned char *) "";
1574 nm
++; /* Don't leave the slash in nm. */
1577 else /* ~user/filename */
1579 /* Get past ~ to user */
1580 unsigned char *user
= nm
+ 1;
1581 /* Find end of name. */
1582 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1583 int len
= ptr
? ptr
- user
: strlen (user
);
1585 unsigned char *ptr1
= index (user
, ':');
1586 if (ptr1
!= 0 && ptr1
- user
< len
)
1589 /* Copy the user name into temp storage. */
1590 o
= (unsigned char *) alloca (len
+ 1);
1591 bcopy ((char *) user
, o
, len
);
1594 /* Look up the user name. */
1595 pw
= (struct passwd
*) getpwnam (o
+ 1);
1597 error ("\"%s\" isn't a registered user", o
+ 1);
1599 newdir
= (unsigned char *) pw
->pw_dir
;
1601 /* Discard the user name from NM. */
1608 #endif /* not VMS */
1612 defalt
= current_buffer
->directory
;
1613 CHECK_STRING (defalt
, 1);
1614 newdir
= XSTRING (defalt
)->data
;
1617 /* Now concatenate the directory and name to new space in the stack frame */
1619 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1620 target
= (unsigned char *) alloca (tlen
);
1626 if (nm
[0] == 0 || nm
[0] == '/')
1627 strcpy (target
, newdir
);
1630 file_name_as_directory (target
, newdir
);
1633 strcat (target
, nm
);
1635 if (index (target
, '/'))
1636 strcpy (target
, sys_translate_unix (target
));
1639 /* Now canonicalize by removing /. and /foo/.. if they appear */
1647 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1653 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1654 /* brackets are offset from each other by 2 */
1657 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1658 /* convert [foo][bar] to [bar] */
1659 while (o
[-1] != '[' && o
[-1] != '<')
1661 else if (*p
== '-' && *o
!= '.')
1664 else if (p
[0] == '-' && o
[-1] == '.' &&
1665 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1666 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1670 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1671 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1673 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1675 /* else [foo.-] ==> [-] */
1681 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1682 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1692 else if (!strncmp (p
, "//", 2)
1694 /* // at start of filename is meaningful in Apollo system */
1702 else if (p
[0] == '/' && p
[1] == '.' &&
1703 (p
[2] == '/' || p
[2] == 0))
1705 else if (!strncmp (p
, "/..", 3)
1706 /* `/../' is the "superroot" on certain file systems. */
1708 && (p
[3] == '/' || p
[3] == 0))
1710 while (o
!= target
&& *--o
!= '/')
1713 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1717 if (o
== target
&& *o
== '/')
1725 #endif /* not VMS */
1728 return make_string (target
, o
- target
);
1732 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1733 Ssubstitute_in_file_name
, 1, 1, 0,
1734 "Substitute environment variables referred to in FILENAME.\n\
1735 `$FOO' where FOO is an environment variable name means to substitute\n\
1736 the value of that variable. The variable name should be terminated\n\
1737 with a character not a letter, digit or underscore; otherwise, enclose\n\
1738 the entire variable name in braces.\n\
1739 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1740 On VMS, `$' substitution is not done; this function does little and only\n\
1741 duplicates what `expand-file-name' does.")
1743 Lisp_Object filename
;
1747 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1748 unsigned char *target
;
1750 int substituted
= 0;
1752 Lisp_Object handler
;
1754 CHECK_STRING (filename
, 0);
1756 /* If the file name has special constructs in it,
1757 call the corresponding file handler. */
1758 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1759 if (!NILP (handler
))
1760 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1762 nm
= XSTRING (filename
)->data
;
1764 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1765 CORRECT_DIR_SEPS (nm
);
1766 substituted
= (strcmp (nm
, XSTRING (filename
)->data
) != 0);
1768 endp
= nm
+ XSTRING (filename
)->size
;
1770 /* If /~ or // appears, discard everything through first slash. */
1772 for (p
= nm
; p
!= endp
; p
++)
1775 #if defined (APOLLO) || defined (WINDOWSNT)
1776 /* // at start of file name is meaningful in Apollo and
1777 WindowsNT systems */
1778 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1779 #else /* not (APOLLO || WINDOWSNT) */
1780 || IS_DIRECTORY_SEP (p
[0])
1781 #endif /* not (APOLLO || WINDOWSNT) */
1786 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1788 || IS_DIRECTORY_SEP (p
[-1])))
1794 /* see comment in expand-file-name about drive specifiers */
1795 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1796 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1805 return build_string (nm
);
1808 /* See if any variables are substituted into the string
1809 and find the total length of their values in `total' */
1811 for (p
= nm
; p
!= endp
;)
1821 /* "$$" means a single "$" */
1830 while (p
!= endp
&& *p
!= '}') p
++;
1831 if (*p
!= '}') goto missingclose
;
1837 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1841 /* Copy out the variable name */
1842 target
= (unsigned char *) alloca (s
- o
+ 1);
1843 strncpy (target
, o
, s
- o
);
1846 strupr (target
); /* $home == $HOME etc. */
1849 /* Get variable value */
1850 o
= (unsigned char *) egetenv (target
);
1851 if (!o
) goto badvar
;
1852 total
+= strlen (o
);
1859 /* If substitution required, recopy the string and do it */
1860 /* Make space in stack frame for the new copy */
1861 xnm
= (unsigned char *) alloca (XSTRING (filename
)->size
+ total
+ 1);
1864 /* Copy the rest of the name through, replacing $ constructs with values */
1881 while (p
!= endp
&& *p
!= '}') p
++;
1882 if (*p
!= '}') goto missingclose
;
1888 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1892 /* Copy out the variable name */
1893 target
= (unsigned char *) alloca (s
- o
+ 1);
1894 strncpy (target
, o
, s
- o
);
1897 strupr (target
); /* $home == $HOME etc. */
1900 /* Get variable value */
1901 o
= (unsigned char *) egetenv (target
);
1911 /* If /~ or // appears, discard everything through first slash. */
1913 for (p
= xnm
; p
!= x
; p
++)
1915 #if defined (APOLLO) || defined (WINDOWSNT)
1916 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
1917 #else /* not (APOLLO || WINDOWSNT) */
1918 || IS_DIRECTORY_SEP (p
[0])
1919 #endif /* not (APOLLO || WINDOWSNT) */
1921 && p
!= nm
&& IS_DIRECTORY_SEP (p
[-1]))
1924 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1925 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1929 return make_string (xnm
, x
- xnm
);
1932 error ("Bad format environment-variable substitution");
1934 error ("Missing \"}\" in environment-variable substitution");
1936 error ("Substituting nonexistent environment variable \"%s\"", target
);
1939 #endif /* not VMS */
1942 /* A slightly faster and more convenient way to get
1943 (directory-file-name (expand-file-name FOO)). */
1946 expand_and_dir_to_file (filename
, defdir
)
1947 Lisp_Object filename
, defdir
;
1949 register Lisp_Object absname
;
1951 absname
= Fexpand_file_name (filename
, defdir
);
1954 register int c
= XSTRING (absname
)->data
[XSTRING (absname
)->size
- 1];
1955 if (c
== ':' || c
== ']' || c
== '>')
1956 absname
= Fdirectory_file_name (absname
);
1959 /* Remove final slash, if any (unless this is the root dir).
1960 stat behaves differently depending! */
1961 if (XSTRING (absname
)->size
> 1
1962 && IS_DIRECTORY_SEP (XSTRING (absname
)->data
[XSTRING (absname
)->size
- 1])
1963 && !IS_DEVICE_SEP (XSTRING (absname
)->data
[XSTRING (absname
)->size
-2]))
1964 /* We cannot take shortcuts; they might be wrong for magic file names. */
1965 absname
= Fdirectory_file_name (absname
);
1970 /* Signal an error if the file ABSNAME already exists.
1971 If INTERACTIVE is nonzero, ask the user whether to proceed,
1972 and bypass the error if the user says to go ahead.
1973 QUERYSTRING is a name for the action that is being considered
1975 *STATPTR is used to store the stat information if the file exists.
1976 If the file does not exist, STATPTR->st_mode is set to 0. */
1979 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
)
1980 Lisp_Object absname
;
1981 unsigned char *querystring
;
1983 struct stat
*statptr
;
1985 register Lisp_Object tem
;
1986 struct stat statbuf
;
1987 struct gcpro gcpro1
;
1989 /* stat is a good way to tell whether the file exists,
1990 regardless of what access permissions it has. */
1991 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
1994 Fsignal (Qfile_already_exists
,
1995 Fcons (build_string ("File already exists"),
1996 Fcons (absname
, Qnil
)));
1998 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
1999 XSTRING (absname
)->data
, querystring
));
2002 Fsignal (Qfile_already_exists
,
2003 Fcons (build_string ("File already exists"),
2004 Fcons (absname
, Qnil
)));
2011 statptr
->st_mode
= 0;
2016 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2017 "fCopy file: \nFCopy %s to file: \np\nP",
2018 "Copy FILE to NEWNAME. Both args must be strings.\n\
2019 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
2020 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
2021 A number as third arg means request confirmation if NEWNAME already exists.\n\
2022 This is what happens in interactive use with M-x.\n\
2023 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
2024 last-modified time as the old one. (This works on only some systems.)\n\
2025 A prefix arg makes KEEP-TIME non-nil.")
2026 (file
, newname
, ok_if_already_exists
, keep_date
)
2027 Lisp_Object file
, newname
, ok_if_already_exists
, keep_date
;
2030 char buf
[16 * 1024];
2031 struct stat st
, out_st
;
2032 Lisp_Object handler
;
2033 struct gcpro gcpro1
, gcpro2
;
2034 int count
= specpdl_ptr
- specpdl
;
2035 int input_file_statable_p
;
2037 GCPRO2 (file
, newname
);
2038 CHECK_STRING (file
, 0);
2039 CHECK_STRING (newname
, 1);
2040 file
= Fexpand_file_name (file
, Qnil
);
2041 newname
= Fexpand_file_name (newname
, Qnil
);
2043 /* If the input file name has special constructs in it,
2044 call the corresponding file handler. */
2045 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2046 /* Likewise for output file name. */
2048 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2049 if (!NILP (handler
))
2050 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2051 ok_if_already_exists
, keep_date
));
2053 if (NILP (ok_if_already_exists
)
2054 || INTEGERP (ok_if_already_exists
))
2055 barf_or_query_if_file_exists (newname
, "copy to it",
2056 INTEGERP (ok_if_already_exists
), &out_st
);
2057 else if (stat (XSTRING (newname
)->data
, &out_st
) < 0)
2060 ifd
= open (XSTRING (file
)->data
, O_RDONLY
);
2062 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2064 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2066 /* We can only copy regular files and symbolic links. Other files are not
2068 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2071 if (out_st
.st_mode
!= 0
2072 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2075 report_file_error ("Input and output files are the same",
2076 Fcons (file
, Fcons (newname
, Qnil
)));
2080 #if defined (S_ISREG) && defined (S_ISLNK)
2081 if (input_file_statable_p
)
2083 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2085 #if defined (EISDIR)
2086 /* Get a better looking error message. */
2089 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2092 #endif /* S_ISREG && S_ISLNK */
2095 /* Create the copy file with the same record format as the input file */
2096 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
2099 /* System's default file type was set to binary by _fmode in emacs.c. */
2100 ofd
= creat (XSTRING (newname
)->data
, S_IREAD
| S_IWRITE
);
2101 #else /* not MSDOS */
2102 ofd
= creat (XSTRING (newname
)->data
, 0666);
2103 #endif /* not MSDOS */
2106 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2108 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2112 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
2113 if (write (ofd
, buf
, n
) != n
)
2114 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2117 /* Closing the output clobbers the file times on some systems. */
2118 if (close (ofd
) < 0)
2119 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2121 if (input_file_statable_p
)
2123 if (!NILP (keep_date
))
2125 EMACS_TIME atime
, mtime
;
2126 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2127 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2128 if (set_file_times (XSTRING (newname
)->data
, atime
, mtime
))
2129 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2132 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
2134 #if defined (__DJGPP__) && __DJGPP__ > 1
2135 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2136 and if it can't, it tells so. Otherwise, under MSDOS we usually
2137 get only the READ bit, which will make the copied file read-only,
2138 so it's better not to chmod at all. */
2139 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2140 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
2141 #endif /* DJGPP version 2 or newer */
2147 /* Discard the unwind protects. */
2148 specpdl_ptr
= specpdl
+ count
;
2154 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2155 Smake_directory_internal
, 1, 1, 0,
2156 "Create a new directory named DIRECTORY.")
2158 Lisp_Object directory
;
2161 Lisp_Object handler
;
2163 CHECK_STRING (directory
, 0);
2164 directory
= Fexpand_file_name (directory
, Qnil
);
2166 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2167 if (!NILP (handler
))
2168 return call2 (handler
, Qmake_directory_internal
, directory
);
2170 dir
= XSTRING (directory
)->data
;
2173 if (mkdir (dir
) != 0)
2175 if (mkdir (dir
, 0777) != 0)
2177 report_file_error ("Creating directory", Flist (1, &directory
));
2182 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2183 "Delete the directory named DIRECTORY.")
2185 Lisp_Object directory
;
2188 Lisp_Object handler
;
2190 CHECK_STRING (directory
, 0);
2191 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2192 dir
= XSTRING (directory
)->data
;
2194 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2195 if (!NILP (handler
))
2196 return call2 (handler
, Qdelete_directory
, directory
);
2198 if (rmdir (dir
) != 0)
2199 report_file_error ("Removing directory", Flist (1, &directory
));
2204 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2205 "Delete file named FILENAME.\n\
2206 If file has multiple names, it continues to exist with the other names.")
2208 Lisp_Object filename
;
2210 Lisp_Object handler
;
2211 CHECK_STRING (filename
, 0);
2212 filename
= Fexpand_file_name (filename
, Qnil
);
2214 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2215 if (!NILP (handler
))
2216 return call2 (handler
, Qdelete_file
, filename
);
2218 if (0 > unlink (XSTRING (filename
)->data
))
2219 report_file_error ("Removing old name", Flist (1, &filename
));
2224 internal_delete_file_1 (ignore
)
2230 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2233 internal_delete_file (filename
)
2234 Lisp_Object filename
;
2236 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2237 Qt
, internal_delete_file_1
));
2240 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2241 "fRename file: \nFRename %s to file: \np",
2242 "Rename FILE as NEWNAME. Both args strings.\n\
2243 If file has names other than FILE, it continues to have those names.\n\
2244 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2245 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2246 A number as third arg means request confirmation if NEWNAME already exists.\n\
2247 This is what happens in interactive use with M-x.")
2248 (file
, newname
, ok_if_already_exists
)
2249 Lisp_Object file
, newname
, ok_if_already_exists
;
2252 Lisp_Object args
[2];
2254 Lisp_Object handler
;
2255 struct gcpro gcpro1
, gcpro2
;
2257 GCPRO2 (file
, newname
);
2258 CHECK_STRING (file
, 0);
2259 CHECK_STRING (newname
, 1);
2260 file
= Fexpand_file_name (file
, Qnil
);
2261 newname
= Fexpand_file_name (newname
, Qnil
);
2263 /* If the file name has special constructs in it,
2264 call the corresponding file handler. */
2265 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2267 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2268 if (!NILP (handler
))
2269 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2270 file
, newname
, ok_if_already_exists
));
2272 if (NILP (ok_if_already_exists
)
2273 || INTEGERP (ok_if_already_exists
))
2274 barf_or_query_if_file_exists (newname
, "rename to it",
2275 INTEGERP (ok_if_already_exists
), 0);
2277 if (0 > rename (XSTRING (file
)->data
, XSTRING (newname
)->data
))
2279 if (0 > link (XSTRING (file
)->data
, XSTRING (newname
)->data
)
2280 || 0 > unlink (XSTRING (file
)->data
))
2285 Fcopy_file (file
, newname
,
2286 /* We have already prompted if it was an integer,
2287 so don't have copy-file prompt again. */
2288 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2289 Fdelete_file (file
);
2296 report_file_error ("Renaming", Flist (2, args
));
2299 report_file_error ("Renaming", Flist (2, &file
));
2306 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2307 "fAdd name to file: \nFName to add to %s: \np",
2308 "Give FILE additional name NEWNAME. Both args strings.\n\
2309 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2310 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2311 A number as third arg means request confirmation if NEWNAME already exists.\n\
2312 This is what happens in interactive use with M-x.")
2313 (file
, newname
, ok_if_already_exists
)
2314 Lisp_Object file
, newname
, ok_if_already_exists
;
2317 Lisp_Object args
[2];
2319 Lisp_Object handler
;
2320 struct gcpro gcpro1
, gcpro2
;
2322 GCPRO2 (file
, newname
);
2323 CHECK_STRING (file
, 0);
2324 CHECK_STRING (newname
, 1);
2325 file
= Fexpand_file_name (file
, Qnil
);
2326 newname
= Fexpand_file_name (newname
, Qnil
);
2328 /* If the file name has special constructs in it,
2329 call the corresponding file handler. */
2330 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2331 if (!NILP (handler
))
2332 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2333 newname
, ok_if_already_exists
));
2335 /* If the new name has special constructs in it,
2336 call the corresponding file handler. */
2337 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2338 if (!NILP (handler
))
2339 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2340 newname
, ok_if_already_exists
));
2342 if (NILP (ok_if_already_exists
)
2343 || INTEGERP (ok_if_already_exists
))
2344 barf_or_query_if_file_exists (newname
, "make it a new name",
2345 INTEGERP (ok_if_already_exists
), 0);
2347 /* Windows does not support this operation. */
2348 report_file_error ("Adding new name", Flist (2, &file
));
2349 #else /* not WINDOWSNT */
2351 unlink (XSTRING (newname
)->data
);
2352 if (0 > link (XSTRING (file
)->data
, XSTRING (newname
)->data
))
2357 report_file_error ("Adding new name", Flist (2, args
));
2359 report_file_error ("Adding new name", Flist (2, &file
));
2362 #endif /* not WINDOWSNT */
2369 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2370 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2371 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2372 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2373 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2374 A number as third arg means request confirmation if LINKNAME already exists.\n\
2375 This happens for interactive use with M-x.")
2376 (filename
, linkname
, ok_if_already_exists
)
2377 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2380 Lisp_Object args
[2];
2382 Lisp_Object handler
;
2383 struct gcpro gcpro1
, gcpro2
;
2385 GCPRO2 (filename
, linkname
);
2386 CHECK_STRING (filename
, 0);
2387 CHECK_STRING (linkname
, 1);
2388 /* If the link target has a ~, we must expand it to get
2389 a truly valid file name. Otherwise, do not expand;
2390 we want to permit links to relative file names. */
2391 if (XSTRING (filename
)->data
[0] == '~')
2392 filename
= Fexpand_file_name (filename
, Qnil
);
2393 linkname
= Fexpand_file_name (linkname
, Qnil
);
2395 /* If the file name has special constructs in it,
2396 call the corresponding file handler. */
2397 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2398 if (!NILP (handler
))
2399 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2400 linkname
, ok_if_already_exists
));
2402 /* If the new link name has special constructs in it,
2403 call the corresponding file handler. */
2404 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2405 if (!NILP (handler
))
2406 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2407 linkname
, ok_if_already_exists
));
2409 if (NILP (ok_if_already_exists
)
2410 || INTEGERP (ok_if_already_exists
))
2411 barf_or_query_if_file_exists (linkname
, "make it a link",
2412 INTEGERP (ok_if_already_exists
), 0);
2413 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2415 /* If we didn't complain already, silently delete existing file. */
2416 if (errno
== EEXIST
)
2418 unlink (XSTRING (linkname
)->data
);
2419 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2429 report_file_error ("Making symbolic link", Flist (2, args
));
2431 report_file_error ("Making symbolic link", Flist (2, &filename
));
2437 #endif /* S_IFLNK */
2441 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2442 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2443 "Define the job-wide logical name NAME to have the value STRING.\n\
2444 If STRING is nil or a null string, the logical name NAME is deleted.")
2449 CHECK_STRING (name
, 0);
2451 delete_logical_name (XSTRING (name
)->data
);
2454 CHECK_STRING (string
, 1);
2456 if (XSTRING (string
)->size
== 0)
2457 delete_logical_name (XSTRING (name
)->data
);
2459 define_logical_name (XSTRING (name
)->data
, XSTRING (string
)->data
);
2468 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2469 "Open a network connection to PATH using LOGIN as the login string.")
2471 Lisp_Object path
, login
;
2475 CHECK_STRING (path
, 0);
2476 CHECK_STRING (login
, 0);
2478 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2480 if (netresult
== -1)
2485 #endif /* HPUX_NET */
2487 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2489 "Return t if file FILENAME specifies an absolute file name.\n\
2490 On Unix, this is a name starting with a `/' or a `~'.")
2492 Lisp_Object filename
;
2496 CHECK_STRING (filename
, 0);
2497 ptr
= XSTRING (filename
)->data
;
2498 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2500 /* ??? This criterion is probably wrong for '<'. */
2501 || index (ptr
, ':') || index (ptr
, '<')
2502 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2506 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2514 /* Return nonzero if file FILENAME exists and can be executed. */
2517 check_executable (filename
)
2521 int len
= strlen (filename
);
2524 if (stat (filename
, &st
) < 0)
2527 return ((st
.st_mode
& S_IEXEC
) != 0);
2529 return (S_ISREG (st
.st_mode
)
2531 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2532 || stricmp (suffix
, ".exe") == 0
2533 || stricmp (suffix
, ".bat") == 0)
2534 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2535 #endif /* not WINDOWSNT */
2536 #else /* not DOS_NT */
2538 return (eaccess (filename
, 1) >= 0);
2540 /* Access isn't quite right because it uses the real uid
2541 and we really want to test with the effective uid.
2542 But Unix doesn't give us a right way to do it. */
2543 return (access (filename
, 1) >= 0);
2545 #endif /* not DOS_NT */
2548 /* Return nonzero if file FILENAME exists and can be written. */
2551 check_writable (filename
)
2556 if (stat (filename
, &st
) < 0)
2558 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2559 #else /* not MSDOS */
2561 return (eaccess (filename
, 2) >= 0);
2563 /* Access isn't quite right because it uses the real uid
2564 and we really want to test with the effective uid.
2565 But Unix doesn't give us a right way to do it.
2566 Opening with O_WRONLY could work for an ordinary file,
2567 but would lose for directories. */
2568 return (access (filename
, 2) >= 0);
2570 #endif /* not MSDOS */
2573 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2574 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2575 See also `file-readable-p' and `file-attributes'.")
2577 Lisp_Object filename
;
2579 Lisp_Object absname
;
2580 Lisp_Object handler
;
2581 struct stat statbuf
;
2583 CHECK_STRING (filename
, 0);
2584 absname
= Fexpand_file_name (filename
, Qnil
);
2586 /* If the file name has special constructs in it,
2587 call the corresponding file handler. */
2588 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2589 if (!NILP (handler
))
2590 return call2 (handler
, Qfile_exists_p
, absname
);
2592 return (stat (XSTRING (absname
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2595 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2596 "Return t if FILENAME can be executed by you.\n\
2597 For a directory, this means you can access files in that directory.")
2599 Lisp_Object filename
;
2602 Lisp_Object absname
;
2603 Lisp_Object handler
;
2605 CHECK_STRING (filename
, 0);
2606 absname
= Fexpand_file_name (filename
, Qnil
);
2608 /* If the file name has special constructs in it,
2609 call the corresponding file handler. */
2610 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2611 if (!NILP (handler
))
2612 return call2 (handler
, Qfile_executable_p
, absname
);
2614 return (check_executable (XSTRING (absname
)->data
) ? Qt
: Qnil
);
2617 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2618 "Return t if file FILENAME exists and you can read it.\n\
2619 See also `file-exists-p' and `file-attributes'.")
2621 Lisp_Object filename
;
2623 Lisp_Object absname
;
2624 Lisp_Object handler
;
2627 CHECK_STRING (filename
, 0);
2628 absname
= Fexpand_file_name (filename
, Qnil
);
2630 /* If the file name has special constructs in it,
2631 call the corresponding file handler. */
2632 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2633 if (!NILP (handler
))
2634 return call2 (handler
, Qfile_readable_p
, absname
);
2637 /* Under MS-DOS and Windows, open does not work for directories. */
2638 if (access (XSTRING (absname
)->data
, 0) == 0)
2641 #else /* not DOS_NT */
2642 desc
= open (XSTRING (absname
)->data
, O_RDONLY
);
2647 #endif /* not DOS_NT */
2650 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2652 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2653 "Return t if file FILENAME can be written or created by you.")
2655 Lisp_Object filename
;
2657 Lisp_Object absname
, dir
;
2658 Lisp_Object handler
;
2659 struct stat statbuf
;
2661 CHECK_STRING (filename
, 0);
2662 absname
= Fexpand_file_name (filename
, Qnil
);
2664 /* If the file name has special constructs in it,
2665 call the corresponding file handler. */
2666 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2667 if (!NILP (handler
))
2668 return call2 (handler
, Qfile_writable_p
, absname
);
2670 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
2671 return (check_writable (XSTRING (absname
)->data
)
2673 dir
= Ffile_name_directory (absname
);
2676 dir
= Fdirectory_file_name (dir
);
2680 dir
= Fdirectory_file_name (dir
);
2682 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2686 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2687 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2688 The value is the name of the file to which it is linked.\n\
2689 Otherwise returns nil.")
2691 Lisp_Object filename
;
2698 Lisp_Object handler
;
2700 CHECK_STRING (filename
, 0);
2701 filename
= Fexpand_file_name (filename
, Qnil
);
2703 /* If the file name has special constructs in it,
2704 call the corresponding file handler. */
2705 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2706 if (!NILP (handler
))
2707 return call2 (handler
, Qfile_symlink_p
, filename
);
2712 buf
= (char *) xmalloc (bufsize
);
2713 bzero (buf
, bufsize
);
2714 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2715 if (valsize
< bufsize
) break;
2716 /* Buffer was not long enough */
2725 val
= make_string (buf
, valsize
);
2728 #else /* not S_IFLNK */
2730 #endif /* not S_IFLNK */
2733 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2734 "Return t if file FILENAME is the name of a directory as a file.\n\
2735 A directory name spec may be given instead; then the value is t\n\
2736 if the directory so specified exists and really is a directory.")
2738 Lisp_Object filename
;
2740 register Lisp_Object absname
;
2742 Lisp_Object handler
;
2744 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2746 /* If the file name has special constructs in it,
2747 call the corresponding file handler. */
2748 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2749 if (!NILP (handler
))
2750 return call2 (handler
, Qfile_directory_p
, absname
);
2752 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2754 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2757 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2758 "Return t if file FILENAME is the name of a directory as a file,\n\
2759 and files in that directory can be opened by you. In order to use a\n\
2760 directory as a buffer's current directory, this predicate must return true.\n\
2761 A directory name spec may be given instead; then the value is t\n\
2762 if the directory so specified exists and really is a readable and\n\
2763 searchable directory.")
2765 Lisp_Object filename
;
2767 Lisp_Object handler
;
2769 struct gcpro gcpro1
;
2771 /* If the file name has special constructs in it,
2772 call the corresponding file handler. */
2773 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2774 if (!NILP (handler
))
2775 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2777 /* It's an unlikely combination, but yes we really do need to gcpro:
2778 Suppose that file-accessible-directory-p has no handler, but
2779 file-directory-p does have a handler; this handler causes a GC which
2780 relocates the string in `filename'; and finally file-directory-p
2781 returns non-nil. Then we would end up passing a garbaged string
2782 to file-executable-p. */
2784 tem
= (NILP (Ffile_directory_p (filename
))
2785 || NILP (Ffile_executable_p (filename
)));
2787 return tem
? Qnil
: Qt
;
2790 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2791 "Return t if file FILENAME is the name of a regular file.\n\
2792 This is the sort of file that holds an ordinary stream of data bytes.")
2794 Lisp_Object filename
;
2796 register Lisp_Object absname
;
2798 Lisp_Object handler
;
2800 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2802 /* If the file name has special constructs in it,
2803 call the corresponding file handler. */
2804 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
2805 if (!NILP (handler
))
2806 return call2 (handler
, Qfile_regular_p
, absname
);
2808 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2810 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2813 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2814 "Return mode bits of file named FILENAME, as an integer.")
2816 Lisp_Object filename
;
2818 Lisp_Object absname
;
2820 Lisp_Object handler
;
2822 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2824 /* If the file name has special constructs in it,
2825 call the corresponding file handler. */
2826 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
2827 if (!NILP (handler
))
2828 return call2 (handler
, Qfile_modes
, absname
);
2830 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2833 if (check_executable (XSTRING (absname
)->data
))
2834 st
.st_mode
|= S_IEXEC
;
2837 return make_number (st
.st_mode
& 07777);
2840 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2841 "Set mode bits of file named FILENAME to MODE (an integer).\n\
2842 Only the 12 low bits of MODE are used.")
2844 Lisp_Object filename
, mode
;
2846 Lisp_Object absname
;
2847 Lisp_Object handler
;
2849 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
2850 CHECK_NUMBER (mode
, 1);
2852 /* If the file name has special constructs in it,
2853 call the corresponding file handler. */
2854 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
2855 if (!NILP (handler
))
2856 return call3 (handler
, Qset_file_modes
, absname
, mode
);
2858 if (chmod (XSTRING (absname
)->data
, XINT (mode
)) < 0)
2859 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
2864 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2865 "Set the file permission bits for newly created files.\n\
2866 The argument MODE should be an integer; only the low 9 bits are used.\n\
2867 This setting is inherited by subprocesses.")
2871 CHECK_NUMBER (mode
, 0);
2873 umask ((~ XINT (mode
)) & 0777);
2878 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2879 "Return the default file protection for created files.\n\
2880 The value is an integer.")
2886 realmask
= umask (0);
2889 XSETINT (value
, (~ realmask
) & 0777);
2895 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2896 "Tell Unix to finish all pending disk updates.")
2905 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2906 "Return t if file FILE1 is newer than file FILE2.\n\
2907 If FILE1 does not exist, the answer is nil;\n\
2908 otherwise, if FILE2 does not exist, the answer is t.")
2910 Lisp_Object file1
, file2
;
2912 Lisp_Object absname1
, absname2
;
2915 Lisp_Object handler
;
2916 struct gcpro gcpro1
, gcpro2
;
2918 CHECK_STRING (file1
, 0);
2919 CHECK_STRING (file2
, 0);
2922 GCPRO2 (absname1
, file2
);
2923 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2924 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2927 /* If the file name has special constructs in it,
2928 call the corresponding file handler. */
2929 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
2931 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
2932 if (!NILP (handler
))
2933 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
2935 if (stat (XSTRING (absname1
)->data
, &st
) < 0)
2938 mtime1
= st
.st_mtime
;
2940 if (stat (XSTRING (absname2
)->data
, &st
) < 0)
2943 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2947 Lisp_Object Qfind_buffer_file_type
;
2950 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2952 "Insert contents of file FILENAME after point.\n\
2953 Returns list of absolute file name and length of data inserted.\n\
2954 If second argument VISIT is non-nil, the buffer's visited filename\n\
2955 and last save file modtime are set, and it is marked unmodified.\n\
2956 If visiting and the file does not exist, visiting is completed\n\
2957 before the error is signaled.\n\n\
2958 The optional third and fourth arguments BEG and END\n\
2959 specify what portion of the file to insert.\n\
2960 If VISIT is non-nil, BEG and END must be nil.\n\
2961 If optional fifth argument REPLACE is non-nil,\n\
2962 it means replace the current buffer contents (in the accessible portion)\n\
2963 with the file contents. This is better than simply deleting and inserting\n\
2964 the whole thing because (1) it preserves some marker positions\n\
2965 and (2) it puts less data in the undo list.")
2966 (filename
, visit
, beg
, end
, replace
)
2967 Lisp_Object filename
, visit
, beg
, end
, replace
;
2971 register int inserted
= 0;
2972 register int how_much
;
2973 int count
= specpdl_ptr
- specpdl
;
2974 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2975 Lisp_Object handler
, val
, insval
;
2978 int not_regular
= 0;
2980 if (current_buffer
->base_buffer
&& ! NILP (visit
))
2981 error ("Cannot do file visiting in an indirect buffer");
2983 if (!NILP (current_buffer
->read_only
))
2984 Fbarf_if_buffer_read_only ();
2989 GCPRO3 (filename
, val
, p
);
2991 CHECK_STRING (filename
, 0);
2992 filename
= Fexpand_file_name (filename
, Qnil
);
2994 /* If the file name has special constructs in it,
2995 call the corresponding file handler. */
2996 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
2997 if (!NILP (handler
))
2999 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3000 visit
, beg
, end
, replace
);
3007 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3009 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
3010 || fstat (fd
, &st
) < 0)
3011 #endif /* not APOLLO */
3013 if (fd
>= 0) close (fd
);
3016 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3023 /* This code will need to be changed in order to work on named
3024 pipes, and it's probably just not worth it. So we should at
3025 least signal an error. */
3026 if (!S_ISREG (st
.st_mode
))
3029 Fsignal (Qfile_error
,
3030 Fcons (build_string ("not a regular file"),
3031 Fcons (filename
, Qnil
)));
3039 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
3042 /* Replacement should preserve point as it preserves markers. */
3043 if (!NILP (replace
))
3044 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3046 record_unwind_protect (close_file_unwind
, make_number (fd
));
3048 /* Supposedly happens on VMS. */
3050 error ("File size is negative");
3052 if (!NILP (beg
) || !NILP (end
))
3054 error ("Attempt to visit less than an entire file");
3057 CHECK_NUMBER (beg
, 0);
3059 XSETFASTINT (beg
, 0);
3062 CHECK_NUMBER (end
, 0);
3065 XSETINT (end
, st
.st_size
);
3066 if (XINT (end
) != st
.st_size
)
3067 error ("maximum buffer size exceeded");
3070 /* If requested, replace the accessible part of the buffer
3071 with the file contents. Avoid replacing text at the
3072 beginning or end of the buffer that matches the file contents;
3073 that preserves markers pointing to the unchanged parts. */
3075 /* On MSDOS, replace mode doesn't really work, except for binary files,
3076 and it's not worth supporting just for them. */
3077 if (!NILP (replace
))
3080 XSETFASTINT (beg
, 0);
3081 XSETFASTINT (end
, st
.st_size
);
3082 del_range_1 (BEGV
, ZV
, 0);
3084 #else /* not DOS_NT */
3085 if (!NILP (replace
))
3087 unsigned char buffer
[1 << 14];
3088 int same_at_start
= BEGV
;
3089 int same_at_end
= ZV
;
3094 /* Count how many chars at the start of the file
3095 match the text at the beginning of the buffer. */
3100 nread
= read (fd
, buffer
, sizeof buffer
);
3102 error ("IO error reading %s: %s",
3103 XSTRING (filename
)->data
, strerror (errno
));
3104 else if (nread
== 0)
3107 while (bufpos
< nread
&& same_at_start
< ZV
3108 && FETCH_CHAR (same_at_start
) == buffer
[bufpos
])
3109 same_at_start
++, bufpos
++;
3110 /* If we found a discrepancy, stop the scan.
3111 Otherwise loop around and scan the next bufferful. */
3112 if (bufpos
!= nread
)
3116 /* If the file matches the buffer completely,
3117 there's no need to replace anything. */
3118 if (same_at_start
- BEGV
== st
.st_size
)
3122 /* Truncate the buffer to the size of the file. */
3123 del_range_1 (same_at_start
, same_at_end
, 0);
3128 /* Count how many chars at the end of the file
3129 match the text at the end of the buffer. */
3132 int total_read
, nread
, bufpos
, curpos
, trial
;
3134 /* At what file position are we now scanning? */
3135 curpos
= st
.st_size
- (ZV
- same_at_end
);
3136 /* If the entire file matches the buffer tail, stop the scan. */
3139 /* How much can we scan in the next step? */
3140 trial
= min (curpos
, sizeof buffer
);
3141 if (lseek (fd
, curpos
- trial
, 0) < 0)
3142 report_file_error ("Setting file position",
3143 Fcons (filename
, Qnil
));
3146 while (total_read
< trial
)
3148 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
3150 error ("IO error reading %s: %s",
3151 XSTRING (filename
)->data
, strerror (errno
));
3152 total_read
+= nread
;
3154 /* Scan this bufferful from the end, comparing with
3155 the Emacs buffer. */
3156 bufpos
= total_read
;
3157 /* Compare with same_at_start to avoid counting some buffer text
3158 as matching both at the file's beginning and at the end. */
3159 while (bufpos
> 0 && same_at_end
> same_at_start
3160 && FETCH_CHAR (same_at_end
- 1) == buffer
[bufpos
- 1])
3161 same_at_end
--, bufpos
--;
3162 /* If we found a discrepancy, stop the scan.
3163 Otherwise loop around and scan the preceding bufferful. */
3166 /* If display current starts at beginning of line,
3167 keep it that way. */
3168 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3169 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3173 /* Don't try to reuse the same piece of text twice. */
3174 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
3176 same_at_end
+= overlap
;
3178 /* Arrange to read only the nonmatching middle part of the file. */
3179 XSETFASTINT (beg
, same_at_start
- BEGV
);
3180 XSETFASTINT (end
, st
.st_size
- (ZV
- same_at_end
));
3182 del_range_1 (same_at_start
, same_at_end
, 0);
3183 /* Insert from the file at the proper position. */
3184 SET_PT (same_at_start
);
3186 #endif /* not DOS_NT */
3188 total
= XINT (end
) - XINT (beg
);
3191 register Lisp_Object temp
;
3193 /* Make sure point-max won't overflow after this insertion. */
3194 XSETINT (temp
, total
);
3195 if (total
!= XINT (temp
))
3196 error ("maximum buffer size exceeded");
3199 if (NILP (visit
) && total
> 0)
3200 prepare_to_modify_buffer (point
, point
);
3203 if (GAP_SIZE
< total
)
3204 make_gap (total
- GAP_SIZE
);
3206 if (XINT (beg
) != 0 || !NILP (replace
))
3208 if (lseek (fd
, XINT (beg
), 0) < 0)
3209 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
3213 while (inserted
< total
)
3215 /* try is reserved in some compilers (Microsoft C) */
3216 int trytry
= min (total
- inserted
, 64 << 10);
3219 /* Allow quitting out of the actual I/O. */
3222 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, trytry
);
3239 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
3240 /* Determine file type from name and remove LFs from CR-LFs if the file
3241 is deemed to be a text file. */
3243 current_buffer
->buffer_file_type
3244 = call1 (Qfind_buffer_file_type
, filename
);
3245 if (NILP (current_buffer
->buffer_file_type
))
3248 = inserted
- crlf_to_lf (inserted
, &FETCH_CHAR (point
- 1) + 1);
3251 GPT
-= reduced_size
;
3252 GAP_SIZE
+= reduced_size
;
3253 inserted
-= reduced_size
;
3260 record_insert (point
, inserted
);
3262 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
3263 offset_intervals (current_buffer
, point
, inserted
);
3269 /* Discard the unwind protect for closing the file. */
3273 error ("IO error reading %s: %s",
3274 XSTRING (filename
)->data
, strerror (errno
));
3281 if (!EQ (current_buffer
->undo_list
, Qt
))
3282 current_buffer
->undo_list
= Qnil
;
3284 stat (XSTRING (filename
)->data
, &st
);
3289 current_buffer
->modtime
= st
.st_mtime
;
3290 current_buffer
->filename
= filename
;
3293 SAVE_MODIFF
= MODIFF
;
3294 current_buffer
->auto_save_modified
= MODIFF
;
3295 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3296 #ifdef CLASH_DETECTION
3299 if (!NILP (current_buffer
->file_truename
))
3300 unlock_file (current_buffer
->file_truename
);
3301 unlock_file (filename
);
3303 #endif /* CLASH_DETECTION */
3305 Fsignal (Qfile_error
,
3306 Fcons (build_string ("not a regular file"),
3307 Fcons (filename
, Qnil
)));
3309 /* If visiting nonexistent file, return nil. */
3310 if (current_buffer
->modtime
== -1)
3311 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3314 /* Decode file format */
3317 insval
= call3 (Qformat_decode
,
3318 Qnil
, make_number (inserted
), visit
);
3319 CHECK_NUMBER (insval
, 0);
3320 inserted
= XFASTINT (insval
);
3323 if (inserted
> 0 && NILP (visit
) && total
> 0)
3324 signal_after_change (point
, 0, inserted
);
3328 p
= Vafter_insert_file_functions
;
3331 insval
= call1 (Fcar (p
), make_number (inserted
));
3334 CHECK_NUMBER (insval
, 0);
3335 inserted
= XFASTINT (insval
);
3343 val
= Fcons (filename
,
3344 Fcons (make_number (inserted
),
3347 RETURN_UNGCPRO (unbind_to (count
, val
));
3350 static Lisp_Object
build_annotations ();
3352 /* If build_annotations switched buffers, switch back to BUF.
3353 Kill the temporary buffer that was selected in the meantime. */
3356 build_annotations_unwind (buf
)
3361 if (XBUFFER (buf
) == current_buffer
)
3363 tembuf
= Fcurrent_buffer ();
3365 Fkill_buffer (tembuf
);
3369 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 6,
3370 "r\nFWrite region to file: ",
3371 "Write current region into specified file.\n\
3372 When called from a program, takes three arguments:\n\
3373 START, END and FILENAME. START and END are buffer positions.\n\
3374 Optional fourth argument APPEND if non-nil means\n\
3375 append to existing file contents (if any).\n\
3376 Optional fifth argument VISIT if t means\n\
3377 set the last-save-file-modtime of buffer to this file's modtime\n\
3378 and mark buffer not modified.\n\
3379 If VISIT is a string, it is a second file name;\n\
3380 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
3381 VISIT is also the file name to lock and unlock for clash detection.\n\
3382 If VISIT is neither t nor nil nor a string,\n\
3383 that means do not print the \"Wrote file\" message.\n\
3384 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
3385 use for locking and unlocking, overriding FILENAME and VISIT.\n\
3386 Kludgy feature: if START is a string, then that string is written\n\
3387 to the file, instead of any buffer contents, and END is ignored.")
3388 (start
, end
, filename
, append
, visit
, lockname
)
3389 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
3397 int count
= specpdl_ptr
- specpdl
;
3400 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3402 Lisp_Object handler
;
3403 Lisp_Object visit_file
;
3404 Lisp_Object annotations
;
3405 int visiting
, quietly
;
3406 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3407 struct buffer
*given_buffer
;
3409 int buffer_file_type
3410 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
3413 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3414 error ("Cannot do file visiting in an indirect buffer");
3416 if (!NILP (start
) && !STRINGP (start
))
3417 validate_region (&start
, &end
);
3419 GCPRO3 (filename
, visit
, lockname
);
3420 filename
= Fexpand_file_name (filename
, Qnil
);
3421 if (STRINGP (visit
))
3422 visit_file
= Fexpand_file_name (visit
, Qnil
);
3424 visit_file
= filename
;
3427 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
3428 quietly
= !NILP (visit
);
3432 if (NILP (lockname
))
3433 lockname
= visit_file
;
3435 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
3437 /* If the file name has special constructs in it,
3438 call the corresponding file handler. */
3439 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
3440 /* If FILENAME has no handler, see if VISIT has one. */
3441 if (NILP (handler
) && STRINGP (visit
))
3442 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
3444 if (!NILP (handler
))
3447 val
= call6 (handler
, Qwrite_region
, start
, end
,
3448 filename
, append
, visit
);
3452 SAVE_MODIFF
= MODIFF
;
3453 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3454 current_buffer
->filename
= visit_file
;
3460 /* Special kludge to simplify auto-saving. */
3463 XSETFASTINT (start
, BEG
);
3464 XSETFASTINT (end
, Z
);
3467 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
3468 count1
= specpdl_ptr
- specpdl
;
3470 given_buffer
= current_buffer
;
3471 annotations
= build_annotations (start
, end
);
3472 if (current_buffer
!= given_buffer
)
3478 #ifdef CLASH_DETECTION
3480 lock_file (lockname
);
3481 #endif /* CLASH_DETECTION */
3483 fn
= XSTRING (filename
)->data
;
3487 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
3488 #else /* not DOS_NT */
3489 desc
= open (fn
, O_WRONLY
);
3490 #endif /* not DOS_NT */
3494 if (auto_saving
) /* Overwrite any previous version of autosave file */
3496 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3497 desc
= open (fn
, O_RDWR
);
3499 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3500 ? XSTRING (current_buffer
->filename
)->data
: 0,
3503 else /* Write to temporary name and rename if no errors */
3505 Lisp_Object temp_name
;
3506 temp_name
= Ffile_name_directory (filename
);
3508 if (!NILP (temp_name
))
3510 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3511 build_string ("$$SAVE$$")));
3512 fname
= XSTRING (filename
)->data
;
3513 fn
= XSTRING (temp_name
)->data
;
3514 desc
= creat_copy_attrs (fname
, fn
);
3517 /* If we can't open the temporary file, try creating a new
3518 version of the original file. VMS "creat" creates a
3519 new version rather than truncating an existing file. */
3522 desc
= creat (fn
, 0666);
3523 #if 0 /* This can clobber an existing file and fail to replace it,
3524 if the user runs out of space. */
3527 /* We can't make a new version;
3528 try to truncate and rewrite existing version if any. */
3530 desc
= open (fn
, O_RDWR
);
3536 desc
= creat (fn
, 0666);
3541 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3542 S_IREAD
| S_IWRITE
);
3543 #else /* not DOS_NT */
3544 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3545 #endif /* not DOS_NT */
3546 #endif /* not VMS */
3552 #ifdef CLASH_DETECTION
3554 if (!auto_saving
) unlock_file (lockname
);
3556 #endif /* CLASH_DETECTION */
3557 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
3560 record_unwind_protect (close_file_unwind
, make_number (desc
));
3563 if (lseek (desc
, 0, 2) < 0)
3565 #ifdef CLASH_DETECTION
3566 if (!auto_saving
) unlock_file (lockname
);
3567 #endif /* CLASH_DETECTION */
3568 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
3573 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3574 * if we do writes that don't end with a carriage return. Furthermore
3575 * it cannot handle writes of more then 16K. The modified
3576 * version of "sys_write" in SYSDEP.C (see comment there) copes with
3577 * this EXCEPT for the last record (iff it doesn't end with a carriage
3578 * return). This implies that if your buffer doesn't end with a carriage
3579 * return, you get one free... tough. However it also means that if
3580 * we make two calls to sys_write (a la the following code) you can
3581 * get one at the gap as well. The easiest way to fix this (honest)
3582 * is to move the gap to the next newline (or the end of the buffer).
3587 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
3588 move_gap (find_next_newline (GPT
, 1));
3594 if (STRINGP (start
))
3596 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
3597 XSTRING (start
)->size
, 0, &annotations
);
3600 else if (XINT (start
) != XINT (end
))
3603 if (XINT (start
) < GPT
)
3605 register int end1
= XINT (end
);
3607 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
),
3608 min (GPT
, end1
) - tem
, tem
, &annotations
);
3609 nwritten
+= min (GPT
, end1
) - tem
;
3613 if (XINT (end
) > GPT
&& !failure
)
3616 tem
= max (tem
, GPT
);
3617 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
,
3619 nwritten
+= XINT (end
) - tem
;
3625 /* If file was empty, still need to write the annotations */
3626 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
);
3633 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3634 Disk full in NFS may be reported here. */
3635 /* mib says that closing the file will try to write as fast as NFS can do
3636 it, and that means the fsync here is not crucial for autosave files. */
3637 if (!auto_saving
&& fsync (desc
) < 0)
3639 /* If fsync fails with EINTR, don't treat that as serious. */
3641 failure
= 1, save_errno
= errno
;
3645 /* Spurious "file has changed on disk" warnings have been
3646 observed on Suns as well.
3647 It seems that `close' can change the modtime, under nfs.
3649 (This has supposedly been fixed in Sunos 4,
3650 but who knows about all the other machines with NFS?) */
3653 /* On VMS and APOLLO, must do the stat after the close
3654 since closing changes the modtime. */
3657 /* Recall that #if defined does not work on VMS. */
3664 /* NFS can report a write failure now. */
3665 if (close (desc
) < 0)
3666 failure
= 1, save_errno
= errno
;
3669 /* If we wrote to a temporary name and had no errors, rename to real name. */
3673 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
3681 /* Discard the unwind protect for close_file_unwind. */
3682 specpdl_ptr
= specpdl
+ count1
;
3683 /* Restore the original current buffer. */
3684 visit_file
= unbind_to (count
, visit_file
);
3686 #ifdef CLASH_DETECTION
3688 unlock_file (lockname
);
3689 #endif /* CLASH_DETECTION */
3691 /* Do this before reporting IO error
3692 to avoid a "file has changed on disk" warning on
3693 next attempt to save. */
3695 current_buffer
->modtime
= st
.st_mtime
;
3698 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
3702 SAVE_MODIFF
= MODIFF
;
3703 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3704 current_buffer
->filename
= visit_file
;
3705 update_mode_lines
++;
3711 message ("Wrote %s", XSTRING (visit_file
)->data
);
3716 Lisp_Object
merge ();
3718 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
3719 "Return t if (car A) is numerically less than (car B).")
3723 return Flss (Fcar (a
), Fcar (b
));
3726 /* Build the complete list of annotations appropriate for writing out
3727 the text between START and END, by calling all the functions in
3728 write-region-annotate-functions and merging the lists they return.
3729 If one of these functions switches to a different buffer, we assume
3730 that buffer contains altered text. Therefore, the caller must
3731 make sure to restore the current buffer in all cases,
3732 as save-excursion would do. */
3735 build_annotations (start
, end
)
3736 Lisp_Object start
, end
;
3738 Lisp_Object annotations
;
3740 struct gcpro gcpro1
, gcpro2
;
3743 p
= Vwrite_region_annotate_functions
;
3744 GCPRO2 (annotations
, p
);
3747 struct buffer
*given_buffer
= current_buffer
;
3748 Vwrite_region_annotations_so_far
= annotations
;
3749 res
= call2 (Fcar (p
), start
, end
);
3750 /* If the function makes a different buffer current,
3751 assume that means this buffer contains altered text to be output.
3752 Reset START and END from the buffer bounds
3753 and discard all previous annotations because they should have
3754 been dealt with by this function. */
3755 if (current_buffer
!= given_buffer
)
3761 Flength (res
); /* Check basic validity of return value */
3762 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3766 /* Now do the same for annotation functions implied by the file-format */
3767 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
3768 p
= Vauto_save_file_format
;
3770 p
= current_buffer
->file_format
;
3773 struct buffer
*given_buffer
= current_buffer
;
3774 Vwrite_region_annotations_so_far
= annotations
;
3775 res
= call3 (Qformat_annotate_function
, Fcar (p
), start
, end
);
3776 if (current_buffer
!= given_buffer
)
3783 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3790 /* Write to descriptor DESC the LEN characters starting at ADDR,
3791 assuming they start at position POS in the buffer.
3792 Intersperse with them the annotations from *ANNOT
3793 (those which fall within the range of positions POS to POS + LEN),
3794 each at its appropriate position.
3796 Modify *ANNOT by discarding elements as we output them.
3797 The return value is negative in case of system call failure. */
3800 a_write (desc
, addr
, len
, pos
, annot
)
3802 register char *addr
;
3809 int lastpos
= pos
+ len
;
3811 while (NILP (*annot
) || CONSP (*annot
))
3813 tem
= Fcar_safe (Fcar (*annot
));
3814 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
3815 nextpos
= XFASTINT (tem
);
3817 return e_write (desc
, addr
, lastpos
- pos
);
3820 if (0 > e_write (desc
, addr
, nextpos
- pos
))
3822 addr
+= nextpos
- pos
;
3825 tem
= Fcdr (Fcar (*annot
));
3828 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
))
3831 *annot
= Fcdr (*annot
);
3836 e_write (desc
, addr
, len
)
3838 register char *addr
;
3841 char buf
[16 * 1024];
3842 register char *p
, *end
;
3844 if (!EQ (current_buffer
->selective_display
, Qt
))
3845 return write (desc
, addr
, len
) - len
;
3849 end
= p
+ sizeof buf
;
3854 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
3863 if (write (desc
, buf
, p
- buf
) != p
- buf
)
3869 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
3870 Sverify_visited_file_modtime
, 1, 1, 0,
3871 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
3872 This means that the file has not been changed since it was visited or saved.")
3878 Lisp_Object handler
;
3880 CHECK_BUFFER (buf
, 0);
3883 if (!STRINGP (b
->filename
)) return Qt
;
3884 if (b
->modtime
== 0) return Qt
;
3886 /* If the file name has special constructs in it,
3887 call the corresponding file handler. */
3888 handler
= Ffind_file_name_handler (b
->filename
,
3889 Qverify_visited_file_modtime
);
3890 if (!NILP (handler
))
3891 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
3893 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
3895 /* If the file doesn't exist now and didn't exist before,
3896 we say that it isn't modified, provided the error is a tame one. */
3897 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
3902 if (st
.st_mtime
== b
->modtime
3903 /* If both are positive, accept them if they are off by one second. */
3904 || (st
.st_mtime
> 0 && b
->modtime
> 0
3905 && (st
.st_mtime
== b
->modtime
+ 1
3906 || st
.st_mtime
== b
->modtime
- 1)))
3911 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
3912 Sclear_visited_file_modtime
, 0, 0, 0,
3913 "Clear out records of last mod time of visited file.\n\
3914 Next attempt to save will certainly not complain of a discrepancy.")
3917 current_buffer
->modtime
= 0;
3921 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
3922 Svisited_file_modtime
, 0, 0, 0,
3923 "Return the current buffer's recorded visited file modification time.\n\
3924 The value is a list of the form (HIGH . LOW), like the time values\n\
3925 that `file-attributes' returns.")
3928 return long_to_cons ((unsigned long) current_buffer
->modtime
);
3931 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
3932 Sset_visited_file_modtime
, 0, 1, 0,
3933 "Update buffer's recorded modification time from the visited file's time.\n\
3934 Useful if the buffer was not read from the file normally\n\
3935 or if the file itself has been changed for some known benign reason.\n\
3936 An argument specifies the modification time value to use\n\
3937 \(instead of that of the visited file), in the form of a list\n\
3938 \(HIGH . LOW) or (HIGH LOW).")
3940 Lisp_Object time_list
;
3942 if (!NILP (time_list
))
3943 current_buffer
->modtime
= cons_to_long (time_list
);
3946 register Lisp_Object filename
;
3948 Lisp_Object handler
;
3950 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
3952 /* If the file name has special constructs in it,
3953 call the corresponding file handler. */
3954 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
3955 if (!NILP (handler
))
3956 /* The handler can find the file name the same way we did. */
3957 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
3958 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
3959 current_buffer
->modtime
= st
.st_mtime
;
3969 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3970 Fsleep_for (make_number (1), Qnil
);
3971 message ("Autosaving...error!for %s", XSTRING (current_buffer
->name
)->data
);
3972 Fsleep_for (make_number (1), Qnil
);
3973 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3974 Fsleep_for (make_number (1), Qnil
);
3984 /* Get visited file's mode to become the auto save file's mode. */
3985 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
3986 /* But make sure we can overwrite it later! */
3987 auto_save_mode_bits
= st
.st_mode
| 0600;
3989 auto_save_mode_bits
= 0666;
3992 Fwrite_region (Qnil
, Qnil
,
3993 current_buffer
->auto_save_file_name
,
3994 Qnil
, Qlambda
, Qnil
);
3998 do_auto_save_unwind (desc
) /* used as unwind-protect function */
4002 if (XINT (desc
) >= 0)
4003 close (XINT (desc
));
4007 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
4008 "Auto-save all buffers that need it.\n\
4009 This is all buffers that have auto-saving enabled\n\
4010 and are changed since last auto-saved.\n\
4011 Auto-saving writes the buffer into a file\n\
4012 so that your editing is not lost if the system crashes.\n\
4013 This file is not the file you visited; that changes only when you save.\n\
4014 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
4015 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
4016 A non-nil CURRENT-ONLY argument means save only current buffer.")
4017 (no_message
, current_only
)
4018 Lisp_Object no_message
, current_only
;
4020 struct buffer
*old
= current_buffer
, *b
;
4021 Lisp_Object tail
, buf
;
4023 char *omessage
= echo_area_glyphs
;
4024 int omessage_length
= echo_area_glyphs_length
;
4025 extern int minibuf_level
;
4026 int do_handled_files
;
4029 int count
= specpdl_ptr
- specpdl
;
4032 /* Ordinarily don't quit within this function,
4033 but don't make it impossible to quit (in case we get hung in I/O). */
4037 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
4038 point to non-strings reached from Vbuffer_alist. */
4043 if (!NILP (Vrun_hooks
))
4044 call1 (Vrun_hooks
, intern ("auto-save-hook"));
4046 if (STRINGP (Vauto_save_list_file_name
))
4048 Lisp_Object listfile
;
4049 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
4051 listdesc
= open (XSTRING (listfile
)->data
,
4052 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
4053 S_IREAD
| S_IWRITE
);
4054 #else /* not DOS_NT */
4055 listdesc
= creat (XSTRING (listfile
)->data
, 0666);
4056 #endif /* not DOS_NT */
4061 /* Arrange to close that file whether or not we get an error.
4062 Also reset auto_saving to 0. */
4063 record_unwind_protect (do_auto_save_unwind
, make_number (listdesc
));
4067 /* First, save all files which don't have handlers. If Emacs is
4068 crashing, the handlers may tweak what is causing Emacs to crash
4069 in the first place, and it would be a shame if Emacs failed to
4070 autosave perfectly ordinary files because it couldn't handle some
4072 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
4073 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
4075 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
4078 /* Record all the buffers that have auto save mode
4079 in the special file that lists them. For each of these buffers,
4080 Record visited name (if any) and auto save name. */
4081 if (STRINGP (b
->auto_save_file_name
)
4082 && listdesc
>= 0 && do_handled_files
== 0)
4084 if (!NILP (b
->filename
))
4086 write (listdesc
, XSTRING (b
->filename
)->data
,
4087 XSTRING (b
->filename
)->size
);
4089 write (listdesc
, "\n", 1);
4090 write (listdesc
, XSTRING (b
->auto_save_file_name
)->data
,
4091 XSTRING (b
->auto_save_file_name
)->size
);
4092 write (listdesc
, "\n", 1);
4095 if (!NILP (current_only
)
4096 && b
!= current_buffer
)
4099 /* Don't auto-save indirect buffers.
4100 The base buffer takes care of it. */
4104 /* Check for auto save enabled
4105 and file changed since last auto save
4106 and file changed since last real save. */
4107 if (STRINGP (b
->auto_save_file_name
)
4108 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
4109 && b
->auto_save_modified
< BUF_MODIFF (b
)
4110 /* -1 means we've turned off autosaving for a while--see below. */
4111 && XINT (b
->save_length
) >= 0
4112 && (do_handled_files
4113 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
4116 EMACS_TIME before_time
, after_time
;
4118 EMACS_GET_TIME (before_time
);
4120 /* If we had a failure, don't try again for 20 minutes. */
4121 if (b
->auto_save_failure_time
>= 0
4122 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
4125 if ((XFASTINT (b
->save_length
) * 10
4126 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
4127 /* A short file is likely to change a large fraction;
4128 spare the user annoying messages. */
4129 && XFASTINT (b
->save_length
) > 5000
4130 /* These messages are frequent and annoying for `*mail*'. */
4131 && !EQ (b
->filename
, Qnil
)
4132 && NILP (no_message
))
4134 /* It has shrunk too much; turn off auto-saving here. */
4135 message ("Buffer %s has shrunk a lot; auto save turned off there",
4136 XSTRING (b
->name
)->data
);
4137 /* Turn off auto-saving until there's a real save,
4138 and prevent any more warnings. */
4139 XSETINT (b
->save_length
, -1);
4140 Fsleep_for (make_number (1), Qnil
);
4143 set_buffer_internal (b
);
4144 if (!auto_saved
&& NILP (no_message
))
4145 message1 ("Auto-saving...");
4146 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
4148 b
->auto_save_modified
= BUF_MODIFF (b
);
4149 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4150 set_buffer_internal (old
);
4152 EMACS_GET_TIME (after_time
);
4154 /* If auto-save took more than 60 seconds,
4155 assume it was an NFS failure that got a timeout. */
4156 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
4157 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
4161 /* Prevent another auto save till enough input events come in. */
4162 record_auto_save ();
4164 if (auto_saved
&& NILP (no_message
))
4168 sit_for (1, 0, 0, 0);
4169 message2 (omessage
, omessage_length
);
4172 message1 ("Auto-saving...done");
4177 unbind_to (count
, Qnil
);
4181 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
4182 Sset_buffer_auto_saved
, 0, 0, 0,
4183 "Mark current buffer as auto-saved with its current text.\n\
4184 No auto-save file will be written until the buffer changes again.")
4187 current_buffer
->auto_save_modified
= MODIFF
;
4188 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4189 current_buffer
->auto_save_failure_time
= -1;
4193 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
4194 Sclear_buffer_auto_save_failure
, 0, 0, 0,
4195 "Clear any record of a recent auto-save failure in the current buffer.")
4198 current_buffer
->auto_save_failure_time
= -1;
4202 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
4204 "Return t if buffer has been auto-saved since last read in or saved.")
4207 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
4210 /* Reading and completing file names */
4211 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
4213 /* In the string VAL, change each $ to $$ and return the result. */
4216 double_dollars (val
)
4219 register unsigned char *old
, *new;
4223 osize
= XSTRING (val
)->size
;
4224 /* Quote "$" as "$$" to get it past substitute-in-file-name */
4225 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
4226 if (*old
++ == '$') count
++;
4229 old
= XSTRING (val
)->data
;
4230 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
4231 new = XSTRING (val
)->data
;
4232 for (n
= osize
; n
> 0; n
--)
4245 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
4247 "Internal subroutine for read-file-name. Do not call this.")
4248 (string
, dir
, action
)
4249 Lisp_Object string
, dir
, action
;
4250 /* action is nil for complete, t for return list of completions,
4251 lambda for verify final value */
4253 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
4255 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4262 /* No need to protect ACTION--we only compare it with t and nil. */
4263 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
4265 if (XSTRING (string
)->size
== 0)
4267 if (EQ (action
, Qlambda
))
4275 orig_string
= string
;
4276 string
= Fsubstitute_in_file_name (string
);
4277 changed
= NILP (Fstring_equal (string
, orig_string
));
4278 name
= Ffile_name_nondirectory (string
);
4279 val
= Ffile_name_directory (string
);
4281 realdir
= Fexpand_file_name (val
, realdir
);
4286 specdir
= Ffile_name_directory (string
);
4287 val
= Ffile_name_completion (name
, realdir
);
4292 return double_dollars (string
);
4296 if (!NILP (specdir
))
4297 val
= concat2 (specdir
, val
);
4299 return double_dollars (val
);
4302 #endif /* not VMS */
4306 if (EQ (action
, Qt
))
4307 return Ffile_name_all_completions (name
, realdir
);
4308 /* Only other case actually used is ACTION = lambda */
4310 /* Supposedly this helps commands such as `cd' that read directory names,
4311 but can someone explain how it helps them? -- RMS */
4312 if (XSTRING (name
)->size
== 0)
4315 return Ffile_exists_p (string
);
4318 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4319 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
4320 Value is not expanded---you must call `expand-file-name' yourself.\n\
4321 Default name to DEFAULT-FILENAME if user enters a null string.\n\
4322 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
4323 except that if INITIAL is specified, that combined with DIR is used.)\n\
4324 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
4325 Non-nil and non-t means also require confirmation after completion.\n\
4326 Fifth arg INITIAL specifies text to start with.\n\
4327 DIR defaults to current buffer's directory default.")
4328 (prompt
, dir
, default_filename
, mustmatch
, initial
)
4329 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
4331 Lisp_Object val
, insdef
, insdef1
, tem
;
4332 struct gcpro gcpro1
, gcpro2
;
4333 register char *homedir
;
4337 dir
= current_buffer
->directory
;
4338 if (NILP (default_filename
))
4340 if (! NILP (initial
))
4341 default_filename
= Fexpand_file_name (initial
, dir
);
4343 default_filename
= current_buffer
->filename
;
4346 /* If dir starts with user's homedir, change that to ~. */
4347 homedir
= (char *) egetenv ("HOME");
4349 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
4350 CORRECT_DIR_SEPS (homedir
);
4354 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4355 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
4357 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4358 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4359 XSTRING (dir
)->data
[0] = '~';
4362 if (insert_default_directory
)
4365 if (!NILP (initial
))
4367 Lisp_Object args
[2], pos
;
4371 insdef
= Fconcat (2, args
);
4372 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
4373 insdef1
= Fcons (double_dollars (insdef
), pos
);
4376 insdef1
= double_dollars (insdef
);
4378 else if (!NILP (initial
))
4381 insdef1
= Fcons (double_dollars (insdef
), 0);
4384 insdef
= Qnil
, insdef1
= Qnil
;
4387 count
= specpdl_ptr
- specpdl
;
4388 specbind (intern ("completion-ignore-case"), Qt
);
4391 GCPRO2 (insdef
, default_filename
);
4392 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4393 dir
, mustmatch
, insdef1
,
4394 Qfile_name_history
);
4397 unbind_to (count
, Qnil
);
4402 error ("No file name specified");
4403 tem
= Fstring_equal (val
, insdef
);
4404 if (!NILP (tem
) && !NILP (default_filename
))
4405 return default_filename
;
4406 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
4408 if (!NILP (default_filename
))
4409 return default_filename
;
4411 error ("No default file name");
4413 return Fsubstitute_in_file_name (val
);
4416 #if 0 /* Old version */
4417 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4418 /* Don't confuse make-docfile by having two doc strings for this function.
4419 make-docfile does not pay attention to #if, for good reason! */
4421 (prompt
, dir
, defalt
, mustmatch
, initial
)
4422 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4424 Lisp_Object val
, insdef
, tem
;
4425 struct gcpro gcpro1
, gcpro2
;
4426 register char *homedir
;
4430 dir
= current_buffer
->directory
;
4432 defalt
= current_buffer
->filename
;
4434 /* If dir starts with user's homedir, change that to ~. */
4435 homedir
= (char *) egetenv ("HOME");
4438 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4439 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
4441 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4442 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4443 XSTRING (dir
)->data
[0] = '~';
4446 if (!NILP (initial
))
4448 else if (insert_default_directory
)
4451 insdef
= build_string ("");
4454 count
= specpdl_ptr
- specpdl
;
4455 specbind (intern ("completion-ignore-case"), Qt
);
4458 GCPRO2 (insdef
, defalt
);
4459 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4461 insert_default_directory
? insdef
: Qnil
,
4462 Qfile_name_history
);
4465 unbind_to (count
, Qnil
);
4470 error ("No file name specified");
4471 tem
= Fstring_equal (val
, insdef
);
4472 if (!NILP (tem
) && !NILP (defalt
))
4474 return Fsubstitute_in_file_name (val
);
4476 #endif /* Old version */
4480 Qexpand_file_name
= intern ("expand-file-name");
4481 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
4482 Qdirectory_file_name
= intern ("directory-file-name");
4483 Qfile_name_directory
= intern ("file-name-directory");
4484 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
4485 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
4486 Qfile_name_as_directory
= intern ("file-name-as-directory");
4487 Qcopy_file
= intern ("copy-file");
4488 Qmake_directory_internal
= intern ("make-directory-internal");
4489 Qdelete_directory
= intern ("delete-directory");
4490 Qdelete_file
= intern ("delete-file");
4491 Qrename_file
= intern ("rename-file");
4492 Qadd_name_to_file
= intern ("add-name-to-file");
4493 Qmake_symbolic_link
= intern ("make-symbolic-link");
4494 Qfile_exists_p
= intern ("file-exists-p");
4495 Qfile_executable_p
= intern ("file-executable-p");
4496 Qfile_readable_p
= intern ("file-readable-p");
4497 Qfile_symlink_p
= intern ("file-symlink-p");
4498 Qfile_writable_p
= intern ("file-writable-p");
4499 Qfile_directory_p
= intern ("file-directory-p");
4500 Qfile_regular_p
= intern ("file-regular-p");
4501 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
4502 Qfile_modes
= intern ("file-modes");
4503 Qset_file_modes
= intern ("set-file-modes");
4504 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
4505 Qinsert_file_contents
= intern ("insert-file-contents");
4506 Qwrite_region
= intern ("write-region");
4507 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
4508 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
4510 staticpro (&Qexpand_file_name
);
4511 staticpro (&Qsubstitute_in_file_name
);
4512 staticpro (&Qdirectory_file_name
);
4513 staticpro (&Qfile_name_directory
);
4514 staticpro (&Qfile_name_nondirectory
);
4515 staticpro (&Qunhandled_file_name_directory
);
4516 staticpro (&Qfile_name_as_directory
);
4517 staticpro (&Qcopy_file
);
4518 staticpro (&Qmake_directory_internal
);
4519 staticpro (&Qdelete_directory
);
4520 staticpro (&Qdelete_file
);
4521 staticpro (&Qrename_file
);
4522 staticpro (&Qadd_name_to_file
);
4523 staticpro (&Qmake_symbolic_link
);
4524 staticpro (&Qfile_exists_p
);
4525 staticpro (&Qfile_executable_p
);
4526 staticpro (&Qfile_readable_p
);
4527 staticpro (&Qfile_symlink_p
);
4528 staticpro (&Qfile_writable_p
);
4529 staticpro (&Qfile_directory_p
);
4530 staticpro (&Qfile_regular_p
);
4531 staticpro (&Qfile_accessible_directory_p
);
4532 staticpro (&Qfile_modes
);
4533 staticpro (&Qset_file_modes
);
4534 staticpro (&Qfile_newer_than_file_p
);
4535 staticpro (&Qinsert_file_contents
);
4536 staticpro (&Qwrite_region
);
4537 staticpro (&Qverify_visited_file_modtime
);
4539 Qfile_name_history
= intern ("file-name-history");
4540 Fset (Qfile_name_history
, Qnil
);
4541 staticpro (&Qfile_name_history
);
4543 Qfile_error
= intern ("file-error");
4544 staticpro (&Qfile_error
);
4545 Qfile_already_exists
= intern ("file-already-exists");
4546 staticpro (&Qfile_already_exists
);
4549 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
4550 staticpro (&Qfind_buffer_file_type
);
4553 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
4554 "*Format in which to write auto-save files.\n\
4555 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
4556 If it is t, which is the default, auto-save files are written in the\n\
4557 same format as a regular save would use.");
4558 Vauto_save_file_format
= Qt
;
4560 Qformat_decode
= intern ("format-decode");
4561 staticpro (&Qformat_decode
);
4562 Qformat_annotate_function
= intern ("format-annotate-function");
4563 staticpro (&Qformat_annotate_function
);
4565 Qcar_less_than_car
= intern ("car-less-than-car");
4566 staticpro (&Qcar_less_than_car
);
4568 Fput (Qfile_error
, Qerror_conditions
,
4569 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
4570 Fput (Qfile_error
, Qerror_message
,
4571 build_string ("File error"));
4573 Fput (Qfile_already_exists
, Qerror_conditions
,
4574 Fcons (Qfile_already_exists
,
4575 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
4576 Fput (Qfile_already_exists
, Qerror_message
,
4577 build_string ("File already exists"));
4579 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
4580 "*Non-nil means when reading a filename start with default dir in minibuffer.");
4581 insert_default_directory
= 1;
4583 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
4584 "*Non-nil means write new files with record format `stmlf'.\n\
4585 nil means use format `var'. This variable is meaningful only on VMS.");
4586 vms_stmlf_recfm
= 0;
4588 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
4589 "Directory separator character for built-in functions that return file names.\n\
4590 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
4591 This variable affects the built-in functions only on Windows,\n\
4592 on other platforms, it is initialized so that Lisp code can find out\n\
4593 what the normal separator is.");
4594 Vdirectory_sep_char
= '/';
4596 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
4597 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
4598 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
4601 The first argument given to HANDLER is the name of the I/O primitive\n\
4602 to be handled; the remaining arguments are the arguments that were\n\
4603 passed to that primitive. For example, if you do\n\
4604 (file-exists-p FILENAME)\n\
4605 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
4606 (funcall HANDLER 'file-exists-p FILENAME)\n\
4607 The function `find-file-name-handler' checks this list for a handler\n\
4608 for its argument.");
4609 Vfile_name_handler_alist
= Qnil
;
4611 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
4612 "A list of functions to be called at the end of `insert-file-contents'.\n\
4613 Each is passed one argument, the number of bytes inserted. It should return\n\
4614 the new byte count, and leave point the same. If `insert-file-contents' is\n\
4615 intercepted by a handler from `file-name-handler-alist', that handler is\n\
4616 responsible for calling the after-insert-file-functions if appropriate.");
4617 Vafter_insert_file_functions
= Qnil
;
4619 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
4620 "A list of functions to be called at the start of `write-region'.\n\
4621 Each is passed two arguments, START and END as for `write-region'.\n\
4622 These are usually two numbers but not always; see the documentation\n\
4623 for `write-region'. The function should return a list of pairs\n\
4624 of the form (POSITION . STRING), consisting of strings to be effectively\n\
4625 inserted at the specified positions of the file being written (1 means to\n\
4626 insert before the first byte written). The POSITIONs must be sorted into\n\
4627 increasing order. If there are several functions in the list, the several\n\
4628 lists are merged destructively.");
4629 Vwrite_region_annotate_functions
= Qnil
;
4631 DEFVAR_LISP ("write-region-annotations-so-far",
4632 &Vwrite_region_annotations_so_far
,
4633 "When an annotation function is called, this holds the previous annotations.\n\
4634 These are the annotations made by other annotation functions\n\
4635 that were already called. See also `write-region-annotate-functions'.");
4636 Vwrite_region_annotations_so_far
= Qnil
;
4638 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
4639 "A list of file name handlers that temporarily should not be used.\n\
4640 This applies only to the operation `inhibit-file-name-operation'.");
4641 Vinhibit_file_name_handlers
= Qnil
;
4643 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
4644 "The operation for which `inhibit-file-name-handlers' is applicable.");
4645 Vinhibit_file_name_operation
= Qnil
;
4647 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
4648 "File name in which we write a list of all auto save file names.\n\
4649 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
4650 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
4652 Vauto_save_list_file_name
= Qnil
;
4654 defsubr (&Sfind_file_name_handler
);
4655 defsubr (&Sfile_name_directory
);
4656 defsubr (&Sfile_name_nondirectory
);
4657 defsubr (&Sunhandled_file_name_directory
);
4658 defsubr (&Sfile_name_as_directory
);
4659 defsubr (&Sdirectory_file_name
);
4660 defsubr (&Smake_temp_name
);
4661 defsubr (&Sexpand_file_name
);
4662 defsubr (&Ssubstitute_in_file_name
);
4663 defsubr (&Scopy_file
);
4664 defsubr (&Smake_directory_internal
);
4665 defsubr (&Sdelete_directory
);
4666 defsubr (&Sdelete_file
);
4667 defsubr (&Srename_file
);
4668 defsubr (&Sadd_name_to_file
);
4670 defsubr (&Smake_symbolic_link
);
4671 #endif /* S_IFLNK */
4673 defsubr (&Sdefine_logical_name
);
4676 defsubr (&Ssysnetunam
);
4677 #endif /* HPUX_NET */
4678 defsubr (&Sfile_name_absolute_p
);
4679 defsubr (&Sfile_exists_p
);
4680 defsubr (&Sfile_executable_p
);
4681 defsubr (&Sfile_readable_p
);
4682 defsubr (&Sfile_writable_p
);
4683 defsubr (&Sfile_symlink_p
);
4684 defsubr (&Sfile_directory_p
);
4685 defsubr (&Sfile_accessible_directory_p
);
4686 defsubr (&Sfile_regular_p
);
4687 defsubr (&Sfile_modes
);
4688 defsubr (&Sset_file_modes
);
4689 defsubr (&Sset_default_file_modes
);
4690 defsubr (&Sdefault_file_modes
);
4691 defsubr (&Sfile_newer_than_file_p
);
4692 defsubr (&Sinsert_file_contents
);
4693 defsubr (&Swrite_region
);
4694 defsubr (&Scar_less_than_car
);
4695 defsubr (&Sverify_visited_file_modtime
);
4696 defsubr (&Sclear_visited_file_modtime
);
4697 defsubr (&Svisited_file_modtime
);
4698 defsubr (&Sset_visited_file_modtime
);
4699 defsubr (&Sdo_auto_save
);
4700 defsubr (&Sset_buffer_auto_saved
);
4701 defsubr (&Sclear_buffer_auto_save_failure
);
4702 defsubr (&Srecent_auto_save_p
);
4704 defsubr (&Sread_file_name_internal
);
4705 defsubr (&Sread_file_name
);
4708 defsubr (&Sunix_sync
);