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')
105 #define DRIVE_LETTER(x) (x)
108 #define IS_DRIVE(x) isalpha (x)
109 extern Lisp_Object Vwin32_downcase_file_names
;
110 #define DRIVE_LETTER(x) (NILP (Vwin32_downcase_file_names) ? (x) : tolower (x))
140 #define min(a, b) ((a) < (b) ? (a) : (b))
141 #define max(a, b) ((a) > (b) ? (a) : (b))
143 /* Nonzero during writing of auto-save files */
146 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
147 a new file with the same mode as the original */
148 int auto_save_mode_bits
;
150 /* Alist of elements (REGEXP . HANDLER) for file names
151 whose I/O is done with a special handler. */
152 Lisp_Object Vfile_name_handler_alist
;
154 /* Format for auto-save files */
155 Lisp_Object Vauto_save_file_format
;
157 /* Lisp functions for translating file formats */
158 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
160 /* Functions to be called to process text properties in inserted file. */
161 Lisp_Object Vafter_insert_file_functions
;
163 /* Functions to be called to create text property annotations for file. */
164 Lisp_Object Vwrite_region_annotate_functions
;
166 /* During build_annotations, each time an annotation function is called,
167 this holds the annotations made by the previous functions. */
168 Lisp_Object Vwrite_region_annotations_so_far
;
170 /* File name in which we write a list of all our auto save files. */
171 Lisp_Object Vauto_save_list_file_name
;
173 /* Nonzero means, when reading a filename in the minibuffer,
174 start out by inserting the default directory into the minibuffer. */
175 int insert_default_directory
;
177 /* On VMS, nonzero means write new files with record format stmlf.
178 Zero means use var format. */
181 /* On NT, specifies the directory separator character, used (eg.) when
182 expanding file names. This can be bound to / or \. */
183 Lisp_Object Vdirectory_sep_char
;
185 /* These variables describe handlers that have "already" had a chance
186 to handle the current operation.
188 Vinhibit_file_name_handlers is a list of file name handlers.
189 Vinhibit_file_name_operation is the operation being handled.
190 If we try to handle that operation, we ignore those handlers. */
192 static Lisp_Object Vinhibit_file_name_handlers
;
193 static Lisp_Object Vinhibit_file_name_operation
;
195 Lisp_Object Qfile_error
, Qfile_already_exists
;
197 Lisp_Object Qfile_name_history
;
199 Lisp_Object Qcar_less_than_car
;
201 report_file_error (string
, data
)
205 Lisp_Object errstring
;
207 errstring
= build_string (strerror (errno
));
209 /* System error messages are capitalized. Downcase the initial
210 unless it is followed by a slash. */
211 if (XSTRING (errstring
)->data
[1] != '/')
212 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
215 Fsignal (Qfile_error
,
216 Fcons (build_string (string
), Fcons (errstring
, data
)));
219 close_file_unwind (fd
)
222 close (XFASTINT (fd
));
225 /* Restore point, having saved it as a marker. */
227 restore_point_unwind (location
)
228 Lisp_Object location
;
230 SET_PT (marker_position (location
));
231 Fset_marker (location
, Qnil
, Qnil
);
234 Lisp_Object Qexpand_file_name
;
235 Lisp_Object Qsubstitute_in_file_name
;
236 Lisp_Object Qdirectory_file_name
;
237 Lisp_Object Qfile_name_directory
;
238 Lisp_Object Qfile_name_nondirectory
;
239 Lisp_Object Qunhandled_file_name_directory
;
240 Lisp_Object Qfile_name_as_directory
;
241 Lisp_Object Qcopy_file
;
242 Lisp_Object Qmake_directory_internal
;
243 Lisp_Object Qdelete_directory
;
244 Lisp_Object Qdelete_file
;
245 Lisp_Object Qrename_file
;
246 Lisp_Object Qadd_name_to_file
;
247 Lisp_Object Qmake_symbolic_link
;
248 Lisp_Object Qfile_exists_p
;
249 Lisp_Object Qfile_executable_p
;
250 Lisp_Object Qfile_readable_p
;
251 Lisp_Object Qfile_symlink_p
;
252 Lisp_Object Qfile_writable_p
;
253 Lisp_Object Qfile_directory_p
;
254 Lisp_Object Qfile_regular_p
;
255 Lisp_Object Qfile_accessible_directory_p
;
256 Lisp_Object Qfile_modes
;
257 Lisp_Object Qset_file_modes
;
258 Lisp_Object Qfile_newer_than_file_p
;
259 Lisp_Object Qinsert_file_contents
;
260 Lisp_Object Qwrite_region
;
261 Lisp_Object Qverify_visited_file_modtime
;
262 Lisp_Object Qset_visited_file_modtime
;
264 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
265 "Return FILENAME's handler function for OPERATION, if it has one.\n\
266 Otherwise, return nil.\n\
267 A file name is handled if one of the regular expressions in\n\
268 `file-name-handler-alist' matches it.\n\n\
269 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
270 any handlers that are members of `inhibit-file-name-handlers',\n\
271 but we still do run any other handlers. This lets handlers\n\
272 use the standard functions without calling themselves recursively.")
273 (filename
, operation
)
274 Lisp_Object filename
, operation
;
276 /* This function must not munge the match data. */
277 Lisp_Object chain
, inhibited_handlers
;
279 CHECK_STRING (filename
, 0);
281 if (EQ (operation
, Vinhibit_file_name_operation
))
282 inhibited_handlers
= Vinhibit_file_name_handlers
;
284 inhibited_handlers
= Qnil
;
286 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
287 chain
= XCONS (chain
)->cdr
)
290 elt
= XCONS (chain
)->car
;
294 string
= XCONS (elt
)->car
;
295 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
297 Lisp_Object handler
, tem
;
299 handler
= XCONS (elt
)->cdr
;
300 tem
= Fmemq (handler
, inhibited_handlers
);
311 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
313 "Return the directory component in file name FILENAME.\n\
314 Return nil if FILENAME does not include a directory.\n\
315 Otherwise return a directory spec.\n\
316 Given a Unix syntax file name, returns a string ending in slash;\n\
317 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
319 Lisp_Object filename
;
321 register unsigned char *beg
;
322 register unsigned char *p
;
325 CHECK_STRING (filename
, 0);
327 /* If the file name has special constructs in it,
328 call the corresponding file handler. */
329 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
331 return call2 (handler
, Qfile_name_directory
, filename
);
333 #ifdef FILE_SYSTEM_CASE
334 filename
= FILE_SYSTEM_CASE (filename
);
336 beg
= XSTRING (filename
)->data
;
338 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
340 p
= beg
+ XSTRING (filename
)->size
;
342 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
344 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
347 /* only recognise drive specifier at beginning */
348 && !(p
[-1] == ':' && p
== beg
+ 2)
355 /* Expansion of "c:" to drive and default directory. */
356 if (p
== beg
+ 2 && beg
[1] == ':')
358 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
359 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
360 if (getdefdir (toupper (*beg
) - 'A' + 1, res
))
362 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
365 p
= beg
+ strlen (beg
);
368 CORRECT_DIR_SEPS (beg
);
370 return make_string (beg
, p
- beg
);
373 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
375 "Return file name FILENAME sans its directory.\n\
376 For example, in a Unix-syntax file name,\n\
377 this is everything after the last slash,\n\
378 or the entire name if it contains no slash.")
380 Lisp_Object filename
;
382 register unsigned char *beg
, *p
, *end
;
385 CHECK_STRING (filename
, 0);
387 /* If the file name has special constructs in it,
388 call the corresponding file handler. */
389 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
391 return call2 (handler
, Qfile_name_nondirectory
, filename
);
393 beg
= XSTRING (filename
)->data
;
394 end
= p
= beg
+ XSTRING (filename
)->size
;
396 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
398 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
401 /* only recognise drive specifier at beginning */
402 && !(p
[-1] == ':' && p
== beg
+ 2)
406 return make_string (p
, end
- p
);
409 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
, Sunhandled_file_name_directory
, 1, 1, 0,
410 "Return a directly usable directory name somehow associated with FILENAME.\n\
411 A `directly usable' directory name is one that may be used without the\n\
412 intervention of any file handler.\n\
413 If FILENAME is a directly usable file itself, return\n\
414 (file-name-directory FILENAME).\n\
415 The `call-process' and `start-process' functions use this function to\n\
416 get a current directory to run processes in.")
418 Lisp_Object filename
;
422 /* If the file name has special constructs in it,
423 call the corresponding file handler. */
424 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
426 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
428 return Ffile_name_directory (filename
);
433 file_name_as_directory (out
, in
)
436 int size
= strlen (in
) - 1;
441 /* Is it already a directory string? */
442 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
444 /* Is it a VMS directory file name? If so, hack VMS syntax. */
445 else if (! index (in
, '/')
446 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
447 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
448 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
449 || ! strncmp (&in
[size
- 5], ".dir", 4))
450 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
451 && in
[size
] == '1')))
453 register char *p
, *dot
;
457 dir:x.dir --> dir:[x]
458 dir:[x]y.dir --> dir:[x.y] */
460 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
463 strncpy (out
, in
, p
- in
);
482 dot
= index (p
, '.');
485 /* blindly remove any extension */
486 size
= strlen (out
) + (dot
- p
);
487 strncat (out
, p
, dot
- p
);
498 /* For Unix syntax, Append a slash if necessary */
499 if (!IS_DIRECTORY_SEP (out
[size
]))
501 out
[size
+ 1] = DIRECTORY_SEP
;
502 out
[size
+ 2] = '\0';
505 CORRECT_DIR_SEPS (out
);
511 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
512 Sfile_name_as_directory
, 1, 1, 0,
513 "Return a string representing file FILENAME interpreted as a directory.\n\
514 This operation exists because a directory is also a file, but its name as\n\
515 a directory is different from its name as a file.\n\
516 The result can be used as the value of `default-directory'\n\
517 or passed as second argument to `expand-file-name'.\n\
518 For a Unix-syntax file name, just appends a slash.\n\
519 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
526 CHECK_STRING (file
, 0);
530 /* If the file name has special constructs in it,
531 call the corresponding file handler. */
532 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
534 return call2 (handler
, Qfile_name_as_directory
, file
);
536 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
537 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
541 * Convert from directory name to filename.
543 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
544 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
545 * On UNIX, it's simple: just make sure there isn't a terminating /
547 * Value is nonzero if the string output is different from the input.
550 directory_file_name (src
, dst
)
558 struct FAB fab
= cc$rms_fab
;
559 struct NAM nam
= cc$rms_nam
;
560 char esa
[NAM$C_MAXRSS
];
565 if (! index (src
, '/')
566 && (src
[slen
- 1] == ']'
567 || src
[slen
- 1] == ':'
568 || src
[slen
- 1] == '>'))
570 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
572 fab
.fab$b_fns
= slen
;
573 fab
.fab$l_nam
= &nam
;
574 fab
.fab$l_fop
= FAB$M_NAM
;
577 nam
.nam$b_ess
= sizeof esa
;
578 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
580 /* We call SYS$PARSE to handle such things as [--] for us. */
581 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
583 slen
= nam
.nam$b_esl
;
584 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
589 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
591 /* what about when we have logical_name:???? */
592 if (src
[slen
- 1] == ':')
593 { /* Xlate logical name and see what we get */
594 ptr
= strcpy (dst
, src
); /* upper case for getenv */
597 if ('a' <= *ptr
&& *ptr
<= 'z')
601 dst
[slen
- 1] = 0; /* remove colon */
602 if (!(src
= egetenv (dst
)))
604 /* should we jump to the beginning of this procedure?
605 Good points: allows us to use logical names that xlate
607 Bad points: can be a problem if we just translated to a device
609 For now, I'll punt and always expect VMS names, and hope for
612 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
613 { /* no recursion here! */
619 { /* not a directory spec */
624 bracket
= src
[slen
- 1];
626 /* If bracket is ']' or '>', bracket - 2 is the corresponding
628 ptr
= index (src
, bracket
- 2);
630 { /* no opening bracket */
634 if (!(rptr
= rindex (src
, '.')))
637 strncpy (dst
, src
, slen
);
641 dst
[slen
++] = bracket
;
646 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
647 then translate the device and recurse. */
648 if (dst
[slen
- 1] == ':'
649 && dst
[slen
- 2] != ':' /* skip decnet nodes */
650 && strcmp (src
+ slen
, "[000000]") == 0)
652 dst
[slen
- 1] = '\0';
653 if ((ptr
= egetenv (dst
))
654 && (rlen
= strlen (ptr
) - 1) > 0
655 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
656 && ptr
[rlen
- 1] == '.')
658 char * buf
= (char *) alloca (strlen (ptr
) + 1);
662 return directory_file_name (buf
, dst
);
667 strcat (dst
, "[000000]");
671 rlen
= strlen (rptr
) - 1;
672 strncat (dst
, rptr
, rlen
);
673 dst
[slen
+ rlen
] = '\0';
674 strcat (dst
, ".DIR.1");
678 /* Process as Unix format: just remove any final slash.
679 But leave "/" unchanged; do not change it to "". */
682 /* Handle // as root for apollo's. */
683 if ((slen
> 2 && dst
[slen
- 1] == '/')
684 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
688 && IS_DIRECTORY_SEP (dst
[slen
- 1])
690 && !IS_ANY_SEP (dst
[slen
- 2])
696 CORRECT_DIR_SEPS (dst
);
701 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
703 "Returns the file name of the directory named DIRECTORY.\n\
704 This is the name of the file that holds the data for the directory DIRECTORY.\n\
705 This operation exists because a directory is also a file, but its name as\n\
706 a directory is different from its name as a file.\n\
707 In Unix-syntax, this function just removes the final slash.\n\
708 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
709 it returns a file name such as \"[X]Y.DIR.1\".")
711 Lisp_Object directory
;
716 CHECK_STRING (directory
, 0);
718 if (NILP (directory
))
721 /* If the file name has special constructs in it,
722 call the corresponding file handler. */
723 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
725 return call2 (handler
, Qdirectory_file_name
, directory
);
728 /* 20 extra chars is insufficient for VMS, since we might perform a
729 logical name translation. an equivalence string can be up to 255
730 chars long, so grab that much extra space... - sss */
731 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
733 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
735 directory_file_name (XSTRING (directory
)->data
, buf
);
736 return build_string (buf
);
739 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
740 "Generate temporary file name (string) starting with PREFIX (a string).\n\
741 The Emacs process number forms part of the result,\n\
742 so there is no danger of generating a name being used by another process.")
748 /* Don't use too many characters of the restricted 8+3 DOS
750 val
= concat2 (prefix
, build_string ("a.XXX"));
752 val
= concat2 (prefix
, build_string ("XXXXXX"));
754 mktemp (XSTRING (val
)->data
);
756 CORRECT_DIR_SEPS (XSTRING (val
)->data
);
761 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
762 "Convert filename NAME to absolute, and canonicalize it.\n\
763 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative\n\
764 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,\n\
765 the current buffer's value of default-directory is used.\n\
766 File name components that are `.' are removed, and \n\
767 so are file name components followed by `..', along with the `..' itself;\n\
768 note that these simplifications are done without checking the resulting\n\
769 file names in the file system.\n\
770 An initial `~/' expands to your home directory.\n\
771 An initial `~USER/' expands to USER's home directory.\n\
772 See also the function `substitute-in-file-name'.")
773 (name
, default_directory
)
774 Lisp_Object name
, default_directory
;
778 register unsigned char *newdir
, *p
, *o
;
780 unsigned char *target
;
783 unsigned char * colon
= 0;
784 unsigned char * close
= 0;
785 unsigned char * slash
= 0;
786 unsigned char * brack
= 0;
787 int lbrack
= 0, rbrack
= 0;
792 int collapse_newdir
= 1;
797 CHECK_STRING (name
, 0);
799 /* If the file name has special constructs in it,
800 call the corresponding file handler. */
801 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
803 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
805 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
806 if (NILP (default_directory
))
807 default_directory
= current_buffer
->directory
;
808 CHECK_STRING (default_directory
, 1);
810 if (!NILP (default_directory
))
812 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
814 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
817 o
= XSTRING (default_directory
)->data
;
819 /* Make sure DEFAULT_DIRECTORY is properly expanded.
820 It would be better to do this down below where we actually use
821 default_directory. Unfortunately, calling Fexpand_file_name recursively
822 could invoke GC, and the strings might be relocated. This would
823 be annoying because we have pointers into strings lying around
824 that would need adjusting, and people would add new pointers to
825 the code and forget to adjust them, resulting in intermittent bugs.
826 Putting this call here avoids all that crud.
828 The EQ test avoids infinite recursion. */
829 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
830 /* Save time in some common cases - as long as default_directory
831 is not relative, it can be canonicalized with name below (if it
832 is needed at all) without requiring it to be expanded now. */
834 /* Detect MSDOS file names with drive specifiers. */
835 && ! (IS_DRIVE (o
[0]) && (IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2])))
837 /* Detect Windows file names in UNC format. */
838 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
840 #else /* not DOS_NT */
841 /* Detect Unix absolute file names (/... alone is not absolute on
843 && ! (IS_DIRECTORY_SEP (o
[0]))
844 #endif /* not DOS_NT */
850 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
855 /* Filenames on VMS are always upper case. */
856 name
= Fupcase (name
);
858 #ifdef FILE_SYSTEM_CASE
859 name
= FILE_SYSTEM_CASE (name
);
862 nm
= XSTRING (name
)->data
;
865 /* We will force directory separators to be either all \ or /, so make
866 a local copy to modify, even if there ends up being no change. */
867 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
869 /* Find and remove drive specifier if present; this makes nm absolute
870 even if the rest of the name appears to be relative. */
872 unsigned char *colon
= rindex (nm
, ':');
875 /* Only recognize colon as part of drive specifier if there is a
876 single alphabetic character preceeding the colon (and if the
877 character before the drive letter, if present, is a directory
878 separator); this is to support the remote system syntax used by
879 ange-ftp, and the "po:username" syntax for POP mailboxes. */
883 else if (IS_DRIVE (colon
[-1])
884 && (colon
== nm
+ 1 || IS_DIRECTORY_SEP (colon
[-2])))
891 while (--colon
>= nm
)
898 /* Handle // and /~ in middle of file name
899 by discarding everything through the first / of that sequence. */
903 /* Since we are expecting the name to be absolute, we can assume
904 that each element starts with a "/". */
906 if (IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1])
907 #if defined (APOLLO) || defined (WINDOWSNT)
908 /* // at start of filename is meaningful on Apollo
909 and WindowsNT systems */
911 #endif /* APOLLO || WINDOWSNT */
915 if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '~')
922 /* Discard any previous drive specifier if nm is now in UNC format. */
923 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
929 /* If nm is absolute, look for /./ or /../ sequences; if none are
930 found, we can probably return right away. We will avoid allocating
931 a new string if name is already fully expanded. */
933 IS_DIRECTORY_SEP (nm
[0])
938 && (drive
|| IS_DIRECTORY_SEP (nm
[1]))
945 /* If it turns out that the filename we want to return is just a
946 suffix of FILENAME, we don't need to go through and edit
947 things; we just need to construct a new string using data
948 starting at the middle of FILENAME. If we set lose to a
949 non-zero value, that means we've discovered that we can't do
956 /* Since we know the name is absolute, we can assume that each
957 element starts with a "/". */
959 /* "." and ".." are hairy. */
960 if (IS_DIRECTORY_SEP (p
[0])
962 && (IS_DIRECTORY_SEP (p
[2])
964 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
971 /* if dev:[dir]/, move nm to / */
972 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
973 nm
= (brack
? brack
+ 1 : colon
+ 1);
982 /* VMS pre V4.4,convert '-'s in filenames. */
983 if (lbrack
== rbrack
)
985 if (dots
< 2) /* this is to allow negative version numbers */
990 if (lbrack
> rbrack
&&
991 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
992 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
998 /* count open brackets, reset close bracket pointer */
999 if (p
[0] == '[' || p
[0] == '<')
1000 lbrack
++, brack
= 0;
1001 /* count close brackets, set close bracket pointer */
1002 if (p
[0] == ']' || p
[0] == '>')
1003 rbrack
++, brack
= p
;
1004 /* detect ][ or >< */
1005 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1007 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1008 nm
= p
+ 1, lose
= 1;
1009 if (p
[0] == ':' && (colon
|| slash
))
1010 /* if dev1:[dir]dev2:, move nm to dev2: */
1016 /* if /name/dev:, move nm to dev: */
1019 /* if node::dev:, move colon following dev */
1020 else if (colon
&& colon
[-1] == ':')
1022 /* if dev1:dev2:, move nm to dev2: */
1023 else if (colon
&& colon
[-1] != ':')
1028 if (p
[0] == ':' && !colon
)
1034 if (lbrack
== rbrack
)
1037 else if (p
[0] == '.')
1045 if (index (nm
, '/'))
1046 return build_string (sys_translate_unix (nm
));
1049 /* Make sure directories are all separated with / or \ as
1050 desired, but avoid allocation of a new string when not
1052 CORRECT_DIR_SEPS (nm
);
1054 if (IS_DIRECTORY_SEP (nm
[1]))
1056 if (strcmp (nm
, XSTRING (name
)->data
) != 0)
1057 name
= build_string (nm
);
1061 /* drive must be set, so this is okay */
1062 if (strcmp (nm
- 2, XSTRING (name
)->data
) != 0)
1064 name
= make_string (nm
- 2, p
- nm
+ 2);
1065 XSTRING (name
)->data
[0] = DRIVE_LETTER (drive
);
1066 XSTRING (name
)->data
[1] = ':';
1069 #else /* not DOS_NT */
1070 if (nm
== XSTRING (name
)->data
)
1072 return build_string (nm
);
1073 #endif /* not DOS_NT */
1077 /* At this point, nm might or might not be an absolute file name. We
1078 need to expand ~ or ~user if present, otherwise prefix nm with
1079 default_directory if nm is not absolute, and finally collapse /./
1080 and /foo/../ sequences.
1082 We set newdir to be the appropriate prefix if one is needed:
1083 - the relevant user directory if nm starts with ~ or ~user
1084 - the specified drive's working dir (DOS/NT only) if nm does not
1086 - the value of default_directory.
1088 Note that these prefixes are not guaranteed to be absolute (except
1089 for the working dir of a drive). Therefore, to ensure we always
1090 return an absolute name, if the final prefix is not absolute we
1091 append it to the current working directory. */
1095 if (nm
[0] == '~') /* prefix ~ */
1097 if (IS_DIRECTORY_SEP (nm
[1])
1101 || nm
[1] == 0) /* ~ by itself */
1103 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1104 newdir
= (unsigned char *) "";
1107 collapse_newdir
= 0;
1110 nm
++; /* Don't leave the slash in nm. */
1113 else /* ~user/filename */
1115 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1120 o
= (unsigned char *) alloca (p
- nm
+ 1);
1121 bcopy ((char *) nm
, o
, p
- nm
);
1124 pw
= (struct passwd
*) getpwnam (o
+ 1);
1127 newdir
= (unsigned char *) pw
-> pw_dir
;
1129 nm
= p
+ 1; /* skip the terminator */
1133 collapse_newdir
= 0;
1138 /* If we don't find a user of that name, leave the name
1139 unchanged; don't move nm forward to p. */
1144 /* On DOS and Windows, nm is absolute if a drive name was specified;
1145 use the drive's current directory as the prefix if needed. */
1146 if (!newdir
&& drive
)
1148 /* Get default directory if needed to make nm absolute. */
1149 if (!IS_DIRECTORY_SEP (nm
[0]))
1151 newdir
= alloca (MAXPATHLEN
+ 1);
1152 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1157 /* Either nm starts with /, or drive isn't mounted. */
1158 newdir
= alloca (4);
1159 newdir
[0] = DRIVE_LETTER (drive
);
1167 /* Finally, if no prefix has been specified and nm is not absolute,
1168 then it must be expanded relative to default_directory. */
1172 /* /... alone is not absolute on DOS and Windows. */
1173 && !IS_DIRECTORY_SEP (nm
[0])
1176 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1183 newdir
= XSTRING (default_directory
)->data
;
1189 /* First ensure newdir is an absolute name. */
1191 /* Detect MSDOS file names with drive specifiers. */
1192 ! (IS_DRIVE (newdir
[0])
1193 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1195 /* Detect Windows file names in UNC format. */
1196 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1200 /* Effectively, let newdir be (expand-file-name newdir cwd).
1201 Because of the admonition against calling expand-file-name
1202 when we have pointers into lisp strings, we accomplish this
1203 indirectly by prepending newdir to nm if necessary, and using
1204 cwd (or the wd of newdir's drive) as the new newdir. */
1206 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1211 if (!IS_DIRECTORY_SEP (nm
[0]))
1213 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1214 file_name_as_directory (tmp
, newdir
);
1218 newdir
= alloca (MAXPATHLEN
+ 1);
1221 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1228 /* Strip off drive name from prefix, if present. */
1229 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1235 /* Keep only a prefix from newdir if nm starts with slash
1236 (//server/share for UNC, nothing otherwise). */
1237 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1240 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1242 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1244 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1246 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1258 /* Get rid of any slash at the end of newdir, unless newdir is
1259 just // (an incomplete UNC name). */
1260 length
= strlen (newdir
);
1261 if (IS_DIRECTORY_SEP (newdir
[length
- 1])
1263 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1267 unsigned char *temp
= (unsigned char *) alloca (length
);
1268 bcopy (newdir
, temp
, length
- 1);
1269 temp
[length
- 1] = 0;
1277 /* Now concatenate the directory and name to new space in the stack frame */
1278 tlen
+= strlen (nm
) + 1;
1280 /* Add reserved space for drive name. (The Microsoft x86 compiler
1281 produces incorrect code if the following two lines are combined.) */
1282 target
= (unsigned char *) alloca (tlen
+ 2);
1284 #else /* not DOS_NT */
1285 target
= (unsigned char *) alloca (tlen
);
1286 #endif /* not DOS_NT */
1292 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1293 strcpy (target
, newdir
);
1296 file_name_as_directory (target
, newdir
);
1299 strcat (target
, nm
);
1301 if (index (target
, '/'))
1302 strcpy (target
, sys_translate_unix (target
));
1305 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1307 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1315 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1321 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1322 /* brackets are offset from each other by 2 */
1325 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1326 /* convert [foo][bar] to [bar] */
1327 while (o
[-1] != '[' && o
[-1] != '<')
1329 else if (*p
== '-' && *o
!= '.')
1332 else if (p
[0] == '-' && o
[-1] == '.' &&
1333 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1334 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1338 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1339 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1341 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1343 /* else [foo.-] ==> [-] */
1349 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1350 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1356 if (!IS_DIRECTORY_SEP (*p
))
1360 else if (IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1])
1361 #if defined (APOLLO) || defined (WINDOWSNT)
1362 /* // at start of filename is meaningful in Apollo
1363 and WindowsNT systems */
1365 #endif /* APOLLO || WINDOWSNT */
1371 else if (IS_DIRECTORY_SEP (p
[0])
1373 && (IS_DIRECTORY_SEP (p
[2])
1376 /* If "/." is the entire filename, keep the "/". Otherwise,
1377 just delete the whole "/.". */
1378 if (o
== target
&& p
[2] == '\0')
1382 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1383 /* `/../' is the "superroot" on certain file systems. */
1385 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1387 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1395 #endif /* not VMS */
1399 /* At last, set drive name. */
1401 /* Except for network file name. */
1402 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1403 #endif /* WINDOWSNT */
1405 if (!drive
) abort ();
1407 target
[0] = DRIVE_LETTER (drive
);
1410 CORRECT_DIR_SEPS (target
);
1413 return make_string (target
, o
- target
);
1417 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1418 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1419 "Convert FILENAME to absolute, and canonicalize it.\n\
1420 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1421 (does not start with slash); if DEFAULT is nil or missing,\n\
1422 the current buffer's value of default-directory is used.\n\
1423 Filenames containing `.' or `..' as components are simplified;\n\
1424 initial `~/' expands to your home directory.\n\
1425 See also the function `substitute-in-file-name'.")
1427 Lisp_Object name
, defalt
;
1431 register unsigned char *newdir
, *p
, *o
;
1433 unsigned char *target
;
1437 unsigned char * colon
= 0;
1438 unsigned char * close
= 0;
1439 unsigned char * slash
= 0;
1440 unsigned char * brack
= 0;
1441 int lbrack
= 0, rbrack
= 0;
1445 CHECK_STRING (name
, 0);
1448 /* Filenames on VMS are always upper case. */
1449 name
= Fupcase (name
);
1452 nm
= XSTRING (name
)->data
;
1454 /* If nm is absolute, flush ...// and detect /./ and /../.
1455 If no /./ or /../ we can return right away. */
1467 if (p
[0] == '/' && p
[1] == '/'
1469 /* // at start of filename is meaningful on Apollo system */
1474 if (p
[0] == '/' && p
[1] == '~')
1475 nm
= p
+ 1, lose
= 1;
1476 if (p
[0] == '/' && p
[1] == '.'
1477 && (p
[2] == '/' || p
[2] == 0
1478 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1484 /* if dev:[dir]/, move nm to / */
1485 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1486 nm
= (brack
? brack
+ 1 : colon
+ 1);
1487 lbrack
= rbrack
= 0;
1495 /* VMS pre V4.4,convert '-'s in filenames. */
1496 if (lbrack
== rbrack
)
1498 if (dots
< 2) /* this is to allow negative version numbers */
1503 if (lbrack
> rbrack
&&
1504 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1505 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1511 /* count open brackets, reset close bracket pointer */
1512 if (p
[0] == '[' || p
[0] == '<')
1513 lbrack
++, brack
= 0;
1514 /* count close brackets, set close bracket pointer */
1515 if (p
[0] == ']' || p
[0] == '>')
1516 rbrack
++, brack
= p
;
1517 /* detect ][ or >< */
1518 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1520 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1521 nm
= p
+ 1, lose
= 1;
1522 if (p
[0] == ':' && (colon
|| slash
))
1523 /* if dev1:[dir]dev2:, move nm to dev2: */
1529 /* If /name/dev:, move nm to dev: */
1532 /* If node::dev:, move colon following dev */
1533 else if (colon
&& colon
[-1] == ':')
1535 /* If dev1:dev2:, move nm to dev2: */
1536 else if (colon
&& colon
[-1] != ':')
1541 if (p
[0] == ':' && !colon
)
1547 if (lbrack
== rbrack
)
1550 else if (p
[0] == '.')
1558 if (index (nm
, '/'))
1559 return build_string (sys_translate_unix (nm
));
1561 if (nm
== XSTRING (name
)->data
)
1563 return build_string (nm
);
1567 /* Now determine directory to start with and put it in NEWDIR */
1571 if (nm
[0] == '~') /* prefix ~ */
1576 || nm
[1] == 0)/* ~/filename */
1578 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1579 newdir
= (unsigned char *) "";
1582 nm
++; /* Don't leave the slash in nm. */
1585 else /* ~user/filename */
1587 /* Get past ~ to user */
1588 unsigned char *user
= nm
+ 1;
1589 /* Find end of name. */
1590 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1591 int len
= ptr
? ptr
- user
: strlen (user
);
1593 unsigned char *ptr1
= index (user
, ':');
1594 if (ptr1
!= 0 && ptr1
- user
< len
)
1597 /* Copy the user name into temp storage. */
1598 o
= (unsigned char *) alloca (len
+ 1);
1599 bcopy ((char *) user
, o
, len
);
1602 /* Look up the user name. */
1603 pw
= (struct passwd
*) getpwnam (o
+ 1);
1605 error ("\"%s\" isn't a registered user", o
+ 1);
1607 newdir
= (unsigned char *) pw
->pw_dir
;
1609 /* Discard the user name from NM. */
1616 #endif /* not VMS */
1620 defalt
= current_buffer
->directory
;
1621 CHECK_STRING (defalt
, 1);
1622 newdir
= XSTRING (defalt
)->data
;
1625 /* Now concatenate the directory and name to new space in the stack frame */
1627 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1628 target
= (unsigned char *) alloca (tlen
);
1634 if (nm
[0] == 0 || nm
[0] == '/')
1635 strcpy (target
, newdir
);
1638 file_name_as_directory (target
, newdir
);
1641 strcat (target
, nm
);
1643 if (index (target
, '/'))
1644 strcpy (target
, sys_translate_unix (target
));
1647 /* Now canonicalize by removing /. and /foo/.. if they appear */
1655 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1661 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1662 /* brackets are offset from each other by 2 */
1665 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1666 /* convert [foo][bar] to [bar] */
1667 while (o
[-1] != '[' && o
[-1] != '<')
1669 else if (*p
== '-' && *o
!= '.')
1672 else if (p
[0] == '-' && o
[-1] == '.' &&
1673 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1674 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1678 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1679 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1681 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1683 /* else [foo.-] ==> [-] */
1689 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1690 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1700 else if (!strncmp (p
, "//", 2)
1702 /* // at start of filename is meaningful in Apollo system */
1710 else if (p
[0] == '/' && p
[1] == '.' &&
1711 (p
[2] == '/' || p
[2] == 0))
1713 else if (!strncmp (p
, "/..", 3)
1714 /* `/../' is the "superroot" on certain file systems. */
1716 && (p
[3] == '/' || p
[3] == 0))
1718 while (o
!= target
&& *--o
!= '/')
1721 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1725 if (o
== target
&& *o
== '/')
1733 #endif /* not VMS */
1736 return make_string (target
, o
- target
);
1740 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1741 Ssubstitute_in_file_name
, 1, 1, 0,
1742 "Substitute environment variables referred to in FILENAME.\n\
1743 `$FOO' where FOO is an environment variable name means to substitute\n\
1744 the value of that variable. The variable name should be terminated\n\
1745 with a character not a letter, digit or underscore; otherwise, enclose\n\
1746 the entire variable name in braces.\n\
1747 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1748 On VMS, `$' substitution is not done; this function does little and only\n\
1749 duplicates what `expand-file-name' does.")
1751 Lisp_Object filename
;
1755 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1756 unsigned char *target
;
1758 int substituted
= 0;
1760 Lisp_Object handler
;
1762 CHECK_STRING (filename
, 0);
1764 /* If the file name has special constructs in it,
1765 call the corresponding file handler. */
1766 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1767 if (!NILP (handler
))
1768 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1770 nm
= XSTRING (filename
)->data
;
1772 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1773 CORRECT_DIR_SEPS (nm
);
1774 substituted
= (strcmp (nm
, XSTRING (filename
)->data
) != 0);
1776 endp
= nm
+ XSTRING (filename
)->size
;
1778 /* If /~ or // appears, discard everything through first slash. */
1780 for (p
= nm
; p
!= endp
; p
++)
1783 #if defined (APOLLO) || defined (WINDOWSNT)
1784 /* // at start of file name is meaningful in Apollo and
1785 WindowsNT systems */
1786 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1787 #else /* not (APOLLO || WINDOWSNT) */
1788 || IS_DIRECTORY_SEP (p
[0])
1789 #endif /* not (APOLLO || WINDOWSNT) */
1794 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1796 || IS_DIRECTORY_SEP (p
[-1])))
1802 /* see comment in expand-file-name about drive specifiers */
1803 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1804 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1813 return build_string (nm
);
1816 /* See if any variables are substituted into the string
1817 and find the total length of their values in `total' */
1819 for (p
= nm
; p
!= endp
;)
1829 /* "$$" means a single "$" */
1838 while (p
!= endp
&& *p
!= '}') p
++;
1839 if (*p
!= '}') goto missingclose
;
1845 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1849 /* Copy out the variable name */
1850 target
= (unsigned char *) alloca (s
- o
+ 1);
1851 strncpy (target
, o
, s
- o
);
1854 strupr (target
); /* $home == $HOME etc. */
1857 /* Get variable value */
1858 o
= (unsigned char *) egetenv (target
);
1859 if (!o
) goto badvar
;
1860 total
+= strlen (o
);
1867 /* If substitution required, recopy the string and do it */
1868 /* Make space in stack frame for the new copy */
1869 xnm
= (unsigned char *) alloca (XSTRING (filename
)->size
+ total
+ 1);
1872 /* Copy the rest of the name through, replacing $ constructs with values */
1889 while (p
!= endp
&& *p
!= '}') p
++;
1890 if (*p
!= '}') goto missingclose
;
1896 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1900 /* Copy out the variable name */
1901 target
= (unsigned char *) alloca (s
- o
+ 1);
1902 strncpy (target
, o
, s
- o
);
1905 strupr (target
); /* $home == $HOME etc. */
1908 /* Get variable value */
1909 o
= (unsigned char *) egetenv (target
);
1919 /* If /~ or // appears, discard everything through first slash. */
1921 for (p
= xnm
; p
!= x
; p
++)
1923 #if defined (APOLLO) || defined (WINDOWSNT)
1924 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
1925 #else /* not (APOLLO || WINDOWSNT) */
1926 || IS_DIRECTORY_SEP (p
[0])
1927 #endif /* not (APOLLO || WINDOWSNT) */
1929 && p
!= nm
&& IS_DIRECTORY_SEP (p
[-1]))
1932 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1933 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1937 return make_string (xnm
, x
- xnm
);
1940 error ("Bad format environment-variable substitution");
1942 error ("Missing \"}\" in environment-variable substitution");
1944 error ("Substituting nonexistent environment variable \"%s\"", target
);
1947 #endif /* not VMS */
1950 /* A slightly faster and more convenient way to get
1951 (directory-file-name (expand-file-name FOO)). */
1954 expand_and_dir_to_file (filename
, defdir
)
1955 Lisp_Object filename
, defdir
;
1957 register Lisp_Object absname
;
1959 absname
= Fexpand_file_name (filename
, defdir
);
1962 register int c
= XSTRING (absname
)->data
[XSTRING (absname
)->size
- 1];
1963 if (c
== ':' || c
== ']' || c
== '>')
1964 absname
= Fdirectory_file_name (absname
);
1967 /* Remove final slash, if any (unless this is the root dir).
1968 stat behaves differently depending! */
1969 if (XSTRING (absname
)->size
> 1
1970 && IS_DIRECTORY_SEP (XSTRING (absname
)->data
[XSTRING (absname
)->size
- 1])
1971 && !IS_DEVICE_SEP (XSTRING (absname
)->data
[XSTRING (absname
)->size
-2]))
1972 /* We cannot take shortcuts; they might be wrong for magic file names. */
1973 absname
= Fdirectory_file_name (absname
);
1978 /* Signal an error if the file ABSNAME already exists.
1979 If INTERACTIVE is nonzero, ask the user whether to proceed,
1980 and bypass the error if the user says to go ahead.
1981 QUERYSTRING is a name for the action that is being considered
1983 *STATPTR is used to store the stat information if the file exists.
1984 If the file does not exist, STATPTR->st_mode is set to 0. */
1987 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
)
1988 Lisp_Object absname
;
1989 unsigned char *querystring
;
1991 struct stat
*statptr
;
1993 register Lisp_Object tem
;
1994 struct stat statbuf
;
1995 struct gcpro gcpro1
;
1997 /* stat is a good way to tell whether the file exists,
1998 regardless of what access permissions it has. */
1999 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
2002 Fsignal (Qfile_already_exists
,
2003 Fcons (build_string ("File already exists"),
2004 Fcons (absname
, Qnil
)));
2006 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
2007 XSTRING (absname
)->data
, querystring
));
2010 Fsignal (Qfile_already_exists
,
2011 Fcons (build_string ("File already exists"),
2012 Fcons (absname
, Qnil
)));
2019 statptr
->st_mode
= 0;
2024 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2025 "fCopy file: \nFCopy %s to file: \np\nP",
2026 "Copy FILE to NEWNAME. Both args must be strings.\n\
2027 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
2028 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
2029 A number as third arg means request confirmation if NEWNAME already exists.\n\
2030 This is what happens in interactive use with M-x.\n\
2031 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
2032 last-modified time as the old one. (This works on only some systems.)\n\
2033 A prefix arg makes KEEP-TIME non-nil.")
2034 (file
, newname
, ok_if_already_exists
, keep_date
)
2035 Lisp_Object file
, newname
, ok_if_already_exists
, keep_date
;
2038 char buf
[16 * 1024];
2039 struct stat st
, out_st
;
2040 Lisp_Object handler
;
2041 struct gcpro gcpro1
, gcpro2
;
2042 int count
= specpdl_ptr
- specpdl
;
2043 int input_file_statable_p
;
2045 GCPRO2 (file
, newname
);
2046 CHECK_STRING (file
, 0);
2047 CHECK_STRING (newname
, 1);
2048 file
= Fexpand_file_name (file
, Qnil
);
2049 newname
= Fexpand_file_name (newname
, Qnil
);
2051 /* If the input file name has special constructs in it,
2052 call the corresponding file handler. */
2053 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2054 /* Likewise for output file name. */
2056 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2057 if (!NILP (handler
))
2058 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2059 ok_if_already_exists
, keep_date
));
2061 if (NILP (ok_if_already_exists
)
2062 || INTEGERP (ok_if_already_exists
))
2063 barf_or_query_if_file_exists (newname
, "copy to it",
2064 INTEGERP (ok_if_already_exists
), &out_st
);
2065 else if (stat (XSTRING (newname
)->data
, &out_st
) < 0)
2068 ifd
= open (XSTRING (file
)->data
, O_RDONLY
);
2070 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2072 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2074 /* We can only copy regular files and symbolic links. Other files are not
2076 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2079 if (out_st
.st_mode
!= 0
2080 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2083 report_file_error ("Input and output files are the same",
2084 Fcons (file
, Fcons (newname
, Qnil
)));
2088 #if defined (S_ISREG) && defined (S_ISLNK)
2089 if (input_file_statable_p
)
2091 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2093 #if defined (EISDIR)
2094 /* Get a better looking error message. */
2097 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2100 #endif /* S_ISREG && S_ISLNK */
2103 /* Create the copy file with the same record format as the input file */
2104 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
2107 /* System's default file type was set to binary by _fmode in emacs.c. */
2108 ofd
= creat (XSTRING (newname
)->data
, S_IREAD
| S_IWRITE
);
2109 #else /* not MSDOS */
2110 ofd
= creat (XSTRING (newname
)->data
, 0666);
2111 #endif /* not MSDOS */
2114 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2116 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2120 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
2121 if (write (ofd
, buf
, n
) != n
)
2122 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2125 /* Closing the output clobbers the file times on some systems. */
2126 if (close (ofd
) < 0)
2127 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2129 if (input_file_statable_p
)
2131 if (!NILP (keep_date
))
2133 EMACS_TIME atime
, mtime
;
2134 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2135 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2136 if (set_file_times (XSTRING (newname
)->data
, atime
, mtime
))
2137 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2140 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
2142 #if defined (__DJGPP__) && __DJGPP__ > 1
2143 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2144 and if it can't, it tells so. Otherwise, under MSDOS we usually
2145 get only the READ bit, which will make the copied file read-only,
2146 so it's better not to chmod at all. */
2147 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2148 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
2149 #endif /* DJGPP version 2 or newer */
2155 /* Discard the unwind protects. */
2156 specpdl_ptr
= specpdl
+ count
;
2162 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2163 Smake_directory_internal
, 1, 1, 0,
2164 "Create a new directory named DIRECTORY.")
2166 Lisp_Object directory
;
2169 Lisp_Object handler
;
2171 CHECK_STRING (directory
, 0);
2172 directory
= Fexpand_file_name (directory
, Qnil
);
2174 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2175 if (!NILP (handler
))
2176 return call2 (handler
, Qmake_directory_internal
, directory
);
2178 dir
= XSTRING (directory
)->data
;
2181 if (mkdir (dir
) != 0)
2183 if (mkdir (dir
, 0777) != 0)
2185 report_file_error ("Creating directory", Flist (1, &directory
));
2190 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2191 "Delete the directory named DIRECTORY.")
2193 Lisp_Object directory
;
2196 Lisp_Object handler
;
2198 CHECK_STRING (directory
, 0);
2199 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2200 dir
= XSTRING (directory
)->data
;
2202 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2203 if (!NILP (handler
))
2204 return call2 (handler
, Qdelete_directory
, directory
);
2206 if (rmdir (dir
) != 0)
2207 report_file_error ("Removing directory", Flist (1, &directory
));
2212 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2213 "Delete file named FILENAME.\n\
2214 If file has multiple names, it continues to exist with the other names.")
2216 Lisp_Object filename
;
2218 Lisp_Object handler
;
2219 CHECK_STRING (filename
, 0);
2220 filename
= Fexpand_file_name (filename
, Qnil
);
2222 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2223 if (!NILP (handler
))
2224 return call2 (handler
, Qdelete_file
, filename
);
2226 if (0 > unlink (XSTRING (filename
)->data
))
2227 report_file_error ("Removing old name", Flist (1, &filename
));
2232 internal_delete_file_1 (ignore
)
2238 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2241 internal_delete_file (filename
)
2242 Lisp_Object filename
;
2244 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2245 Qt
, internal_delete_file_1
));
2248 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2249 "fRename file: \nFRename %s to file: \np",
2250 "Rename FILE as NEWNAME. Both args strings.\n\
2251 If file has names other than FILE, it continues to have those names.\n\
2252 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2253 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2254 A number as third arg means request confirmation if NEWNAME already exists.\n\
2255 This is what happens in interactive use with M-x.")
2256 (file
, newname
, ok_if_already_exists
)
2257 Lisp_Object file
, newname
, ok_if_already_exists
;
2260 Lisp_Object args
[2];
2262 Lisp_Object handler
;
2263 struct gcpro gcpro1
, gcpro2
;
2265 GCPRO2 (file
, newname
);
2266 CHECK_STRING (file
, 0);
2267 CHECK_STRING (newname
, 1);
2268 file
= Fexpand_file_name (file
, Qnil
);
2269 newname
= Fexpand_file_name (newname
, Qnil
);
2271 /* If the file name has special constructs in it,
2272 call the corresponding file handler. */
2273 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2275 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2276 if (!NILP (handler
))
2277 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2278 file
, newname
, ok_if_already_exists
));
2280 if (NILP (ok_if_already_exists
)
2281 || INTEGERP (ok_if_already_exists
))
2282 barf_or_query_if_file_exists (newname
, "rename to it",
2283 INTEGERP (ok_if_already_exists
), 0);
2285 if (0 > rename (XSTRING (file
)->data
, XSTRING (newname
)->data
))
2287 if (0 > link (XSTRING (file
)->data
, XSTRING (newname
)->data
)
2288 || 0 > unlink (XSTRING (file
)->data
))
2293 Fcopy_file (file
, newname
,
2294 /* We have already prompted if it was an integer,
2295 so don't have copy-file prompt again. */
2296 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2297 Fdelete_file (file
);
2304 report_file_error ("Renaming", Flist (2, args
));
2307 report_file_error ("Renaming", Flist (2, &file
));
2314 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2315 "fAdd name to file: \nFName to add to %s: \np",
2316 "Give FILE additional name NEWNAME. Both args strings.\n\
2317 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2318 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2319 A number as third arg means request confirmation if NEWNAME already exists.\n\
2320 This is what happens in interactive use with M-x.")
2321 (file
, newname
, ok_if_already_exists
)
2322 Lisp_Object file
, newname
, ok_if_already_exists
;
2325 Lisp_Object args
[2];
2327 Lisp_Object handler
;
2328 struct gcpro gcpro1
, gcpro2
;
2330 GCPRO2 (file
, newname
);
2331 CHECK_STRING (file
, 0);
2332 CHECK_STRING (newname
, 1);
2333 file
= Fexpand_file_name (file
, Qnil
);
2334 newname
= Fexpand_file_name (newname
, Qnil
);
2336 /* If the file name has special constructs in it,
2337 call the corresponding file handler. */
2338 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2339 if (!NILP (handler
))
2340 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2341 newname
, ok_if_already_exists
));
2343 /* If the new name has special constructs in it,
2344 call the corresponding file handler. */
2345 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2346 if (!NILP (handler
))
2347 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2348 newname
, ok_if_already_exists
));
2350 if (NILP (ok_if_already_exists
)
2351 || INTEGERP (ok_if_already_exists
))
2352 barf_or_query_if_file_exists (newname
, "make it a new name",
2353 INTEGERP (ok_if_already_exists
), 0);
2355 /* Windows does not support this operation. */
2356 report_file_error ("Adding new name", Flist (2, &file
));
2357 #else /* not WINDOWSNT */
2359 unlink (XSTRING (newname
)->data
);
2360 if (0 > link (XSTRING (file
)->data
, XSTRING (newname
)->data
))
2365 report_file_error ("Adding new name", Flist (2, args
));
2367 report_file_error ("Adding new name", Flist (2, &file
));
2370 #endif /* not WINDOWSNT */
2377 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2378 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2379 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2380 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2381 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2382 A number as third arg means request confirmation if LINKNAME already exists.\n\
2383 This happens for interactive use with M-x.")
2384 (filename
, linkname
, ok_if_already_exists
)
2385 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2388 Lisp_Object args
[2];
2390 Lisp_Object handler
;
2391 struct gcpro gcpro1
, gcpro2
;
2393 GCPRO2 (filename
, linkname
);
2394 CHECK_STRING (filename
, 0);
2395 CHECK_STRING (linkname
, 1);
2396 /* If the link target has a ~, we must expand it to get
2397 a truly valid file name. Otherwise, do not expand;
2398 we want to permit links to relative file names. */
2399 if (XSTRING (filename
)->data
[0] == '~')
2400 filename
= Fexpand_file_name (filename
, Qnil
);
2401 linkname
= Fexpand_file_name (linkname
, Qnil
);
2403 /* If the file name has special constructs in it,
2404 call the corresponding file handler. */
2405 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2406 if (!NILP (handler
))
2407 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2408 linkname
, ok_if_already_exists
));
2410 /* If the new link name has special constructs in it,
2411 call the corresponding file handler. */
2412 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2413 if (!NILP (handler
))
2414 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2415 linkname
, ok_if_already_exists
));
2417 if (NILP (ok_if_already_exists
)
2418 || INTEGERP (ok_if_already_exists
))
2419 barf_or_query_if_file_exists (linkname
, "make it a link",
2420 INTEGERP (ok_if_already_exists
), 0);
2421 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2423 /* If we didn't complain already, silently delete existing file. */
2424 if (errno
== EEXIST
)
2426 unlink (XSTRING (linkname
)->data
);
2427 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2437 report_file_error ("Making symbolic link", Flist (2, args
));
2439 report_file_error ("Making symbolic link", Flist (2, &filename
));
2445 #endif /* S_IFLNK */
2449 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2450 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2451 "Define the job-wide logical name NAME to have the value STRING.\n\
2452 If STRING is nil or a null string, the logical name NAME is deleted.")
2457 CHECK_STRING (name
, 0);
2459 delete_logical_name (XSTRING (name
)->data
);
2462 CHECK_STRING (string
, 1);
2464 if (XSTRING (string
)->size
== 0)
2465 delete_logical_name (XSTRING (name
)->data
);
2467 define_logical_name (XSTRING (name
)->data
, XSTRING (string
)->data
);
2476 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2477 "Open a network connection to PATH using LOGIN as the login string.")
2479 Lisp_Object path
, login
;
2483 CHECK_STRING (path
, 0);
2484 CHECK_STRING (login
, 0);
2486 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2488 if (netresult
== -1)
2493 #endif /* HPUX_NET */
2495 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2497 "Return t if file FILENAME specifies an absolute file name.\n\
2498 On Unix, this is a name starting with a `/' or a `~'.")
2500 Lisp_Object filename
;
2504 CHECK_STRING (filename
, 0);
2505 ptr
= XSTRING (filename
)->data
;
2506 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2508 /* ??? This criterion is probably wrong for '<'. */
2509 || index (ptr
, ':') || index (ptr
, '<')
2510 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2514 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2522 /* Return nonzero if file FILENAME exists and can be executed. */
2525 check_executable (filename
)
2529 int len
= strlen (filename
);
2532 if (stat (filename
, &st
) < 0)
2535 return ((st
.st_mode
& S_IEXEC
) != 0);
2537 return (S_ISREG (st
.st_mode
)
2539 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2540 || stricmp (suffix
, ".exe") == 0
2541 || stricmp (suffix
, ".bat") == 0)
2542 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2543 #endif /* not WINDOWSNT */
2544 #else /* not DOS_NT */
2546 return (eaccess (filename
, 1) >= 0);
2548 /* Access isn't quite right because it uses the real uid
2549 and we really want to test with the effective uid.
2550 But Unix doesn't give us a right way to do it. */
2551 return (access (filename
, 1) >= 0);
2553 #endif /* not DOS_NT */
2556 /* Return nonzero if file FILENAME exists and can be written. */
2559 check_writable (filename
)
2564 if (stat (filename
, &st
) < 0)
2566 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2567 #else /* not MSDOS */
2569 return (eaccess (filename
, 2) >= 0);
2571 /* Access isn't quite right because it uses the real uid
2572 and we really want to test with the effective uid.
2573 But Unix doesn't give us a right way to do it.
2574 Opening with O_WRONLY could work for an ordinary file,
2575 but would lose for directories. */
2576 return (access (filename
, 2) >= 0);
2578 #endif /* not MSDOS */
2581 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2582 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2583 See also `file-readable-p' and `file-attributes'.")
2585 Lisp_Object filename
;
2587 Lisp_Object absname
;
2588 Lisp_Object handler
;
2589 struct stat statbuf
;
2591 CHECK_STRING (filename
, 0);
2592 absname
= Fexpand_file_name (filename
, Qnil
);
2594 /* If the file name has special constructs in it,
2595 call the corresponding file handler. */
2596 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2597 if (!NILP (handler
))
2598 return call2 (handler
, Qfile_exists_p
, absname
);
2600 return (stat (XSTRING (absname
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2603 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2604 "Return t if FILENAME can be executed by you.\n\
2605 For a directory, this means you can access files in that directory.")
2607 Lisp_Object filename
;
2610 Lisp_Object absname
;
2611 Lisp_Object handler
;
2613 CHECK_STRING (filename
, 0);
2614 absname
= Fexpand_file_name (filename
, Qnil
);
2616 /* If the file name has special constructs in it,
2617 call the corresponding file handler. */
2618 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2619 if (!NILP (handler
))
2620 return call2 (handler
, Qfile_executable_p
, absname
);
2622 return (check_executable (XSTRING (absname
)->data
) ? Qt
: Qnil
);
2625 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2626 "Return t if file FILENAME exists and you can read it.\n\
2627 See also `file-exists-p' and `file-attributes'.")
2629 Lisp_Object filename
;
2631 Lisp_Object absname
;
2632 Lisp_Object handler
;
2635 CHECK_STRING (filename
, 0);
2636 absname
= Fexpand_file_name (filename
, Qnil
);
2638 /* If the file name has special constructs in it,
2639 call the corresponding file handler. */
2640 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2641 if (!NILP (handler
))
2642 return call2 (handler
, Qfile_readable_p
, absname
);
2645 /* Under MS-DOS and Windows, open does not work for directories. */
2646 if (access (XSTRING (absname
)->data
, 0) == 0)
2649 #else /* not DOS_NT */
2650 desc
= open (XSTRING (absname
)->data
, O_RDONLY
);
2655 #endif /* not DOS_NT */
2658 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2660 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2661 "Return t if file FILENAME can be written or created by you.")
2663 Lisp_Object filename
;
2665 Lisp_Object absname
, dir
;
2666 Lisp_Object handler
;
2667 struct stat statbuf
;
2669 CHECK_STRING (filename
, 0);
2670 absname
= Fexpand_file_name (filename
, Qnil
);
2672 /* If the file name has special constructs in it,
2673 call the corresponding file handler. */
2674 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2675 if (!NILP (handler
))
2676 return call2 (handler
, Qfile_writable_p
, absname
);
2678 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
2679 return (check_writable (XSTRING (absname
)->data
)
2681 dir
= Ffile_name_directory (absname
);
2684 dir
= Fdirectory_file_name (dir
);
2688 dir
= Fdirectory_file_name (dir
);
2690 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2694 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2695 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2696 The value is the name of the file to which it is linked.\n\
2697 Otherwise returns nil.")
2699 Lisp_Object filename
;
2706 Lisp_Object handler
;
2708 CHECK_STRING (filename
, 0);
2709 filename
= Fexpand_file_name (filename
, Qnil
);
2711 /* If the file name has special constructs in it,
2712 call the corresponding file handler. */
2713 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2714 if (!NILP (handler
))
2715 return call2 (handler
, Qfile_symlink_p
, filename
);
2720 buf
= (char *) xmalloc (bufsize
);
2721 bzero (buf
, bufsize
);
2722 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2723 if (valsize
< bufsize
) break;
2724 /* Buffer was not long enough */
2733 val
= make_string (buf
, valsize
);
2736 #else /* not S_IFLNK */
2738 #endif /* not S_IFLNK */
2741 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2742 "Return t if file FILENAME is the name of a directory as a file.\n\
2743 A directory name spec may be given instead; then the value is t\n\
2744 if the directory so specified exists and really is a directory.")
2746 Lisp_Object filename
;
2748 register Lisp_Object absname
;
2750 Lisp_Object handler
;
2752 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2754 /* If the file name has special constructs in it,
2755 call the corresponding file handler. */
2756 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2757 if (!NILP (handler
))
2758 return call2 (handler
, Qfile_directory_p
, absname
);
2760 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2762 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2765 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2766 "Return t if file FILENAME is the name of a directory as a file,\n\
2767 and files in that directory can be opened by you. In order to use a\n\
2768 directory as a buffer's current directory, this predicate must return true.\n\
2769 A directory name spec may be given instead; then the value is t\n\
2770 if the directory so specified exists and really is a readable and\n\
2771 searchable directory.")
2773 Lisp_Object filename
;
2775 Lisp_Object handler
;
2777 struct gcpro gcpro1
;
2779 /* If the file name has special constructs in it,
2780 call the corresponding file handler. */
2781 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2782 if (!NILP (handler
))
2783 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2785 /* It's an unlikely combination, but yes we really do need to gcpro:
2786 Suppose that file-accessible-directory-p has no handler, but
2787 file-directory-p does have a handler; this handler causes a GC which
2788 relocates the string in `filename'; and finally file-directory-p
2789 returns non-nil. Then we would end up passing a garbaged string
2790 to file-executable-p. */
2792 tem
= (NILP (Ffile_directory_p (filename
))
2793 || NILP (Ffile_executable_p (filename
)));
2795 return tem
? Qnil
: Qt
;
2798 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2799 "Return t if file FILENAME is the name of a regular file.\n\
2800 This is the sort of file that holds an ordinary stream of data bytes.")
2802 Lisp_Object filename
;
2804 register Lisp_Object absname
;
2806 Lisp_Object handler
;
2808 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2810 /* If the file name has special constructs in it,
2811 call the corresponding file handler. */
2812 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
2813 if (!NILP (handler
))
2814 return call2 (handler
, Qfile_regular_p
, absname
);
2816 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2818 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2821 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2822 "Return mode bits of file named FILENAME, as an integer.")
2824 Lisp_Object filename
;
2826 Lisp_Object absname
;
2828 Lisp_Object handler
;
2830 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2832 /* If the file name has special constructs in it,
2833 call the corresponding file handler. */
2834 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
2835 if (!NILP (handler
))
2836 return call2 (handler
, Qfile_modes
, absname
);
2838 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2841 if (check_executable (XSTRING (absname
)->data
))
2842 st
.st_mode
|= S_IEXEC
;
2845 return make_number (st
.st_mode
& 07777);
2848 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2849 "Set mode bits of file named FILENAME to MODE (an integer).\n\
2850 Only the 12 low bits of MODE are used.")
2852 Lisp_Object filename
, mode
;
2854 Lisp_Object absname
;
2855 Lisp_Object handler
;
2857 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
2858 CHECK_NUMBER (mode
, 1);
2860 /* If the file name has special constructs in it,
2861 call the corresponding file handler. */
2862 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
2863 if (!NILP (handler
))
2864 return call3 (handler
, Qset_file_modes
, absname
, mode
);
2866 if (chmod (XSTRING (absname
)->data
, XINT (mode
)) < 0)
2867 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
2872 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2873 "Set the file permission bits for newly created files.\n\
2874 The argument MODE should be an integer; only the low 9 bits are used.\n\
2875 This setting is inherited by subprocesses.")
2879 CHECK_NUMBER (mode
, 0);
2881 umask ((~ XINT (mode
)) & 0777);
2886 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2887 "Return the default file protection for created files.\n\
2888 The value is an integer.")
2894 realmask
= umask (0);
2897 XSETINT (value
, (~ realmask
) & 0777);
2903 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2904 "Tell Unix to finish all pending disk updates.")
2913 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2914 "Return t if file FILE1 is newer than file FILE2.\n\
2915 If FILE1 does not exist, the answer is nil;\n\
2916 otherwise, if FILE2 does not exist, the answer is t.")
2918 Lisp_Object file1
, file2
;
2920 Lisp_Object absname1
, absname2
;
2923 Lisp_Object handler
;
2924 struct gcpro gcpro1
, gcpro2
;
2926 CHECK_STRING (file1
, 0);
2927 CHECK_STRING (file2
, 0);
2930 GCPRO2 (absname1
, file2
);
2931 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2932 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2935 /* If the file name has special constructs in it,
2936 call the corresponding file handler. */
2937 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
2939 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
2940 if (!NILP (handler
))
2941 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
2943 if (stat (XSTRING (absname1
)->data
, &st
) < 0)
2946 mtime1
= st
.st_mtime
;
2948 if (stat (XSTRING (absname2
)->data
, &st
) < 0)
2951 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
2955 Lisp_Object Qfind_buffer_file_type
;
2958 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
2960 "Insert contents of file FILENAME after point.\n\
2961 Returns list of absolute file name and length of data inserted.\n\
2962 If second argument VISIT is non-nil, the buffer's visited filename\n\
2963 and last save file modtime are set, and it is marked unmodified.\n\
2964 If visiting and the file does not exist, visiting is completed\n\
2965 before the error is signaled.\n\n\
2966 The optional third and fourth arguments BEG and END\n\
2967 specify what portion of the file to insert.\n\
2968 If VISIT is non-nil, BEG and END must be nil.\n\
2969 If optional fifth argument REPLACE is non-nil,\n\
2970 it means replace the current buffer contents (in the accessible portion)\n\
2971 with the file contents. This is better than simply deleting and inserting\n\
2972 the whole thing because (1) it preserves some marker positions\n\
2973 and (2) it puts less data in the undo list.")
2974 (filename
, visit
, beg
, end
, replace
)
2975 Lisp_Object filename
, visit
, beg
, end
, replace
;
2979 register int inserted
= 0;
2980 register int how_much
;
2981 int count
= specpdl_ptr
- specpdl
;
2982 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2983 Lisp_Object handler
, val
, insval
;
2986 int not_regular
= 0;
2988 if (current_buffer
->base_buffer
&& ! NILP (visit
))
2989 error ("Cannot do file visiting in an indirect buffer");
2991 if (!NILP (current_buffer
->read_only
))
2992 Fbarf_if_buffer_read_only ();
2997 GCPRO3 (filename
, val
, p
);
2999 CHECK_STRING (filename
, 0);
3000 filename
= Fexpand_file_name (filename
, Qnil
);
3002 /* If the file name has special constructs in it,
3003 call the corresponding file handler. */
3004 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3005 if (!NILP (handler
))
3007 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3008 visit
, beg
, end
, replace
);
3015 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3017 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
3018 || fstat (fd
, &st
) < 0)
3019 #endif /* not APOLLO */
3021 if (fd
>= 0) close (fd
);
3024 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3031 /* This code will need to be changed in order to work on named
3032 pipes, and it's probably just not worth it. So we should at
3033 least signal an error. */
3034 if (!S_ISREG (st
.st_mode
))
3037 Fsignal (Qfile_error
,
3038 Fcons (build_string ("not a regular file"),
3039 Fcons (filename
, Qnil
)));
3047 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
3050 /* Replacement should preserve point as it preserves markers. */
3051 if (!NILP (replace
))
3052 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3054 record_unwind_protect (close_file_unwind
, make_number (fd
));
3056 /* Supposedly happens on VMS. */
3058 error ("File size is negative");
3060 if (!NILP (beg
) || !NILP (end
))
3062 error ("Attempt to visit less than an entire file");
3065 CHECK_NUMBER (beg
, 0);
3067 XSETFASTINT (beg
, 0);
3070 CHECK_NUMBER (end
, 0);
3073 XSETINT (end
, st
.st_size
);
3074 if (XINT (end
) != st
.st_size
)
3075 error ("maximum buffer size exceeded");
3078 /* If requested, replace the accessible part of the buffer
3079 with the file contents. Avoid replacing text at the
3080 beginning or end of the buffer that matches the file contents;
3081 that preserves markers pointing to the unchanged parts. */
3083 /* On MSDOS, replace mode doesn't really work, except for binary files,
3084 and it's not worth supporting just for them. */
3085 if (!NILP (replace
))
3088 XSETFASTINT (beg
, 0);
3089 XSETFASTINT (end
, st
.st_size
);
3090 del_range_1 (BEGV
, ZV
, 0);
3092 #else /* not DOS_NT */
3093 if (!NILP (replace
))
3095 unsigned char buffer
[1 << 14];
3096 int same_at_start
= BEGV
;
3097 int same_at_end
= ZV
;
3102 /* Count how many chars at the start of the file
3103 match the text at the beginning of the buffer. */
3108 nread
= read (fd
, buffer
, sizeof buffer
);
3110 error ("IO error reading %s: %s",
3111 XSTRING (filename
)->data
, strerror (errno
));
3112 else if (nread
== 0)
3115 while (bufpos
< nread
&& same_at_start
< ZV
3116 && FETCH_CHAR (same_at_start
) == buffer
[bufpos
])
3117 same_at_start
++, bufpos
++;
3118 /* If we found a discrepancy, stop the scan.
3119 Otherwise loop around and scan the next bufferful. */
3120 if (bufpos
!= nread
)
3124 /* If the file matches the buffer completely,
3125 there's no need to replace anything. */
3126 if (same_at_start
- BEGV
== st
.st_size
)
3130 /* Truncate the buffer to the size of the file. */
3131 del_range_1 (same_at_start
, same_at_end
, 0);
3136 /* Count how many chars at the end of the file
3137 match the text at the end of the buffer. */
3140 int total_read
, nread
, bufpos
, curpos
, trial
;
3142 /* At what file position are we now scanning? */
3143 curpos
= st
.st_size
- (ZV
- same_at_end
);
3144 /* If the entire file matches the buffer tail, stop the scan. */
3147 /* How much can we scan in the next step? */
3148 trial
= min (curpos
, sizeof buffer
);
3149 if (lseek (fd
, curpos
- trial
, 0) < 0)
3150 report_file_error ("Setting file position",
3151 Fcons (filename
, Qnil
));
3154 while (total_read
< trial
)
3156 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
3158 error ("IO error reading %s: %s",
3159 XSTRING (filename
)->data
, strerror (errno
));
3160 total_read
+= nread
;
3162 /* Scan this bufferful from the end, comparing with
3163 the Emacs buffer. */
3164 bufpos
= total_read
;
3165 /* Compare with same_at_start to avoid counting some buffer text
3166 as matching both at the file's beginning and at the end. */
3167 while (bufpos
> 0 && same_at_end
> same_at_start
3168 && FETCH_CHAR (same_at_end
- 1) == buffer
[bufpos
- 1])
3169 same_at_end
--, bufpos
--;
3170 /* If we found a discrepancy, stop the scan.
3171 Otherwise loop around and scan the preceding bufferful. */
3174 /* If display current starts at beginning of line,
3175 keep it that way. */
3176 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3177 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3181 /* Don't try to reuse the same piece of text twice. */
3182 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
3184 same_at_end
+= overlap
;
3186 /* Arrange to read only the nonmatching middle part of the file. */
3187 XSETFASTINT (beg
, same_at_start
- BEGV
);
3188 XSETFASTINT (end
, st
.st_size
- (ZV
- same_at_end
));
3190 del_range_1 (same_at_start
, same_at_end
, 0);
3191 /* Insert from the file at the proper position. */
3192 SET_PT (same_at_start
);
3194 #endif /* not DOS_NT */
3196 total
= XINT (end
) - XINT (beg
);
3199 register Lisp_Object temp
;
3201 /* Make sure point-max won't overflow after this insertion. */
3202 XSETINT (temp
, total
);
3203 if (total
!= XINT (temp
))
3204 error ("maximum buffer size exceeded");
3207 if (NILP (visit
) && total
> 0)
3208 prepare_to_modify_buffer (point
, point
);
3211 if (GAP_SIZE
< total
)
3212 make_gap (total
- GAP_SIZE
);
3214 if (XINT (beg
) != 0 || !NILP (replace
))
3216 if (lseek (fd
, XINT (beg
), 0) < 0)
3217 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
3221 while (inserted
< total
)
3223 /* try is reserved in some compilers (Microsoft C) */
3224 int trytry
= min (total
- inserted
, 64 << 10);
3227 /* Allow quitting out of the actual I/O. */
3230 this = read (fd
, &FETCH_CHAR (point
+ inserted
- 1) + 1, trytry
);
3247 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
3248 /* Determine file type from name and remove LFs from CR-LFs if the file
3249 is deemed to be a text file. */
3251 current_buffer
->buffer_file_type
3252 = call1 (Qfind_buffer_file_type
, filename
);
3253 if (NILP (current_buffer
->buffer_file_type
))
3256 = inserted
- crlf_to_lf (inserted
, &FETCH_CHAR (point
- 1) + 1);
3259 GPT
-= reduced_size
;
3260 GAP_SIZE
+= reduced_size
;
3261 inserted
-= reduced_size
;
3268 record_insert (point
, inserted
);
3270 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
3271 offset_intervals (current_buffer
, point
, inserted
);
3277 /* Discard the unwind protect for closing the file. */
3281 error ("IO error reading %s: %s",
3282 XSTRING (filename
)->data
, strerror (errno
));
3289 if (!EQ (current_buffer
->undo_list
, Qt
))
3290 current_buffer
->undo_list
= Qnil
;
3292 stat (XSTRING (filename
)->data
, &st
);
3297 current_buffer
->modtime
= st
.st_mtime
;
3298 current_buffer
->filename
= filename
;
3301 SAVE_MODIFF
= MODIFF
;
3302 current_buffer
->auto_save_modified
= MODIFF
;
3303 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3304 #ifdef CLASH_DETECTION
3307 if (!NILP (current_buffer
->file_truename
))
3308 unlock_file (current_buffer
->file_truename
);
3309 unlock_file (filename
);
3311 #endif /* CLASH_DETECTION */
3313 Fsignal (Qfile_error
,
3314 Fcons (build_string ("not a regular file"),
3315 Fcons (filename
, Qnil
)));
3317 /* If visiting nonexistent file, return nil. */
3318 if (current_buffer
->modtime
== -1)
3319 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3322 /* Decode file format */
3325 insval
= call3 (Qformat_decode
,
3326 Qnil
, make_number (inserted
), visit
);
3327 CHECK_NUMBER (insval
, 0);
3328 inserted
= XFASTINT (insval
);
3331 if (inserted
> 0 && NILP (visit
) && total
> 0)
3332 signal_after_change (point
, 0, inserted
);
3336 p
= Vafter_insert_file_functions
;
3339 insval
= call1 (Fcar (p
), make_number (inserted
));
3342 CHECK_NUMBER (insval
, 0);
3343 inserted
= XFASTINT (insval
);
3351 val
= Fcons (filename
,
3352 Fcons (make_number (inserted
),
3355 RETURN_UNGCPRO (unbind_to (count
, val
));
3358 static Lisp_Object
build_annotations ();
3360 /* If build_annotations switched buffers, switch back to BUF.
3361 Kill the temporary buffer that was selected in the meantime. */
3364 build_annotations_unwind (buf
)
3369 if (XBUFFER (buf
) == current_buffer
)
3371 tembuf
= Fcurrent_buffer ();
3373 Fkill_buffer (tembuf
);
3377 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 6,
3378 "r\nFWrite region to file: ",
3379 "Write current region into specified file.\n\
3380 When called from a program, takes three arguments:\n\
3381 START, END and FILENAME. START and END are buffer positions.\n\
3382 Optional fourth argument APPEND if non-nil means\n\
3383 append to existing file contents (if any).\n\
3384 Optional fifth argument VISIT if t means\n\
3385 set the last-save-file-modtime of buffer to this file's modtime\n\
3386 and mark buffer not modified.\n\
3387 If VISIT is a string, it is a second file name;\n\
3388 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
3389 VISIT is also the file name to lock and unlock for clash detection.\n\
3390 If VISIT is neither t nor nil nor a string,\n\
3391 that means do not print the \"Wrote file\" message.\n\
3392 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
3393 use for locking and unlocking, overriding FILENAME and VISIT.\n\
3394 Kludgy feature: if START is a string, then that string is written\n\
3395 to the file, instead of any buffer contents, and END is ignored.")
3396 (start
, end
, filename
, append
, visit
, lockname
)
3397 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
3405 int count
= specpdl_ptr
- specpdl
;
3408 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3410 Lisp_Object handler
;
3411 Lisp_Object visit_file
;
3412 Lisp_Object annotations
;
3413 int visiting
, quietly
;
3414 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3415 struct buffer
*given_buffer
;
3417 int buffer_file_type
3418 = NILP (current_buffer
->buffer_file_type
) ? O_TEXT
: O_BINARY
;
3421 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3422 error ("Cannot do file visiting in an indirect buffer");
3424 if (!NILP (start
) && !STRINGP (start
))
3425 validate_region (&start
, &end
);
3427 GCPRO3 (filename
, visit
, lockname
);
3428 filename
= Fexpand_file_name (filename
, Qnil
);
3429 if (STRINGP (visit
))
3430 visit_file
= Fexpand_file_name (visit
, Qnil
);
3432 visit_file
= filename
;
3435 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
3436 quietly
= !NILP (visit
);
3440 if (NILP (lockname
))
3441 lockname
= visit_file
;
3443 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
3445 /* If the file name has special constructs in it,
3446 call the corresponding file handler. */
3447 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
3448 /* If FILENAME has no handler, see if VISIT has one. */
3449 if (NILP (handler
) && STRINGP (visit
))
3450 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
3452 if (!NILP (handler
))
3455 val
= call6 (handler
, Qwrite_region
, start
, end
,
3456 filename
, append
, visit
);
3460 SAVE_MODIFF
= MODIFF
;
3461 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3462 current_buffer
->filename
= visit_file
;
3468 /* Special kludge to simplify auto-saving. */
3471 XSETFASTINT (start
, BEG
);
3472 XSETFASTINT (end
, Z
);
3475 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
3476 count1
= specpdl_ptr
- specpdl
;
3478 given_buffer
= current_buffer
;
3479 annotations
= build_annotations (start
, end
);
3480 if (current_buffer
!= given_buffer
)
3486 #ifdef CLASH_DETECTION
3488 lock_file (lockname
);
3489 #endif /* CLASH_DETECTION */
3491 fn
= XSTRING (filename
)->data
;
3495 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
3496 #else /* not DOS_NT */
3497 desc
= open (fn
, O_WRONLY
);
3498 #endif /* not DOS_NT */
3502 if (auto_saving
) /* Overwrite any previous version of autosave file */
3504 vms_truncate (fn
); /* if fn exists, truncate to zero length */
3505 desc
= open (fn
, O_RDWR
);
3507 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
3508 ? XSTRING (current_buffer
->filename
)->data
: 0,
3511 else /* Write to temporary name and rename if no errors */
3513 Lisp_Object temp_name
;
3514 temp_name
= Ffile_name_directory (filename
);
3516 if (!NILP (temp_name
))
3518 temp_name
= Fmake_temp_name (concat2 (temp_name
,
3519 build_string ("$$SAVE$$")));
3520 fname
= XSTRING (filename
)->data
;
3521 fn
= XSTRING (temp_name
)->data
;
3522 desc
= creat_copy_attrs (fname
, fn
);
3525 /* If we can't open the temporary file, try creating a new
3526 version of the original file. VMS "creat" creates a
3527 new version rather than truncating an existing file. */
3530 desc
= creat (fn
, 0666);
3531 #if 0 /* This can clobber an existing file and fail to replace it,
3532 if the user runs out of space. */
3535 /* We can't make a new version;
3536 try to truncate and rewrite existing version if any. */
3538 desc
= open (fn
, O_RDWR
);
3544 desc
= creat (fn
, 0666);
3549 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
3550 S_IREAD
| S_IWRITE
);
3551 #else /* not DOS_NT */
3552 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
3553 #endif /* not DOS_NT */
3554 #endif /* not VMS */
3560 #ifdef CLASH_DETECTION
3562 if (!auto_saving
) unlock_file (lockname
);
3564 #endif /* CLASH_DETECTION */
3565 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
3568 record_unwind_protect (close_file_unwind
, make_number (desc
));
3571 if (lseek (desc
, 0, 2) < 0)
3573 #ifdef CLASH_DETECTION
3574 if (!auto_saving
) unlock_file (lockname
);
3575 #endif /* CLASH_DETECTION */
3576 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
3581 * Kludge Warning: The VMS C RTL likes to insert carriage returns
3582 * if we do writes that don't end with a carriage return. Furthermore
3583 * it cannot handle writes of more then 16K. The modified
3584 * version of "sys_write" in SYSDEP.C (see comment there) copes with
3585 * this EXCEPT for the last record (iff it doesn't end with a carriage
3586 * return). This implies that if your buffer doesn't end with a carriage
3587 * return, you get one free... tough. However it also means that if
3588 * we make two calls to sys_write (a la the following code) you can
3589 * get one at the gap as well. The easiest way to fix this (honest)
3590 * is to move the gap to the next newline (or the end of the buffer).
3595 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
3596 move_gap (find_next_newline (GPT
, 1));
3602 if (STRINGP (start
))
3604 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
3605 XSTRING (start
)->size
, 0, &annotations
);
3608 else if (XINT (start
) != XINT (end
))
3611 if (XINT (start
) < GPT
)
3613 register int end1
= XINT (end
);
3615 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
),
3616 min (GPT
, end1
) - tem
, tem
, &annotations
);
3617 nwritten
+= min (GPT
, end1
) - tem
;
3621 if (XINT (end
) > GPT
&& !failure
)
3624 tem
= max (tem
, GPT
);
3625 failure
= 0 > a_write (desc
, &FETCH_CHAR (tem
), XINT (end
) - tem
,
3627 nwritten
+= XINT (end
) - tem
;
3633 /* If file was empty, still need to write the annotations */
3634 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
);
3641 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3642 Disk full in NFS may be reported here. */
3643 /* mib says that closing the file will try to write as fast as NFS can do
3644 it, and that means the fsync here is not crucial for autosave files. */
3645 if (!auto_saving
&& fsync (desc
) < 0)
3647 /* If fsync fails with EINTR, don't treat that as serious. */
3649 failure
= 1, save_errno
= errno
;
3653 /* Spurious "file has changed on disk" warnings have been
3654 observed on Suns as well.
3655 It seems that `close' can change the modtime, under nfs.
3657 (This has supposedly been fixed in Sunos 4,
3658 but who knows about all the other machines with NFS?) */
3661 /* On VMS and APOLLO, must do the stat after the close
3662 since closing changes the modtime. */
3665 /* Recall that #if defined does not work on VMS. */
3672 /* NFS can report a write failure now. */
3673 if (close (desc
) < 0)
3674 failure
= 1, save_errno
= errno
;
3677 /* If we wrote to a temporary name and had no errors, rename to real name. */
3681 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
3689 /* Discard the unwind protect for close_file_unwind. */
3690 specpdl_ptr
= specpdl
+ count1
;
3691 /* Restore the original current buffer. */
3692 visit_file
= unbind_to (count
, visit_file
);
3694 #ifdef CLASH_DETECTION
3696 unlock_file (lockname
);
3697 #endif /* CLASH_DETECTION */
3699 /* Do this before reporting IO error
3700 to avoid a "file has changed on disk" warning on
3701 next attempt to save. */
3703 current_buffer
->modtime
= st
.st_mtime
;
3706 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
3710 SAVE_MODIFF
= MODIFF
;
3711 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3712 current_buffer
->filename
= visit_file
;
3713 update_mode_lines
++;
3719 message ("Wrote %s", XSTRING (visit_file
)->data
);
3724 Lisp_Object
merge ();
3726 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
3727 "Return t if (car A) is numerically less than (car B).")
3731 return Flss (Fcar (a
), Fcar (b
));
3734 /* Build the complete list of annotations appropriate for writing out
3735 the text between START and END, by calling all the functions in
3736 write-region-annotate-functions and merging the lists they return.
3737 If one of these functions switches to a different buffer, we assume
3738 that buffer contains altered text. Therefore, the caller must
3739 make sure to restore the current buffer in all cases,
3740 as save-excursion would do. */
3743 build_annotations (start
, end
)
3744 Lisp_Object start
, end
;
3746 Lisp_Object annotations
;
3748 struct gcpro gcpro1
, gcpro2
;
3751 p
= Vwrite_region_annotate_functions
;
3752 GCPRO2 (annotations
, p
);
3755 struct buffer
*given_buffer
= current_buffer
;
3756 Vwrite_region_annotations_so_far
= annotations
;
3757 res
= call2 (Fcar (p
), start
, end
);
3758 /* If the function makes a different buffer current,
3759 assume that means this buffer contains altered text to be output.
3760 Reset START and END from the buffer bounds
3761 and discard all previous annotations because they should have
3762 been dealt with by this function. */
3763 if (current_buffer
!= given_buffer
)
3769 Flength (res
); /* Check basic validity of return value */
3770 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3774 /* Now do the same for annotation functions implied by the file-format */
3775 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
3776 p
= Vauto_save_file_format
;
3778 p
= current_buffer
->file_format
;
3781 struct buffer
*given_buffer
= current_buffer
;
3782 Vwrite_region_annotations_so_far
= annotations
;
3783 res
= call3 (Qformat_annotate_function
, Fcar (p
), start
, end
);
3784 if (current_buffer
!= given_buffer
)
3791 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
3798 /* Write to descriptor DESC the LEN characters starting at ADDR,
3799 assuming they start at position POS in the buffer.
3800 Intersperse with them the annotations from *ANNOT
3801 (those which fall within the range of positions POS to POS + LEN),
3802 each at its appropriate position.
3804 Modify *ANNOT by discarding elements as we output them.
3805 The return value is negative in case of system call failure. */
3808 a_write (desc
, addr
, len
, pos
, annot
)
3810 register char *addr
;
3817 int lastpos
= pos
+ len
;
3819 while (NILP (*annot
) || CONSP (*annot
))
3821 tem
= Fcar_safe (Fcar (*annot
));
3822 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
3823 nextpos
= XFASTINT (tem
);
3825 return e_write (desc
, addr
, lastpos
- pos
);
3828 if (0 > e_write (desc
, addr
, nextpos
- pos
))
3830 addr
+= nextpos
- pos
;
3833 tem
= Fcdr (Fcar (*annot
));
3836 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
))
3839 *annot
= Fcdr (*annot
);
3844 e_write (desc
, addr
, len
)
3846 register char *addr
;
3849 char buf
[16 * 1024];
3850 register char *p
, *end
;
3852 if (!EQ (current_buffer
->selective_display
, Qt
))
3853 return write (desc
, addr
, len
) - len
;
3857 end
= p
+ sizeof buf
;
3862 if (write (desc
, buf
, sizeof buf
) != sizeof buf
)
3871 if (write (desc
, buf
, p
- buf
) != p
- buf
)
3877 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
3878 Sverify_visited_file_modtime
, 1, 1, 0,
3879 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
3880 This means that the file has not been changed since it was visited or saved.")
3886 Lisp_Object handler
;
3888 CHECK_BUFFER (buf
, 0);
3891 if (!STRINGP (b
->filename
)) return Qt
;
3892 if (b
->modtime
== 0) return Qt
;
3894 /* If the file name has special constructs in it,
3895 call the corresponding file handler. */
3896 handler
= Ffind_file_name_handler (b
->filename
,
3897 Qverify_visited_file_modtime
);
3898 if (!NILP (handler
))
3899 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
3901 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
3903 /* If the file doesn't exist now and didn't exist before,
3904 we say that it isn't modified, provided the error is a tame one. */
3905 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
3910 if (st
.st_mtime
== b
->modtime
3911 /* If both are positive, accept them if they are off by one second. */
3912 || (st
.st_mtime
> 0 && b
->modtime
> 0
3913 && (st
.st_mtime
== b
->modtime
+ 1
3914 || st
.st_mtime
== b
->modtime
- 1)))
3919 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
3920 Sclear_visited_file_modtime
, 0, 0, 0,
3921 "Clear out records of last mod time of visited file.\n\
3922 Next attempt to save will certainly not complain of a discrepancy.")
3925 current_buffer
->modtime
= 0;
3929 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
3930 Svisited_file_modtime
, 0, 0, 0,
3931 "Return the current buffer's recorded visited file modification time.\n\
3932 The value is a list of the form (HIGH . LOW), like the time values\n\
3933 that `file-attributes' returns.")
3936 return long_to_cons ((unsigned long) current_buffer
->modtime
);
3939 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
3940 Sset_visited_file_modtime
, 0, 1, 0,
3941 "Update buffer's recorded modification time from the visited file's time.\n\
3942 Useful if the buffer was not read from the file normally\n\
3943 or if the file itself has been changed for some known benign reason.\n\
3944 An argument specifies the modification time value to use\n\
3945 \(instead of that of the visited file), in the form of a list\n\
3946 \(HIGH . LOW) or (HIGH LOW).")
3948 Lisp_Object time_list
;
3950 if (!NILP (time_list
))
3951 current_buffer
->modtime
= cons_to_long (time_list
);
3954 register Lisp_Object filename
;
3956 Lisp_Object handler
;
3958 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
3960 /* If the file name has special constructs in it,
3961 call the corresponding file handler. */
3962 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
3963 if (!NILP (handler
))
3964 /* The handler can find the file name the same way we did. */
3965 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
3966 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
3967 current_buffer
->modtime
= st
.st_mtime
;
3977 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3978 Fsleep_for (make_number (1), Qnil
);
3979 message ("Autosaving...error!for %s", XSTRING (current_buffer
->name
)->data
);
3980 Fsleep_for (make_number (1), Qnil
);
3981 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
3982 Fsleep_for (make_number (1), Qnil
);
3992 /* Get visited file's mode to become the auto save file's mode. */
3993 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
3994 /* But make sure we can overwrite it later! */
3995 auto_save_mode_bits
= st
.st_mode
| 0600;
3997 auto_save_mode_bits
= 0666;
4000 Fwrite_region (Qnil
, Qnil
,
4001 current_buffer
->auto_save_file_name
,
4002 Qnil
, Qlambda
, Qnil
);
4006 do_auto_save_unwind (desc
) /* used as unwind-protect function */
4010 if (XINT (desc
) >= 0)
4011 close (XINT (desc
));
4015 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
4016 "Auto-save all buffers that need it.\n\
4017 This is all buffers that have auto-saving enabled\n\
4018 and are changed since last auto-saved.\n\
4019 Auto-saving writes the buffer into a file\n\
4020 so that your editing is not lost if the system crashes.\n\
4021 This file is not the file you visited; that changes only when you save.\n\
4022 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
4023 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
4024 A non-nil CURRENT-ONLY argument means save only current buffer.")
4025 (no_message
, current_only
)
4026 Lisp_Object no_message
, current_only
;
4028 struct buffer
*old
= current_buffer
, *b
;
4029 Lisp_Object tail
, buf
;
4031 char *omessage
= echo_area_glyphs
;
4032 int omessage_length
= echo_area_glyphs_length
;
4033 extern int minibuf_level
;
4034 int do_handled_files
;
4037 int count
= specpdl_ptr
- specpdl
;
4040 /* Ordinarily don't quit within this function,
4041 but don't make it impossible to quit (in case we get hung in I/O). */
4045 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
4046 point to non-strings reached from Vbuffer_alist. */
4051 if (!NILP (Vrun_hooks
))
4052 call1 (Vrun_hooks
, intern ("auto-save-hook"));
4054 if (STRINGP (Vauto_save_list_file_name
))
4056 Lisp_Object listfile
;
4057 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
4059 listdesc
= open (XSTRING (listfile
)->data
,
4060 O_WRONLY
| O_TRUNC
| O_CREAT
| O_TEXT
,
4061 S_IREAD
| S_IWRITE
);
4062 #else /* not DOS_NT */
4063 listdesc
= creat (XSTRING (listfile
)->data
, 0666);
4064 #endif /* not DOS_NT */
4069 /* Arrange to close that file whether or not we get an error.
4070 Also reset auto_saving to 0. */
4071 record_unwind_protect (do_auto_save_unwind
, make_number (listdesc
));
4075 /* First, save all files which don't have handlers. If Emacs is
4076 crashing, the handlers may tweak what is causing Emacs to crash
4077 in the first place, and it would be a shame if Emacs failed to
4078 autosave perfectly ordinary files because it couldn't handle some
4080 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
4081 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
4083 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
4086 /* Record all the buffers that have auto save mode
4087 in the special file that lists them. For each of these buffers,
4088 Record visited name (if any) and auto save name. */
4089 if (STRINGP (b
->auto_save_file_name
)
4090 && listdesc
>= 0 && do_handled_files
== 0)
4092 if (!NILP (b
->filename
))
4094 write (listdesc
, XSTRING (b
->filename
)->data
,
4095 XSTRING (b
->filename
)->size
);
4097 write (listdesc
, "\n", 1);
4098 write (listdesc
, XSTRING (b
->auto_save_file_name
)->data
,
4099 XSTRING (b
->auto_save_file_name
)->size
);
4100 write (listdesc
, "\n", 1);
4103 if (!NILP (current_only
)
4104 && b
!= current_buffer
)
4107 /* Don't auto-save indirect buffers.
4108 The base buffer takes care of it. */
4112 /* Check for auto save enabled
4113 and file changed since last auto save
4114 and file changed since last real save. */
4115 if (STRINGP (b
->auto_save_file_name
)
4116 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
4117 && b
->auto_save_modified
< BUF_MODIFF (b
)
4118 /* -1 means we've turned off autosaving for a while--see below. */
4119 && XINT (b
->save_length
) >= 0
4120 && (do_handled_files
4121 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
4124 EMACS_TIME before_time
, after_time
;
4126 EMACS_GET_TIME (before_time
);
4128 /* If we had a failure, don't try again for 20 minutes. */
4129 if (b
->auto_save_failure_time
>= 0
4130 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
4133 if ((XFASTINT (b
->save_length
) * 10
4134 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
4135 /* A short file is likely to change a large fraction;
4136 spare the user annoying messages. */
4137 && XFASTINT (b
->save_length
) > 5000
4138 /* These messages are frequent and annoying for `*mail*'. */
4139 && !EQ (b
->filename
, Qnil
)
4140 && NILP (no_message
))
4142 /* It has shrunk too much; turn off auto-saving here. */
4143 message ("Buffer %s has shrunk a lot; auto save turned off there",
4144 XSTRING (b
->name
)->data
);
4145 /* Turn off auto-saving until there's a real save,
4146 and prevent any more warnings. */
4147 XSETINT (b
->save_length
, -1);
4148 Fsleep_for (make_number (1), Qnil
);
4151 set_buffer_internal (b
);
4152 if (!auto_saved
&& NILP (no_message
))
4153 message1 ("Auto-saving...");
4154 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
4156 b
->auto_save_modified
= BUF_MODIFF (b
);
4157 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4158 set_buffer_internal (old
);
4160 EMACS_GET_TIME (after_time
);
4162 /* If auto-save took more than 60 seconds,
4163 assume it was an NFS failure that got a timeout. */
4164 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
4165 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
4169 /* Prevent another auto save till enough input events come in. */
4170 record_auto_save ();
4172 if (auto_saved
&& NILP (no_message
))
4176 sit_for (1, 0, 0, 0);
4177 message2 (omessage
, omessage_length
);
4180 message1 ("Auto-saving...done");
4185 unbind_to (count
, Qnil
);
4189 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
4190 Sset_buffer_auto_saved
, 0, 0, 0,
4191 "Mark current buffer as auto-saved with its current text.\n\
4192 No auto-save file will be written until the buffer changes again.")
4195 current_buffer
->auto_save_modified
= MODIFF
;
4196 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4197 current_buffer
->auto_save_failure_time
= -1;
4201 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
4202 Sclear_buffer_auto_save_failure
, 0, 0, 0,
4203 "Clear any record of a recent auto-save failure in the current buffer.")
4206 current_buffer
->auto_save_failure_time
= -1;
4210 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
4212 "Return t if buffer has been auto-saved since last read in or saved.")
4215 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
4218 /* Reading and completing file names */
4219 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
4221 /* In the string VAL, change each $ to $$ and return the result. */
4224 double_dollars (val
)
4227 register unsigned char *old
, *new;
4231 osize
= XSTRING (val
)->size
;
4232 /* Quote "$" as "$$" to get it past substitute-in-file-name */
4233 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
4234 if (*old
++ == '$') count
++;
4237 old
= XSTRING (val
)->data
;
4238 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
4239 new = XSTRING (val
)->data
;
4240 for (n
= osize
; n
> 0; n
--)
4253 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
4255 "Internal subroutine for read-file-name. Do not call this.")
4256 (string
, dir
, action
)
4257 Lisp_Object string
, dir
, action
;
4258 /* action is nil for complete, t for return list of completions,
4259 lambda for verify final value */
4261 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
4263 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4270 /* No need to protect ACTION--we only compare it with t and nil. */
4271 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
4273 if (XSTRING (string
)->size
== 0)
4275 if (EQ (action
, Qlambda
))
4283 orig_string
= string
;
4284 string
= Fsubstitute_in_file_name (string
);
4285 changed
= NILP (Fstring_equal (string
, orig_string
));
4286 name
= Ffile_name_nondirectory (string
);
4287 val
= Ffile_name_directory (string
);
4289 realdir
= Fexpand_file_name (val
, realdir
);
4294 specdir
= Ffile_name_directory (string
);
4295 val
= Ffile_name_completion (name
, realdir
);
4300 return double_dollars (string
);
4304 if (!NILP (specdir
))
4305 val
= concat2 (specdir
, val
);
4307 return double_dollars (val
);
4310 #endif /* not VMS */
4314 if (EQ (action
, Qt
))
4315 return Ffile_name_all_completions (name
, realdir
);
4316 /* Only other case actually used is ACTION = lambda */
4318 /* Supposedly this helps commands such as `cd' that read directory names,
4319 but can someone explain how it helps them? -- RMS */
4320 if (XSTRING (name
)->size
== 0)
4323 return Ffile_exists_p (string
);
4326 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4327 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
4328 Value is not expanded---you must call `expand-file-name' yourself.\n\
4329 Default name to DEFAULT-FILENAME if user enters a null string.\n\
4330 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
4331 except that if INITIAL is specified, that combined with DIR is used.)\n\
4332 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
4333 Non-nil and non-t means also require confirmation after completion.\n\
4334 Fifth arg INITIAL specifies text to start with.\n\
4335 DIR defaults to current buffer's directory default.")
4336 (prompt
, dir
, default_filename
, mustmatch
, initial
)
4337 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
4339 Lisp_Object val
, insdef
, insdef1
, tem
;
4340 struct gcpro gcpro1
, gcpro2
;
4341 register char *homedir
;
4345 dir
= current_buffer
->directory
;
4346 if (NILP (default_filename
))
4348 if (! NILP (initial
))
4349 default_filename
= Fexpand_file_name (initial
, dir
);
4351 default_filename
= current_buffer
->filename
;
4354 /* If dir starts with user's homedir, change that to ~. */
4355 homedir
= (char *) egetenv ("HOME");
4357 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
4358 CORRECT_DIR_SEPS (homedir
);
4362 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4363 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
4365 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4366 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4367 XSTRING (dir
)->data
[0] = '~';
4370 if (insert_default_directory
)
4373 if (!NILP (initial
))
4375 Lisp_Object args
[2], pos
;
4379 insdef
= Fconcat (2, args
);
4380 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
4381 insdef1
= Fcons (double_dollars (insdef
), pos
);
4384 insdef1
= double_dollars (insdef
);
4386 else if (!NILP (initial
))
4389 insdef1
= Fcons (double_dollars (insdef
), 0);
4392 insdef
= Qnil
, insdef1
= Qnil
;
4395 count
= specpdl_ptr
- specpdl
;
4396 specbind (intern ("completion-ignore-case"), Qt
);
4399 GCPRO2 (insdef
, default_filename
);
4400 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4401 dir
, mustmatch
, insdef1
,
4402 Qfile_name_history
);
4405 unbind_to (count
, Qnil
);
4410 error ("No file name specified");
4411 tem
= Fstring_equal (val
, insdef
);
4412 if (!NILP (tem
) && !NILP (default_filename
))
4413 return default_filename
;
4414 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
4416 if (!NILP (default_filename
))
4417 return default_filename
;
4419 error ("No default file name");
4421 return Fsubstitute_in_file_name (val
);
4424 #if 0 /* Old version */
4425 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4426 /* Don't confuse make-docfile by having two doc strings for this function.
4427 make-docfile does not pay attention to #if, for good reason! */
4429 (prompt
, dir
, defalt
, mustmatch
, initial
)
4430 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
4432 Lisp_Object val
, insdef
, tem
;
4433 struct gcpro gcpro1
, gcpro2
;
4434 register char *homedir
;
4438 dir
= current_buffer
->directory
;
4440 defalt
= current_buffer
->filename
;
4442 /* If dir starts with user's homedir, change that to ~. */
4443 homedir
= (char *) egetenv ("HOME");
4446 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4447 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
4449 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4450 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4451 XSTRING (dir
)->data
[0] = '~';
4454 if (!NILP (initial
))
4456 else if (insert_default_directory
)
4459 insdef
= build_string ("");
4462 count
= specpdl_ptr
- specpdl
;
4463 specbind (intern ("completion-ignore-case"), Qt
);
4466 GCPRO2 (insdef
, defalt
);
4467 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4469 insert_default_directory
? insdef
: Qnil
,
4470 Qfile_name_history
);
4473 unbind_to (count
, Qnil
);
4478 error ("No file name specified");
4479 tem
= Fstring_equal (val
, insdef
);
4480 if (!NILP (tem
) && !NILP (defalt
))
4482 return Fsubstitute_in_file_name (val
);
4484 #endif /* Old version */
4488 Qexpand_file_name
= intern ("expand-file-name");
4489 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
4490 Qdirectory_file_name
= intern ("directory-file-name");
4491 Qfile_name_directory
= intern ("file-name-directory");
4492 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
4493 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
4494 Qfile_name_as_directory
= intern ("file-name-as-directory");
4495 Qcopy_file
= intern ("copy-file");
4496 Qmake_directory_internal
= intern ("make-directory-internal");
4497 Qdelete_directory
= intern ("delete-directory");
4498 Qdelete_file
= intern ("delete-file");
4499 Qrename_file
= intern ("rename-file");
4500 Qadd_name_to_file
= intern ("add-name-to-file");
4501 Qmake_symbolic_link
= intern ("make-symbolic-link");
4502 Qfile_exists_p
= intern ("file-exists-p");
4503 Qfile_executable_p
= intern ("file-executable-p");
4504 Qfile_readable_p
= intern ("file-readable-p");
4505 Qfile_symlink_p
= intern ("file-symlink-p");
4506 Qfile_writable_p
= intern ("file-writable-p");
4507 Qfile_directory_p
= intern ("file-directory-p");
4508 Qfile_regular_p
= intern ("file-regular-p");
4509 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
4510 Qfile_modes
= intern ("file-modes");
4511 Qset_file_modes
= intern ("set-file-modes");
4512 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
4513 Qinsert_file_contents
= intern ("insert-file-contents");
4514 Qwrite_region
= intern ("write-region");
4515 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
4516 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
4518 staticpro (&Qexpand_file_name
);
4519 staticpro (&Qsubstitute_in_file_name
);
4520 staticpro (&Qdirectory_file_name
);
4521 staticpro (&Qfile_name_directory
);
4522 staticpro (&Qfile_name_nondirectory
);
4523 staticpro (&Qunhandled_file_name_directory
);
4524 staticpro (&Qfile_name_as_directory
);
4525 staticpro (&Qcopy_file
);
4526 staticpro (&Qmake_directory_internal
);
4527 staticpro (&Qdelete_directory
);
4528 staticpro (&Qdelete_file
);
4529 staticpro (&Qrename_file
);
4530 staticpro (&Qadd_name_to_file
);
4531 staticpro (&Qmake_symbolic_link
);
4532 staticpro (&Qfile_exists_p
);
4533 staticpro (&Qfile_executable_p
);
4534 staticpro (&Qfile_readable_p
);
4535 staticpro (&Qfile_symlink_p
);
4536 staticpro (&Qfile_writable_p
);
4537 staticpro (&Qfile_directory_p
);
4538 staticpro (&Qfile_regular_p
);
4539 staticpro (&Qfile_accessible_directory_p
);
4540 staticpro (&Qfile_modes
);
4541 staticpro (&Qset_file_modes
);
4542 staticpro (&Qfile_newer_than_file_p
);
4543 staticpro (&Qinsert_file_contents
);
4544 staticpro (&Qwrite_region
);
4545 staticpro (&Qverify_visited_file_modtime
);
4547 Qfile_name_history
= intern ("file-name-history");
4548 Fset (Qfile_name_history
, Qnil
);
4549 staticpro (&Qfile_name_history
);
4551 Qfile_error
= intern ("file-error");
4552 staticpro (&Qfile_error
);
4553 Qfile_already_exists
= intern ("file-already-exists");
4554 staticpro (&Qfile_already_exists
);
4557 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
4558 staticpro (&Qfind_buffer_file_type
);
4561 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
4562 "*Format in which to write auto-save files.\n\
4563 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
4564 If it is t, which is the default, auto-save files are written in the\n\
4565 same format as a regular save would use.");
4566 Vauto_save_file_format
= Qt
;
4568 Qformat_decode
= intern ("format-decode");
4569 staticpro (&Qformat_decode
);
4570 Qformat_annotate_function
= intern ("format-annotate-function");
4571 staticpro (&Qformat_annotate_function
);
4573 Qcar_less_than_car
= intern ("car-less-than-car");
4574 staticpro (&Qcar_less_than_car
);
4576 Fput (Qfile_error
, Qerror_conditions
,
4577 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
4578 Fput (Qfile_error
, Qerror_message
,
4579 build_string ("File error"));
4581 Fput (Qfile_already_exists
, Qerror_conditions
,
4582 Fcons (Qfile_already_exists
,
4583 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
4584 Fput (Qfile_already_exists
, Qerror_message
,
4585 build_string ("File already exists"));
4587 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
4588 "*Non-nil means when reading a filename start with default dir in minibuffer.");
4589 insert_default_directory
= 1;
4591 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
4592 "*Non-nil means write new files with record format `stmlf'.\n\
4593 nil means use format `var'. This variable is meaningful only on VMS.");
4594 vms_stmlf_recfm
= 0;
4596 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
4597 "Directory separator character for built-in functions that return file names.\n\
4598 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
4599 This variable affects the built-in functions only on Windows,\n\
4600 on other platforms, it is initialized so that Lisp code can find out\n\
4601 what the normal separator is.");
4602 Vdirectory_sep_char
= '/';
4604 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
4605 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
4606 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
4609 The first argument given to HANDLER is the name of the I/O primitive\n\
4610 to be handled; the remaining arguments are the arguments that were\n\
4611 passed to that primitive. For example, if you do\n\
4612 (file-exists-p FILENAME)\n\
4613 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
4614 (funcall HANDLER 'file-exists-p FILENAME)\n\
4615 The function `find-file-name-handler' checks this list for a handler\n\
4616 for its argument.");
4617 Vfile_name_handler_alist
= Qnil
;
4619 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
4620 "A list of functions to be called at the end of `insert-file-contents'.\n\
4621 Each is passed one argument, the number of bytes inserted. It should return\n\
4622 the new byte count, and leave point the same. If `insert-file-contents' is\n\
4623 intercepted by a handler from `file-name-handler-alist', that handler is\n\
4624 responsible for calling the after-insert-file-functions if appropriate.");
4625 Vafter_insert_file_functions
= Qnil
;
4627 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
4628 "A list of functions to be called at the start of `write-region'.\n\
4629 Each is passed two arguments, START and END as for `write-region'.\n\
4630 These are usually two numbers but not always; see the documentation\n\
4631 for `write-region'. The function should return a list of pairs\n\
4632 of the form (POSITION . STRING), consisting of strings to be effectively\n\
4633 inserted at the specified positions of the file being written (1 means to\n\
4634 insert before the first byte written). The POSITIONs must be sorted into\n\
4635 increasing order. If there are several functions in the list, the several\n\
4636 lists are merged destructively.");
4637 Vwrite_region_annotate_functions
= Qnil
;
4639 DEFVAR_LISP ("write-region-annotations-so-far",
4640 &Vwrite_region_annotations_so_far
,
4641 "When an annotation function is called, this holds the previous annotations.\n\
4642 These are the annotations made by other annotation functions\n\
4643 that were already called. See also `write-region-annotate-functions'.");
4644 Vwrite_region_annotations_so_far
= Qnil
;
4646 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
4647 "A list of file name handlers that temporarily should not be used.\n\
4648 This applies only to the operation `inhibit-file-name-operation'.");
4649 Vinhibit_file_name_handlers
= Qnil
;
4651 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
4652 "The operation for which `inhibit-file-name-handlers' is applicable.");
4653 Vinhibit_file_name_operation
= Qnil
;
4655 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
4656 "File name in which we write a list of all auto save file names.\n\
4657 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
4658 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
4660 Vauto_save_list_file_name
= Qnil
;
4662 defsubr (&Sfind_file_name_handler
);
4663 defsubr (&Sfile_name_directory
);
4664 defsubr (&Sfile_name_nondirectory
);
4665 defsubr (&Sunhandled_file_name_directory
);
4666 defsubr (&Sfile_name_as_directory
);
4667 defsubr (&Sdirectory_file_name
);
4668 defsubr (&Smake_temp_name
);
4669 defsubr (&Sexpand_file_name
);
4670 defsubr (&Ssubstitute_in_file_name
);
4671 defsubr (&Scopy_file
);
4672 defsubr (&Smake_directory_internal
);
4673 defsubr (&Sdelete_directory
);
4674 defsubr (&Sdelete_file
);
4675 defsubr (&Srename_file
);
4676 defsubr (&Sadd_name_to_file
);
4678 defsubr (&Smake_symbolic_link
);
4679 #endif /* S_IFLNK */
4681 defsubr (&Sdefine_logical_name
);
4684 defsubr (&Ssysnetunam
);
4685 #endif /* HPUX_NET */
4686 defsubr (&Sfile_name_absolute_p
);
4687 defsubr (&Sfile_exists_p
);
4688 defsubr (&Sfile_executable_p
);
4689 defsubr (&Sfile_readable_p
);
4690 defsubr (&Sfile_writable_p
);
4691 defsubr (&Sfile_symlink_p
);
4692 defsubr (&Sfile_directory_p
);
4693 defsubr (&Sfile_accessible_directory_p
);
4694 defsubr (&Sfile_regular_p
);
4695 defsubr (&Sfile_modes
);
4696 defsubr (&Sset_file_modes
);
4697 defsubr (&Sset_default_file_modes
);
4698 defsubr (&Sdefault_file_modes
);
4699 defsubr (&Sfile_newer_than_file_p
);
4700 defsubr (&Sinsert_file_contents
);
4701 defsubr (&Swrite_region
);
4702 defsubr (&Scar_less_than_car
);
4703 defsubr (&Sverify_visited_file_modtime
);
4704 defsubr (&Sclear_visited_file_modtime
);
4705 defsubr (&Svisited_file_modtime
);
4706 defsubr (&Sset_visited_file_modtime
);
4707 defsubr (&Sdo_auto_save
);
4708 defsubr (&Sset_buffer_auto_saved
);
4709 defsubr (&Sclear_buffer_auto_save_failure
);
4710 defsubr (&Srecent_auto_save_p
);
4712 defsubr (&Sread_file_name_internal
);
4713 defsubr (&Sread_file_name
);
4716 defsubr (&Sunix_sync
);