1 /* File IO for GNU Emacs.
2 Copyright (C) 1985,86,87,88,93,94,95,96,1997 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
23 #if defined (USG5) || defined (BSD_SYSTEM) || defined (LINUX)
28 #include <sys/types.h>
35 #if !defined (S_ISLNK) && defined (S_IFLNK)
36 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
39 #if !defined (S_ISFIFO) && defined (S_IFIFO)
40 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
43 #if !defined (S_ISREG) && defined (S_IFREG)
44 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
55 #include <sys/param.h>
77 extern char *strerror ();
94 #include "intervals.h"
105 #endif /* not WINDOWSNT */
108 #define CORRECT_DIR_SEPS(s) \
109 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
110 else unixtodos_filename (s); \
112 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
113 redirector allows the six letters between 'Z' and 'a' as well. */
115 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
118 #define IS_DRIVE(x) isalpha (x)
120 /* Need to lower-case the drive letter, or else expanded
121 filenames will sometimes compare inequal, because
122 `expand-file-name' doesn't always down-case the drive letter. */
123 #define DRIVE_LETTER(x) (tolower (x))
152 #define min(a, b) ((a) < (b) ? (a) : (b))
153 #define max(a, b) ((a) > (b) ? (a) : (b))
155 /* Encode the file name NAME using the specified coding system
156 for file names, if any. */
157 #define ENCODE_FILE(name) \
158 (! NILP (Vfile_name_coding_system) \
159 && XFASTINT (Vfile_name_coding_system) != 0 \
160 ? Fencode_coding_string (name, Vfile_name_coding_system, Qt) \
163 /* Nonzero during writing of auto-save files */
166 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
167 a new file with the same mode as the original */
168 int auto_save_mode_bits
;
170 /* Coding system for file names, or nil if none. */
171 Lisp_Object Vfile_name_coding_system
;
173 /* Alist of elements (REGEXP . HANDLER) for file names
174 whose I/O is done with a special handler. */
175 Lisp_Object Vfile_name_handler_alist
;
177 /* Format for auto-save files */
178 Lisp_Object Vauto_save_file_format
;
180 /* Lisp functions for translating file formats */
181 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
183 /* Function to be called to decide a coding system of a reading file. */
184 Lisp_Object Vset_auto_coding_function
;
186 /* Functions to be called to process text properties in inserted file. */
187 Lisp_Object Vafter_insert_file_functions
;
189 /* Functions to be called to create text property annotations for file. */
190 Lisp_Object Vwrite_region_annotate_functions
;
192 /* During build_annotations, each time an annotation function is called,
193 this holds the annotations made by the previous functions. */
194 Lisp_Object Vwrite_region_annotations_so_far
;
196 /* File name in which we write a list of all our auto save files. */
197 Lisp_Object Vauto_save_list_file_name
;
199 /* Nonzero means, when reading a filename in the minibuffer,
200 start out by inserting the default directory into the minibuffer. */
201 int insert_default_directory
;
203 /* On VMS, nonzero means write new files with record format stmlf.
204 Zero means use var format. */
207 /* On NT, specifies the directory separator character, used (eg.) when
208 expanding file names. This can be bound to / or \. */
209 Lisp_Object Vdirectory_sep_char
;
211 extern Lisp_Object Vuser_login_name
;
213 extern int minibuf_level
;
215 extern int minibuffer_auto_raise
;
217 /* These variables describe handlers that have "already" had a chance
218 to handle the current operation.
220 Vinhibit_file_name_handlers is a list of file name handlers.
221 Vinhibit_file_name_operation is the operation being handled.
222 If we try to handle that operation, we ignore those handlers. */
224 static Lisp_Object Vinhibit_file_name_handlers
;
225 static Lisp_Object Vinhibit_file_name_operation
;
227 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
229 Lisp_Object Qfile_name_history
;
231 Lisp_Object Qcar_less_than_car
;
233 report_file_error (string
, data
)
237 Lisp_Object errstring
;
239 errstring
= build_string (strerror (errno
));
241 /* System error messages are capitalized. Downcase the initial
242 unless it is followed by a slash. */
243 if (XSTRING (errstring
)->data
[1] != '/')
244 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
247 Fsignal (Qfile_error
,
248 Fcons (build_string (string
), Fcons (errstring
, data
)));
251 close_file_unwind (fd
)
254 close (XFASTINT (fd
));
257 /* Restore point, having saved it as a marker. */
259 restore_point_unwind (location
)
260 Lisp_Object location
;
262 SET_PT (marker_position (location
));
263 Fset_marker (location
, Qnil
, Qnil
);
266 Lisp_Object Qexpand_file_name
;
267 Lisp_Object Qsubstitute_in_file_name
;
268 Lisp_Object Qdirectory_file_name
;
269 Lisp_Object Qfile_name_directory
;
270 Lisp_Object Qfile_name_nondirectory
;
271 Lisp_Object Qunhandled_file_name_directory
;
272 Lisp_Object Qfile_name_as_directory
;
273 Lisp_Object Qcopy_file
;
274 Lisp_Object Qmake_directory_internal
;
275 Lisp_Object Qdelete_directory
;
276 Lisp_Object Qdelete_file
;
277 Lisp_Object Qrename_file
;
278 Lisp_Object Qadd_name_to_file
;
279 Lisp_Object Qmake_symbolic_link
;
280 Lisp_Object Qfile_exists_p
;
281 Lisp_Object Qfile_executable_p
;
282 Lisp_Object Qfile_readable_p
;
283 Lisp_Object Qfile_writable_p
;
284 Lisp_Object Qfile_symlink_p
;
285 Lisp_Object Qaccess_file
;
286 Lisp_Object Qfile_directory_p
;
287 Lisp_Object Qfile_regular_p
;
288 Lisp_Object Qfile_accessible_directory_p
;
289 Lisp_Object Qfile_modes
;
290 Lisp_Object Qset_file_modes
;
291 Lisp_Object Qfile_newer_than_file_p
;
292 Lisp_Object Qinsert_file_contents
;
293 Lisp_Object Qwrite_region
;
294 Lisp_Object Qverify_visited_file_modtime
;
295 Lisp_Object Qset_visited_file_modtime
;
297 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
298 "Return FILENAME's handler function for OPERATION, if it has one.\n\
299 Otherwise, return nil.\n\
300 A file name is handled if one of the regular expressions in\n\
301 `file-name-handler-alist' matches it.\n\n\
302 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
303 any handlers that are members of `inhibit-file-name-handlers',\n\
304 but we still do run any other handlers. This lets handlers\n\
305 use the standard functions without calling themselves recursively.")
306 (filename
, operation
)
307 Lisp_Object filename
, operation
;
309 /* This function must not munge the match data. */
310 Lisp_Object chain
, inhibited_handlers
;
312 CHECK_STRING (filename
, 0);
314 if (EQ (operation
, Vinhibit_file_name_operation
))
315 inhibited_handlers
= Vinhibit_file_name_handlers
;
317 inhibited_handlers
= Qnil
;
319 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
320 chain
= XCONS (chain
)->cdr
)
323 elt
= XCONS (chain
)->car
;
327 string
= XCONS (elt
)->car
;
328 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
330 Lisp_Object handler
, tem
;
332 handler
= XCONS (elt
)->cdr
;
333 tem
= Fmemq (handler
, inhibited_handlers
);
344 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
346 "Return the directory component in file name FILENAME.\n\
347 Return nil if FILENAME does not include a directory.\n\
348 Otherwise return a directory spec.\n\
349 Given a Unix syntax file name, returns a string ending in slash;\n\
350 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
352 Lisp_Object filename
;
354 register unsigned char *beg
;
355 register unsigned char *p
;
358 CHECK_STRING (filename
, 0);
360 /* If the file name has special constructs in it,
361 call the corresponding file handler. */
362 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
364 return call2 (handler
, Qfile_name_directory
, filename
);
366 #ifdef FILE_SYSTEM_CASE
367 filename
= FILE_SYSTEM_CASE (filename
);
369 beg
= XSTRING (filename
)->data
;
371 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
373 p
= beg
+ XSTRING (filename
)->size
;
375 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
377 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
380 /* only recognise drive specifier at beginning */
381 && !(p
[-1] == ':' && p
== beg
+ 2)
388 /* Expansion of "c:" to drive and default directory. */
389 if (p
== beg
+ 2 && beg
[1] == ':')
391 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
392 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
393 if (getdefdir (toupper (*beg
) - 'A' + 1, res
))
395 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
398 p
= beg
+ strlen (beg
);
401 CORRECT_DIR_SEPS (beg
);
403 return make_string (beg
, p
- beg
);
406 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
408 "Return file name FILENAME sans its directory.\n\
409 For example, in a Unix-syntax file name,\n\
410 this is everything after the last slash,\n\
411 or the entire name if it contains no slash.")
413 Lisp_Object filename
;
415 register unsigned char *beg
, *p
, *end
;
418 CHECK_STRING (filename
, 0);
420 /* If the file name has special constructs in it,
421 call the corresponding file handler. */
422 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
424 return call2 (handler
, Qfile_name_nondirectory
, filename
);
426 beg
= XSTRING (filename
)->data
;
427 end
= p
= beg
+ XSTRING (filename
)->size
;
429 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
431 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
434 /* only recognise drive specifier at beginning */
435 && !(p
[-1] == ':' && p
== beg
+ 2)
439 return make_string (p
, end
- p
);
442 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
, Sunhandled_file_name_directory
, 1, 1, 0,
443 "Return a directly usable directory name somehow associated with FILENAME.\n\
444 A `directly usable' directory name is one that may be used without the\n\
445 intervention of any file handler.\n\
446 If FILENAME is a directly usable file itself, return\n\
447 (file-name-directory FILENAME).\n\
448 The `call-process' and `start-process' functions use this function to\n\
449 get a current directory to run processes in.")
451 Lisp_Object filename
;
455 /* If the file name has special constructs in it,
456 call the corresponding file handler. */
457 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
459 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
461 return Ffile_name_directory (filename
);
466 file_name_as_directory (out
, in
)
469 int size
= strlen (in
) - 1;
474 /* Is it already a directory string? */
475 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
477 /* Is it a VMS directory file name? If so, hack VMS syntax. */
478 else if (! index (in
, '/')
479 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
480 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
481 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
482 || ! strncmp (&in
[size
- 5], ".dir", 4))
483 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
484 && in
[size
] == '1')))
486 register char *p
, *dot
;
490 dir:x.dir --> dir:[x]
491 dir:[x]y.dir --> dir:[x.y] */
493 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
496 strncpy (out
, in
, p
- in
);
515 dot
= index (p
, '.');
518 /* blindly remove any extension */
519 size
= strlen (out
) + (dot
- p
);
520 strncat (out
, p
, dot
- p
);
531 /* For Unix syntax, Append a slash if necessary */
532 if (!IS_DIRECTORY_SEP (out
[size
]))
534 out
[size
+ 1] = DIRECTORY_SEP
;
535 out
[size
+ 2] = '\0';
538 CORRECT_DIR_SEPS (out
);
544 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
545 Sfile_name_as_directory
, 1, 1, 0,
546 "Return a string representing file FILENAME interpreted as a directory.\n\
547 This operation exists because a directory is also a file, but its name as\n\
548 a directory is different from its name as a file.\n\
549 The result can be used as the value of `default-directory'\n\
550 or passed as second argument to `expand-file-name'.\n\
551 For a Unix-syntax file name, just appends a slash.\n\
552 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
559 CHECK_STRING (file
, 0);
563 /* If the file name has special constructs in it,
564 call the corresponding file handler. */
565 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
567 return call2 (handler
, Qfile_name_as_directory
, file
);
569 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
570 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
574 * Convert from directory name to filename.
576 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
577 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
578 * On UNIX, it's simple: just make sure there isn't a terminating /
580 * Value is nonzero if the string output is different from the input.
583 directory_file_name (src
, dst
)
591 struct FAB fab
= cc$rms_fab
;
592 struct NAM nam
= cc$rms_nam
;
593 char esa
[NAM$C_MAXRSS
];
598 if (! index (src
, '/')
599 && (src
[slen
- 1] == ']'
600 || src
[slen
- 1] == ':'
601 || src
[slen
- 1] == '>'))
603 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
605 fab
.fab$b_fns
= slen
;
606 fab
.fab$l_nam
= &nam
;
607 fab
.fab$l_fop
= FAB$M_NAM
;
610 nam
.nam$b_ess
= sizeof esa
;
611 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
613 /* We call SYS$PARSE to handle such things as [--] for us. */
614 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
616 slen
= nam
.nam$b_esl
;
617 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
622 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
624 /* what about when we have logical_name:???? */
625 if (src
[slen
- 1] == ':')
626 { /* Xlate logical name and see what we get */
627 ptr
= strcpy (dst
, src
); /* upper case for getenv */
630 if ('a' <= *ptr
&& *ptr
<= 'z')
634 dst
[slen
- 1] = 0; /* remove colon */
635 if (!(src
= egetenv (dst
)))
637 /* should we jump to the beginning of this procedure?
638 Good points: allows us to use logical names that xlate
640 Bad points: can be a problem if we just translated to a device
642 For now, I'll punt and always expect VMS names, and hope for
645 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
646 { /* no recursion here! */
652 { /* not a directory spec */
657 bracket
= src
[slen
- 1];
659 /* If bracket is ']' or '>', bracket - 2 is the corresponding
661 ptr
= index (src
, bracket
- 2);
663 { /* no opening bracket */
667 if (!(rptr
= rindex (src
, '.')))
670 strncpy (dst
, src
, slen
);
674 dst
[slen
++] = bracket
;
679 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
680 then translate the device and recurse. */
681 if (dst
[slen
- 1] == ':'
682 && dst
[slen
- 2] != ':' /* skip decnet nodes */
683 && strcmp (src
+ slen
, "[000000]") == 0)
685 dst
[slen
- 1] = '\0';
686 if ((ptr
= egetenv (dst
))
687 && (rlen
= strlen (ptr
) - 1) > 0
688 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
689 && ptr
[rlen
- 1] == '.')
691 char * buf
= (char *) alloca (strlen (ptr
) + 1);
695 return directory_file_name (buf
, dst
);
700 strcat (dst
, "[000000]");
704 rlen
= strlen (rptr
) - 1;
705 strncat (dst
, rptr
, rlen
);
706 dst
[slen
+ rlen
] = '\0';
707 strcat (dst
, ".DIR.1");
711 /* Process as Unix format: just remove any final slash.
712 But leave "/" unchanged; do not change it to "". */
715 /* Handle // as root for apollo's. */
716 if ((slen
> 2 && dst
[slen
- 1] == '/')
717 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
721 && IS_DIRECTORY_SEP (dst
[slen
- 1])
723 && !IS_ANY_SEP (dst
[slen
- 2])
729 CORRECT_DIR_SEPS (dst
);
734 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
736 "Returns the file name of the directory named DIRECTORY.\n\
737 This is the name of the file that holds the data for the directory DIRECTORY.\n\
738 This operation exists because a directory is also a file, but its name as\n\
739 a directory is different from its name as a file.\n\
740 In Unix-syntax, this function just removes the final slash.\n\
741 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
742 it returns a file name such as \"[X]Y.DIR.1\".")
744 Lisp_Object directory
;
749 CHECK_STRING (directory
, 0);
751 if (NILP (directory
))
754 /* If the file name has special constructs in it,
755 call the corresponding file handler. */
756 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
758 return call2 (handler
, Qdirectory_file_name
, directory
);
761 /* 20 extra chars is insufficient for VMS, since we might perform a
762 logical name translation. an equivalence string can be up to 255
763 chars long, so grab that much extra space... - sss */
764 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
766 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
768 directory_file_name (XSTRING (directory
)->data
, buf
);
769 return build_string (buf
);
772 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
773 "Generate temporary file name (string) starting with PREFIX (a string).\n\
774 The Emacs process number forms part of the result,\n\
775 so there is no danger of generating a name being used by another process.\n\
776 In addition, this function makes an attempt to choose a name\n\
777 which has no existing file.")
783 /* Don't use too many characters of the restricted 8+3 DOS
785 val
= concat2 (prefix
, build_string ("a.XXX"));
787 val
= concat2 (prefix
, build_string ("XXXXXX"));
789 mktemp (XSTRING (val
)->data
);
791 CORRECT_DIR_SEPS (XSTRING (val
)->data
);
796 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
797 "Convert filename NAME to absolute, and canonicalize it.\n\
798 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative\n\
799 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,\n\
800 the current buffer's value of default-directory is used.\n\
801 File name components that are `.' are removed, and \n\
802 so are file name components followed by `..', along with the `..' itself;\n\
803 note that these simplifications are done without checking the resulting\n\
804 file names in the file system.\n\
805 An initial `~/' expands to your home directory.\n\
806 An initial `~USER/' expands to USER's home directory.\n\
807 See also the function `substitute-in-file-name'.")
808 (name
, default_directory
)
809 Lisp_Object name
, default_directory
;
813 register unsigned char *newdir
, *p
, *o
;
815 unsigned char *target
;
818 unsigned char * colon
= 0;
819 unsigned char * close
= 0;
820 unsigned char * slash
= 0;
821 unsigned char * brack
= 0;
822 int lbrack
= 0, rbrack
= 0;
827 int collapse_newdir
= 1;
832 CHECK_STRING (name
, 0);
834 /* If the file name has special constructs in it,
835 call the corresponding file handler. */
836 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
838 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
840 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
841 if (NILP (default_directory
))
842 default_directory
= current_buffer
->directory
;
843 if (! STRINGP (default_directory
))
844 default_directory
= build_string ("/");
846 if (!NILP (default_directory
))
848 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
850 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
853 o
= XSTRING (default_directory
)->data
;
855 /* Make sure DEFAULT_DIRECTORY is properly expanded.
856 It would be better to do this down below where we actually use
857 default_directory. Unfortunately, calling Fexpand_file_name recursively
858 could invoke GC, and the strings might be relocated. This would
859 be annoying because we have pointers into strings lying around
860 that would need adjusting, and people would add new pointers to
861 the code and forget to adjust them, resulting in intermittent bugs.
862 Putting this call here avoids all that crud.
864 The EQ test avoids infinite recursion. */
865 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
866 /* Save time in some common cases - as long as default_directory
867 is not relative, it can be canonicalized with name below (if it
868 is needed at all) without requiring it to be expanded now. */
870 /* Detect MSDOS file names with drive specifiers. */
871 && ! (IS_DRIVE (o
[0]) && (IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2])))
873 /* Detect Windows file names in UNC format. */
874 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
876 #else /* not DOS_NT */
877 /* Detect Unix absolute file names (/... alone is not absolute on
879 && ! (IS_DIRECTORY_SEP (o
[0]))
880 #endif /* not DOS_NT */
886 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
891 /* Filenames on VMS are always upper case. */
892 name
= Fupcase (name
);
894 #ifdef FILE_SYSTEM_CASE
895 name
= FILE_SYSTEM_CASE (name
);
898 nm
= XSTRING (name
)->data
;
901 /* We will force directory separators to be either all \ or /, so make
902 a local copy to modify, even if there ends up being no change. */
903 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
905 /* Find and remove drive specifier if present; this makes nm absolute
906 even if the rest of the name appears to be relative. */
908 unsigned char *colon
= rindex (nm
, ':');
911 /* Only recognize colon as part of drive specifier if there is a
912 single alphabetic character preceeding the colon (and if the
913 character before the drive letter, if present, is a directory
914 separator); this is to support the remote system syntax used by
915 ange-ftp, and the "po:username" syntax for POP mailboxes. */
919 else if (IS_DRIVE (colon
[-1])
920 && (colon
== nm
+ 1 || IS_DIRECTORY_SEP (colon
[-2])))
927 while (--colon
>= nm
)
934 /* If we see "c://somedir", we want to strip the first slash after the
935 colon when stripping the drive letter. Otherwise, this expands to
937 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
939 #endif /* WINDOWSNT */
943 /* Discard any previous drive specifier if nm is now in UNC format. */
944 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
950 /* If nm is absolute, look for /./ or /../ sequences; if none are
951 found, we can probably return right away. We will avoid allocating
952 a new string if name is already fully expanded. */
954 IS_DIRECTORY_SEP (nm
[0])
959 && (drive
|| IS_DIRECTORY_SEP (nm
[1]))
966 /* If it turns out that the filename we want to return is just a
967 suffix of FILENAME, we don't need to go through and edit
968 things; we just need to construct a new string using data
969 starting at the middle of FILENAME. If we set lose to a
970 non-zero value, that means we've discovered that we can't do
977 /* Since we know the name is absolute, we can assume that each
978 element starts with a "/". */
980 /* "." and ".." are hairy. */
981 if (IS_DIRECTORY_SEP (p
[0])
983 && (IS_DIRECTORY_SEP (p
[2])
985 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
992 /* if dev:[dir]/, move nm to / */
993 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
994 nm
= (brack
? brack
+ 1 : colon
+ 1);
1003 /* VMS pre V4.4,convert '-'s in filenames. */
1004 if (lbrack
== rbrack
)
1006 if (dots
< 2) /* this is to allow negative version numbers */
1011 if (lbrack
> rbrack
&&
1012 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1013 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1019 /* count open brackets, reset close bracket pointer */
1020 if (p
[0] == '[' || p
[0] == '<')
1021 lbrack
++, brack
= 0;
1022 /* count close brackets, set close bracket pointer */
1023 if (p
[0] == ']' || p
[0] == '>')
1024 rbrack
++, brack
= p
;
1025 /* detect ][ or >< */
1026 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1028 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1029 nm
= p
+ 1, lose
= 1;
1030 if (p
[0] == ':' && (colon
|| slash
))
1031 /* if dev1:[dir]dev2:, move nm to dev2: */
1037 /* if /name/dev:, move nm to dev: */
1040 /* if node::dev:, move colon following dev */
1041 else if (colon
&& colon
[-1] == ':')
1043 /* if dev1:dev2:, move nm to dev2: */
1044 else if (colon
&& colon
[-1] != ':')
1049 if (p
[0] == ':' && !colon
)
1055 if (lbrack
== rbrack
)
1058 else if (p
[0] == '.')
1066 if (index (nm
, '/'))
1067 return build_string (sys_translate_unix (nm
));
1070 /* Make sure directories are all separated with / or \ as
1071 desired, but avoid allocation of a new string when not
1073 CORRECT_DIR_SEPS (nm
);
1075 if (IS_DIRECTORY_SEP (nm
[1]))
1077 if (strcmp (nm
, XSTRING (name
)->data
) != 0)
1078 name
= build_string (nm
);
1082 /* drive must be set, so this is okay */
1083 if (strcmp (nm
- 2, XSTRING (name
)->data
) != 0)
1085 name
= make_string (nm
- 2, p
- nm
+ 2);
1086 XSTRING (name
)->data
[0] = DRIVE_LETTER (drive
);
1087 XSTRING (name
)->data
[1] = ':';
1090 #else /* not DOS_NT */
1091 if (nm
== XSTRING (name
)->data
)
1093 return build_string (nm
);
1094 #endif /* not DOS_NT */
1098 /* At this point, nm might or might not be an absolute file name. We
1099 need to expand ~ or ~user if present, otherwise prefix nm with
1100 default_directory if nm is not absolute, and finally collapse /./
1101 and /foo/../ sequences.
1103 We set newdir to be the appropriate prefix if one is needed:
1104 - the relevant user directory if nm starts with ~ or ~user
1105 - the specified drive's working dir (DOS/NT only) if nm does not
1107 - the value of default_directory.
1109 Note that these prefixes are not guaranteed to be absolute (except
1110 for the working dir of a drive). Therefore, to ensure we always
1111 return an absolute name, if the final prefix is not absolute we
1112 append it to the current working directory. */
1116 if (nm
[0] == '~') /* prefix ~ */
1118 if (IS_DIRECTORY_SEP (nm
[1])
1122 || nm
[1] == 0) /* ~ by itself */
1124 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1125 newdir
= (unsigned char *) "";
1128 collapse_newdir
= 0;
1131 nm
++; /* Don't leave the slash in nm. */
1134 else /* ~user/filename */
1136 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1141 o
= (unsigned char *) alloca (p
- nm
+ 1);
1142 bcopy ((char *) nm
, o
, p
- nm
);
1145 pw
= (struct passwd
*) getpwnam (o
+ 1);
1148 newdir
= (unsigned char *) pw
-> pw_dir
;
1150 nm
= p
+ 1; /* skip the terminator */
1154 collapse_newdir
= 0;
1159 /* If we don't find a user of that name, leave the name
1160 unchanged; don't move nm forward to p. */
1165 /* On DOS and Windows, nm is absolute if a drive name was specified;
1166 use the drive's current directory as the prefix if needed. */
1167 if (!newdir
&& drive
)
1169 /* Get default directory if needed to make nm absolute. */
1170 if (!IS_DIRECTORY_SEP (nm
[0]))
1172 newdir
= alloca (MAXPATHLEN
+ 1);
1173 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1178 /* Either nm starts with /, or drive isn't mounted. */
1179 newdir
= alloca (4);
1180 newdir
[0] = DRIVE_LETTER (drive
);
1188 /* Finally, if no prefix has been specified and nm is not absolute,
1189 then it must be expanded relative to default_directory. */
1193 /* /... alone is not absolute on DOS and Windows. */
1194 && !IS_DIRECTORY_SEP (nm
[0])
1197 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1204 newdir
= XSTRING (default_directory
)->data
;
1210 /* First ensure newdir is an absolute name. */
1212 /* Detect MSDOS file names with drive specifiers. */
1213 ! (IS_DRIVE (newdir
[0])
1214 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1216 /* Detect Windows file names in UNC format. */
1217 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1221 /* Effectively, let newdir be (expand-file-name newdir cwd).
1222 Because of the admonition against calling expand-file-name
1223 when we have pointers into lisp strings, we accomplish this
1224 indirectly by prepending newdir to nm if necessary, and using
1225 cwd (or the wd of newdir's drive) as the new newdir. */
1227 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1232 if (!IS_DIRECTORY_SEP (nm
[0]))
1234 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1235 file_name_as_directory (tmp
, newdir
);
1239 newdir
= alloca (MAXPATHLEN
+ 1);
1242 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1249 /* Strip off drive name from prefix, if present. */
1250 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1256 /* Keep only a prefix from newdir if nm starts with slash
1257 (//server/share for UNC, nothing otherwise). */
1258 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1261 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1263 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1265 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1267 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1279 /* Get rid of any slash at the end of newdir, unless newdir is
1280 just // (an incomplete UNC name). */
1281 length
= strlen (newdir
);
1282 if (length
> 0 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1284 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1288 unsigned char *temp
= (unsigned char *) alloca (length
);
1289 bcopy (newdir
, temp
, length
- 1);
1290 temp
[length
- 1] = 0;
1298 /* Now concatenate the directory and name to new space in the stack frame */
1299 tlen
+= strlen (nm
) + 1;
1301 /* Add reserved space for drive name. (The Microsoft x86 compiler
1302 produces incorrect code if the following two lines are combined.) */
1303 target
= (unsigned char *) alloca (tlen
+ 2);
1305 #else /* not DOS_NT */
1306 target
= (unsigned char *) alloca (tlen
);
1307 #endif /* not DOS_NT */
1313 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1314 strcpy (target
, newdir
);
1317 file_name_as_directory (target
, newdir
);
1320 strcat (target
, nm
);
1322 if (index (target
, '/'))
1323 strcpy (target
, sys_translate_unix (target
));
1326 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1328 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1336 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1342 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1343 /* brackets are offset from each other by 2 */
1346 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1347 /* convert [foo][bar] to [bar] */
1348 while (o
[-1] != '[' && o
[-1] != '<')
1350 else if (*p
== '-' && *o
!= '.')
1353 else if (p
[0] == '-' && o
[-1] == '.' &&
1354 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1355 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1359 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1360 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1362 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1364 /* else [foo.-] ==> [-] */
1370 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1371 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1377 if (!IS_DIRECTORY_SEP (*p
))
1381 else if (IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1])
1382 #if defined (APOLLO) || defined (WINDOWSNT)
1383 /* // at start of filename is meaningful in Apollo
1384 and WindowsNT systems. */
1386 #endif /* APOLLO || WINDOWSNT */
1392 else if (IS_DIRECTORY_SEP (p
[0])
1394 && (IS_DIRECTORY_SEP (p
[2])
1397 /* If "/." is the entire filename, keep the "/". Otherwise,
1398 just delete the whole "/.". */
1399 if (o
== target
&& p
[2] == '\0')
1403 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1404 /* `/../' is the "superroot" on certain file systems. */
1406 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1408 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1410 /* Keep initial / only if this is the whole name. */
1411 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1419 #endif /* not VMS */
1423 /* At last, set drive name. */
1425 /* Except for network file name. */
1426 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1427 #endif /* WINDOWSNT */
1429 if (!drive
) abort ();
1431 target
[0] = DRIVE_LETTER (drive
);
1434 CORRECT_DIR_SEPS (target
);
1437 return make_string (target
, o
- target
);
1441 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1442 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1443 "Convert FILENAME to absolute, and canonicalize it.\n\
1444 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1445 (does not start with slash); if DEFAULT is nil or missing,\n\
1446 the current buffer's value of default-directory is used.\n\
1447 Filenames containing `.' or `..' as components are simplified;\n\
1448 initial `~/' expands to your home directory.\n\
1449 See also the function `substitute-in-file-name'.")
1451 Lisp_Object name
, defalt
;
1455 register unsigned char *newdir
, *p
, *o
;
1457 unsigned char *target
;
1461 unsigned char * colon
= 0;
1462 unsigned char * close
= 0;
1463 unsigned char * slash
= 0;
1464 unsigned char * brack
= 0;
1465 int lbrack
= 0, rbrack
= 0;
1469 CHECK_STRING (name
, 0);
1472 /* Filenames on VMS are always upper case. */
1473 name
= Fupcase (name
);
1476 nm
= XSTRING (name
)->data
;
1478 /* If nm is absolute, flush ...// and detect /./ and /../.
1479 If no /./ or /../ we can return right away. */
1491 if (p
[0] == '/' && p
[1] == '/'
1493 /* // at start of filename is meaningful on Apollo system. */
1498 if (p
[0] == '/' && p
[1] == '~')
1499 nm
= p
+ 1, lose
= 1;
1500 if (p
[0] == '/' && p
[1] == '.'
1501 && (p
[2] == '/' || p
[2] == 0
1502 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1508 /* if dev:[dir]/, move nm to / */
1509 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1510 nm
= (brack
? brack
+ 1 : colon
+ 1);
1511 lbrack
= rbrack
= 0;
1519 /* VMS pre V4.4,convert '-'s in filenames. */
1520 if (lbrack
== rbrack
)
1522 if (dots
< 2) /* this is to allow negative version numbers */
1527 if (lbrack
> rbrack
&&
1528 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1529 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1535 /* count open brackets, reset close bracket pointer */
1536 if (p
[0] == '[' || p
[0] == '<')
1537 lbrack
++, brack
= 0;
1538 /* count close brackets, set close bracket pointer */
1539 if (p
[0] == ']' || p
[0] == '>')
1540 rbrack
++, brack
= p
;
1541 /* detect ][ or >< */
1542 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1544 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1545 nm
= p
+ 1, lose
= 1;
1546 if (p
[0] == ':' && (colon
|| slash
))
1547 /* if dev1:[dir]dev2:, move nm to dev2: */
1553 /* If /name/dev:, move nm to dev: */
1556 /* If node::dev:, move colon following dev */
1557 else if (colon
&& colon
[-1] == ':')
1559 /* If dev1:dev2:, move nm to dev2: */
1560 else if (colon
&& colon
[-1] != ':')
1565 if (p
[0] == ':' && !colon
)
1571 if (lbrack
== rbrack
)
1574 else if (p
[0] == '.')
1582 if (index (nm
, '/'))
1583 return build_string (sys_translate_unix (nm
));
1585 if (nm
== XSTRING (name
)->data
)
1587 return build_string (nm
);
1591 /* Now determine directory to start with and put it in NEWDIR */
1595 if (nm
[0] == '~') /* prefix ~ */
1600 || nm
[1] == 0)/* ~/filename */
1602 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1603 newdir
= (unsigned char *) "";
1606 nm
++; /* Don't leave the slash in nm. */
1609 else /* ~user/filename */
1611 /* Get past ~ to user */
1612 unsigned char *user
= nm
+ 1;
1613 /* Find end of name. */
1614 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1615 int len
= ptr
? ptr
- user
: strlen (user
);
1617 unsigned char *ptr1
= index (user
, ':');
1618 if (ptr1
!= 0 && ptr1
- user
< len
)
1621 /* Copy the user name into temp storage. */
1622 o
= (unsigned char *) alloca (len
+ 1);
1623 bcopy ((char *) user
, o
, len
);
1626 /* Look up the user name. */
1627 pw
= (struct passwd
*) getpwnam (o
+ 1);
1629 error ("\"%s\" isn't a registered user", o
+ 1);
1631 newdir
= (unsigned char *) pw
->pw_dir
;
1633 /* Discard the user name from NM. */
1640 #endif /* not VMS */
1644 defalt
= current_buffer
->directory
;
1645 CHECK_STRING (defalt
, 1);
1646 newdir
= XSTRING (defalt
)->data
;
1649 /* Now concatenate the directory and name to new space in the stack frame */
1651 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1652 target
= (unsigned char *) alloca (tlen
);
1658 if (nm
[0] == 0 || nm
[0] == '/')
1659 strcpy (target
, newdir
);
1662 file_name_as_directory (target
, newdir
);
1665 strcat (target
, nm
);
1667 if (index (target
, '/'))
1668 strcpy (target
, sys_translate_unix (target
));
1671 /* Now canonicalize by removing /. and /foo/.. if they appear */
1679 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1685 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1686 /* brackets are offset from each other by 2 */
1689 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1690 /* convert [foo][bar] to [bar] */
1691 while (o
[-1] != '[' && o
[-1] != '<')
1693 else if (*p
== '-' && *o
!= '.')
1696 else if (p
[0] == '-' && o
[-1] == '.' &&
1697 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1698 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1702 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1703 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1705 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1707 /* else [foo.-] ==> [-] */
1713 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1714 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1724 else if (!strncmp (p
, "//", 2)
1726 /* // at start of filename is meaningful in Apollo system. */
1734 else if (p
[0] == '/' && p
[1] == '.' &&
1735 (p
[2] == '/' || p
[2] == 0))
1737 else if (!strncmp (p
, "/..", 3)
1738 /* `/../' is the "superroot" on certain file systems. */
1740 && (p
[3] == '/' || p
[3] == 0))
1742 while (o
!= target
&& *--o
!= '/')
1745 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1749 if (o
== target
&& *o
== '/')
1757 #endif /* not VMS */
1760 return make_string (target
, o
- target
);
1764 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1765 Ssubstitute_in_file_name
, 1, 1, 0,
1766 "Substitute environment variables referred to in FILENAME.\n\
1767 `$FOO' where FOO is an environment variable name means to substitute\n\
1768 the value of that variable. The variable name should be terminated\n\
1769 with a character not a letter, digit or underscore; otherwise, enclose\n\
1770 the entire variable name in braces.\n\
1771 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1772 On VMS, `$' substitution is not done; this function does little and only\n\
1773 duplicates what `expand-file-name' does.")
1775 Lisp_Object filename
;
1779 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1780 unsigned char *target
;
1782 int substituted
= 0;
1784 Lisp_Object handler
;
1786 CHECK_STRING (filename
, 0);
1788 /* If the file name has special constructs in it,
1789 call the corresponding file handler. */
1790 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1791 if (!NILP (handler
))
1792 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1794 nm
= XSTRING (filename
)->data
;
1796 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1797 CORRECT_DIR_SEPS (nm
);
1798 substituted
= (strcmp (nm
, XSTRING (filename
)->data
) != 0);
1800 endp
= nm
+ XSTRING (filename
)->size
;
1802 /* If /~ or // appears, discard everything through first slash. */
1804 for (p
= nm
; p
!= endp
; p
++)
1807 #if defined (APOLLO) || defined (WINDOWSNT)
1808 /* // at start of file name is meaningful in Apollo and
1809 WindowsNT systems. */
1810 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1811 #else /* not (APOLLO || WINDOWSNT) */
1812 || IS_DIRECTORY_SEP (p
[0])
1813 #endif /* not (APOLLO || WINDOWSNT) */
1818 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1820 || IS_DIRECTORY_SEP (p
[-1])))
1826 /* see comment in expand-file-name about drive specifiers */
1827 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1828 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1837 return build_string (nm
);
1840 /* See if any variables are substituted into the string
1841 and find the total length of their values in `total' */
1843 for (p
= nm
; p
!= endp
;)
1853 /* "$$" means a single "$" */
1862 while (p
!= endp
&& *p
!= '}') p
++;
1863 if (*p
!= '}') goto missingclose
;
1869 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1873 /* Copy out the variable name */
1874 target
= (unsigned char *) alloca (s
- o
+ 1);
1875 strncpy (target
, o
, s
- o
);
1878 strupr (target
); /* $home == $HOME etc. */
1881 /* Get variable value */
1882 o
= (unsigned char *) egetenv (target
);
1883 if (!o
) goto badvar
;
1884 total
+= strlen (o
);
1891 /* If substitution required, recopy the string and do it */
1892 /* Make space in stack frame for the new copy */
1893 xnm
= (unsigned char *) alloca (XSTRING (filename
)->size
+ total
+ 1);
1896 /* Copy the rest of the name through, replacing $ constructs with values */
1913 while (p
!= endp
&& *p
!= '}') p
++;
1914 if (*p
!= '}') goto missingclose
;
1920 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1924 /* Copy out the variable name */
1925 target
= (unsigned char *) alloca (s
- o
+ 1);
1926 strncpy (target
, o
, s
- o
);
1929 strupr (target
); /* $home == $HOME etc. */
1932 /* Get variable value */
1933 o
= (unsigned char *) egetenv (target
);
1943 /* If /~ or // appears, discard everything through first slash. */
1945 for (p
= xnm
; p
!= x
; p
++)
1947 #if defined (APOLLO) || defined (WINDOWSNT)
1948 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
1949 #else /* not (APOLLO || WINDOWSNT) */
1950 || IS_DIRECTORY_SEP (p
[0])
1951 #endif /* not (APOLLO || WINDOWSNT) */
1953 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
1956 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1957 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1961 return make_string (xnm
, x
- xnm
);
1964 error ("Bad format environment-variable substitution");
1966 error ("Missing \"}\" in environment-variable substitution");
1968 error ("Substituting nonexistent environment variable \"%s\"", target
);
1971 #endif /* not VMS */
1974 /* A slightly faster and more convenient way to get
1975 (directory-file-name (expand-file-name FOO)). */
1978 expand_and_dir_to_file (filename
, defdir
)
1979 Lisp_Object filename
, defdir
;
1981 register Lisp_Object absname
;
1983 absname
= Fexpand_file_name (filename
, defdir
);
1986 register int c
= XSTRING (absname
)->data
[XSTRING (absname
)->size
- 1];
1987 if (c
== ':' || c
== ']' || c
== '>')
1988 absname
= Fdirectory_file_name (absname
);
1991 /* Remove final slash, if any (unless this is the root dir).
1992 stat behaves differently depending! */
1993 if (XSTRING (absname
)->size
> 1
1994 && IS_DIRECTORY_SEP (XSTRING (absname
)->data
[XSTRING (absname
)->size
- 1])
1995 && !IS_DEVICE_SEP (XSTRING (absname
)->data
[XSTRING (absname
)->size
-2]))
1996 /* We cannot take shortcuts; they might be wrong for magic file names. */
1997 absname
= Fdirectory_file_name (absname
);
2002 /* Signal an error if the file ABSNAME already exists.
2003 If INTERACTIVE is nonzero, ask the user whether to proceed,
2004 and bypass the error if the user says to go ahead.
2005 QUERYSTRING is a name for the action that is being considered
2007 *STATPTR is used to store the stat information if the file exists.
2008 If the file does not exist, STATPTR->st_mode is set to 0. */
2011 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
)
2012 Lisp_Object absname
;
2013 unsigned char *querystring
;
2015 struct stat
*statptr
;
2017 register Lisp_Object tem
;
2018 struct stat statbuf
;
2019 struct gcpro gcpro1
;
2021 /* stat is a good way to tell whether the file exists,
2022 regardless of what access permissions it has. */
2023 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
2026 Fsignal (Qfile_already_exists
,
2027 Fcons (build_string ("File already exists"),
2028 Fcons (absname
, Qnil
)));
2030 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
2031 XSTRING (absname
)->data
, querystring
));
2034 Fsignal (Qfile_already_exists
,
2035 Fcons (build_string ("File already exists"),
2036 Fcons (absname
, Qnil
)));
2043 statptr
->st_mode
= 0;
2048 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2049 "fCopy file: \nFCopy %s to file: \np\nP",
2050 "Copy FILE to NEWNAME. Both args must be strings.\n\
2051 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
2052 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
2053 A number as third arg means request confirmation if NEWNAME already exists.\n\
2054 This is what happens in interactive use with M-x.\n\
2055 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
2056 last-modified time as the old one. (This works on only some systems.)\n\
2057 A prefix arg makes KEEP-TIME non-nil.")
2058 (file
, newname
, ok_if_already_exists
, keep_date
)
2059 Lisp_Object file
, newname
, ok_if_already_exists
, keep_date
;
2062 char buf
[16 * 1024];
2063 struct stat st
, out_st
;
2064 Lisp_Object handler
;
2065 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2066 int count
= specpdl_ptr
- specpdl
;
2067 int input_file_statable_p
;
2068 Lisp_Object encoded_file
, encoded_newname
;
2070 encoded_file
= encoded_newname
= Qnil
;
2071 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2072 CHECK_STRING (file
, 0);
2073 CHECK_STRING (newname
, 1);
2075 file
= Fexpand_file_name (file
, Qnil
);
2076 newname
= Fexpand_file_name (newname
, Qnil
);
2078 /* If the input file name has special constructs in it,
2079 call the corresponding file handler. */
2080 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2081 /* Likewise for output file name. */
2083 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2084 if (!NILP (handler
))
2085 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2086 ok_if_already_exists
, keep_date
));
2088 encoded_file
= ENCODE_FILE (file
);
2089 encoded_newname
= ENCODE_FILE (newname
);
2091 if (NILP (ok_if_already_exists
)
2092 || INTEGERP (ok_if_already_exists
))
2093 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2094 INTEGERP (ok_if_already_exists
), &out_st
);
2095 else if (stat (XSTRING (encoded_newname
)->data
, &out_st
) < 0)
2098 ifd
= open (XSTRING (encoded_file
)->data
, O_RDONLY
);
2100 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2102 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2104 /* We can only copy regular files and symbolic links. Other files are not
2106 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2108 #if !defined (MSDOS) || __DJGPP__ > 1
2109 if (out_st
.st_mode
!= 0
2110 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2113 report_file_error ("Input and output files are the same",
2114 Fcons (file
, Fcons (newname
, Qnil
)));
2118 #if defined (S_ISREG) && defined (S_ISLNK)
2119 if (input_file_statable_p
)
2121 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2123 #if defined (EISDIR)
2124 /* Get a better looking error message. */
2127 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2130 #endif /* S_ISREG && S_ISLNK */
2133 /* Create the copy file with the same record format as the input file */
2134 ofd
= sys_creat (XSTRING (encoded_newname
)->data
, 0666, ifd
);
2137 /* System's default file type was set to binary by _fmode in emacs.c. */
2138 ofd
= creat (XSTRING (encoded_newname
)->data
, S_IREAD
| S_IWRITE
);
2139 #else /* not MSDOS */
2140 ofd
= creat (XSTRING (encoded_newname
)->data
, 0666);
2141 #endif /* not MSDOS */
2144 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2146 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2150 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
2151 if (write (ofd
, buf
, n
) != n
)
2152 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2155 /* Closing the output clobbers the file times on some systems. */
2156 if (close (ofd
) < 0)
2157 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2159 if (input_file_statable_p
)
2161 if (!NILP (keep_date
))
2163 EMACS_TIME atime
, mtime
;
2164 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2165 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2166 if (set_file_times (XSTRING (encoded_newname
)->data
,
2168 Fsignal (Qfile_date_error
,
2169 Fcons (build_string ("Cannot set file date"),
2170 Fcons (newname
, Qnil
)));
2173 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2175 #if defined (__DJGPP__) && __DJGPP__ > 1
2176 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2177 and if it can't, it tells so. Otherwise, under MSDOS we usually
2178 get only the READ bit, which will make the copied file read-only,
2179 so it's better not to chmod at all. */
2180 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2181 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2182 #endif /* DJGPP version 2 or newer */
2188 /* Discard the unwind protects. */
2189 specpdl_ptr
= specpdl
+ count
;
2195 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2196 Smake_directory_internal
, 1, 1, 0,
2197 "Create a new directory named DIRECTORY.")
2199 Lisp_Object directory
;
2202 Lisp_Object handler
;
2203 Lisp_Object encoded_dir
;
2205 CHECK_STRING (directory
, 0);
2206 directory
= Fexpand_file_name (directory
, Qnil
);
2208 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2209 if (!NILP (handler
))
2210 return call2 (handler
, Qmake_directory_internal
, directory
);
2212 encoded_dir
= ENCODE_FILE (directory
);
2214 dir
= XSTRING (encoded_dir
)->data
;
2217 if (mkdir (dir
) != 0)
2219 if (mkdir (dir
, 0777) != 0)
2221 report_file_error ("Creating directory", Flist (1, &directory
));
2226 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2227 "Delete the directory named DIRECTORY.")
2229 Lisp_Object directory
;
2232 Lisp_Object handler
;
2233 Lisp_Object encoded_dir
;
2235 CHECK_STRING (directory
, 0);
2236 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2238 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2239 if (!NILP (handler
))
2240 return call2 (handler
, Qdelete_directory
, directory
);
2242 encoded_dir
= ENCODE_FILE (directory
);
2244 dir
= XSTRING (encoded_dir
)->data
;
2246 if (rmdir (dir
) != 0)
2247 report_file_error ("Removing directory", Flist (1, &directory
));
2252 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2253 "Delete file named FILENAME.\n\
2254 If file has multiple names, it continues to exist with the other names.")
2256 Lisp_Object filename
;
2258 Lisp_Object handler
;
2259 Lisp_Object encoded_file
;
2261 CHECK_STRING (filename
, 0);
2262 filename
= Fexpand_file_name (filename
, Qnil
);
2264 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2265 if (!NILP (handler
))
2266 return call2 (handler
, Qdelete_file
, filename
);
2268 encoded_file
= ENCODE_FILE (filename
);
2270 if (0 > unlink (XSTRING (encoded_file
)->data
))
2271 report_file_error ("Removing old name", Flist (1, &filename
));
2276 internal_delete_file_1 (ignore
)
2282 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2285 internal_delete_file (filename
)
2286 Lisp_Object filename
;
2288 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2289 Qt
, internal_delete_file_1
));
2292 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2293 "fRename file: \nFRename %s to file: \np",
2294 "Rename FILE as NEWNAME. Both args strings.\n\
2295 If file has names other than FILE, it continues to have those names.\n\
2296 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2297 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2298 A number as third arg means request confirmation if NEWNAME already exists.\n\
2299 This is what happens in interactive use with M-x.")
2300 (file
, newname
, ok_if_already_exists
)
2301 Lisp_Object file
, newname
, ok_if_already_exists
;
2304 Lisp_Object args
[2];
2306 Lisp_Object handler
;
2307 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2308 Lisp_Object encoded_file
, encoded_newname
;
2310 encoded_file
= encoded_newname
= Qnil
;
2311 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2312 CHECK_STRING (file
, 0);
2313 CHECK_STRING (newname
, 1);
2314 file
= Fexpand_file_name (file
, Qnil
);
2315 newname
= Fexpand_file_name (newname
, Qnil
);
2317 /* If the file name has special constructs in it,
2318 call the corresponding file handler. */
2319 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2321 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2322 if (!NILP (handler
))
2323 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2324 file
, newname
, ok_if_already_exists
));
2326 encoded_file
= ENCODE_FILE (file
);
2327 encoded_newname
= ENCODE_FILE (newname
);
2329 if (NILP (ok_if_already_exists
)
2330 || INTEGERP (ok_if_already_exists
))
2331 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2332 INTEGERP (ok_if_already_exists
), 0);
2334 if (0 > rename (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2336 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
)
2337 || 0 > unlink (XSTRING (encoded_file
)->data
))
2342 Fcopy_file (file
, newname
,
2343 /* We have already prompted if it was an integer,
2344 so don't have copy-file prompt again. */
2345 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2346 Fdelete_file (file
);
2353 report_file_error ("Renaming", Flist (2, args
));
2356 report_file_error ("Renaming", Flist (2, &file
));
2363 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2364 "fAdd name to file: \nFName to add to %s: \np",
2365 "Give FILE additional name NEWNAME. Both args strings.\n\
2366 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2367 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2368 A number as third arg means request confirmation if NEWNAME already exists.\n\
2369 This is what happens in interactive use with M-x.")
2370 (file
, newname
, ok_if_already_exists
)
2371 Lisp_Object file
, newname
, ok_if_already_exists
;
2374 Lisp_Object args
[2];
2376 Lisp_Object handler
;
2377 Lisp_Object encoded_file
, encoded_newname
;
2378 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2380 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2381 encoded_file
= encoded_newname
= Qnil
;
2382 CHECK_STRING (file
, 0);
2383 CHECK_STRING (newname
, 1);
2384 file
= Fexpand_file_name (file
, Qnil
);
2385 newname
= Fexpand_file_name (newname
, Qnil
);
2387 /* If the file name has special constructs in it,
2388 call the corresponding file handler. */
2389 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2390 if (!NILP (handler
))
2391 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2392 newname
, ok_if_already_exists
));
2394 /* If the new name has special constructs in it,
2395 call the corresponding file handler. */
2396 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2397 if (!NILP (handler
))
2398 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2399 newname
, ok_if_already_exists
));
2401 encoded_file
= ENCODE_FILE (file
);
2402 encoded_newname
= ENCODE_FILE (newname
);
2404 if (NILP (ok_if_already_exists
)
2405 || INTEGERP (ok_if_already_exists
))
2406 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2407 INTEGERP (ok_if_already_exists
), 0);
2409 unlink (XSTRING (newname
)->data
);
2410 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2415 report_file_error ("Adding new name", Flist (2, args
));
2417 report_file_error ("Adding new name", Flist (2, &file
));
2426 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2427 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2428 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2429 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2430 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2431 A number as third arg means request confirmation if LINKNAME already exists.\n\
2432 This happens for interactive use with M-x.")
2433 (filename
, linkname
, ok_if_already_exists
)
2434 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2437 Lisp_Object args
[2];
2439 Lisp_Object handler
;
2440 Lisp_Object encoded_filename
, encoded_linkname
;
2441 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2443 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2444 encoded_filename
= encoded_linkname
= Qnil
;
2445 CHECK_STRING (filename
, 0);
2446 CHECK_STRING (linkname
, 1);
2447 /* If the link target has a ~, we must expand it to get
2448 a truly valid file name. Otherwise, do not expand;
2449 we want to permit links to relative file names. */
2450 if (XSTRING (filename
)->data
[0] == '~')
2451 filename
= Fexpand_file_name (filename
, Qnil
);
2452 linkname
= Fexpand_file_name (linkname
, Qnil
);
2454 /* If the file name has special constructs in it,
2455 call the corresponding file handler. */
2456 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2457 if (!NILP (handler
))
2458 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2459 linkname
, ok_if_already_exists
));
2461 /* If the new link name has special constructs in it,
2462 call the corresponding file handler. */
2463 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2464 if (!NILP (handler
))
2465 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2466 linkname
, ok_if_already_exists
));
2468 encoded_filename
= ENCODE_FILE (filename
);
2469 encoded_linkname
= ENCODE_FILE (linkname
);
2471 if (NILP (ok_if_already_exists
)
2472 || INTEGERP (ok_if_already_exists
))
2473 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2474 INTEGERP (ok_if_already_exists
), 0);
2475 if (0 > symlink (XSTRING (encoded_filename
)->data
,
2476 XSTRING (encoded_linkname
)->data
))
2478 /* If we didn't complain already, silently delete existing file. */
2479 if (errno
== EEXIST
)
2481 unlink (XSTRING (encoded_linkname
)->data
);
2482 if (0 <= symlink (XSTRING (encoded_filename
)->data
,
2483 XSTRING (encoded_linkname
)->data
))
2493 report_file_error ("Making symbolic link", Flist (2, args
));
2495 report_file_error ("Making symbolic link", Flist (2, &filename
));
2501 #endif /* S_IFLNK */
2505 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2506 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2507 "Define the job-wide logical name NAME to have the value STRING.\n\
2508 If STRING is nil or a null string, the logical name NAME is deleted.")
2513 CHECK_STRING (name
, 0);
2515 delete_logical_name (XSTRING (name
)->data
);
2518 CHECK_STRING (string
, 1);
2520 if (XSTRING (string
)->size
== 0)
2521 delete_logical_name (XSTRING (name
)->data
);
2523 define_logical_name (XSTRING (name
)->data
, XSTRING (string
)->data
);
2532 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2533 "Open a network connection to PATH using LOGIN as the login string.")
2535 Lisp_Object path
, login
;
2539 CHECK_STRING (path
, 0);
2540 CHECK_STRING (login
, 0);
2542 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2544 if (netresult
== -1)
2549 #endif /* HPUX_NET */
2551 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2553 "Return t if file FILENAME specifies an absolute file name.\n\
2554 On Unix, this is a name starting with a `/' or a `~'.")
2556 Lisp_Object filename
;
2560 CHECK_STRING (filename
, 0);
2561 ptr
= XSTRING (filename
)->data
;
2562 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2564 /* ??? This criterion is probably wrong for '<'. */
2565 || index (ptr
, ':') || index (ptr
, '<')
2566 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2570 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2578 /* Return nonzero if file FILENAME exists and can be executed. */
2581 check_executable (filename
)
2585 int len
= strlen (filename
);
2588 if (stat (filename
, &st
) < 0)
2590 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2591 return ((st
.st_mode
& S_IEXEC
) != 0);
2593 return (S_ISREG (st
.st_mode
)
2595 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2596 || stricmp (suffix
, ".exe") == 0
2597 || stricmp (suffix
, ".bat") == 0)
2598 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2599 #endif /* not WINDOWSNT */
2600 #else /* not DOS_NT */
2601 #ifdef HAVE_EUIDACCESS
2602 return (euidaccess (filename
, 1) >= 0);
2604 /* Access isn't quite right because it uses the real uid
2605 and we really want to test with the effective uid.
2606 But Unix doesn't give us a right way to do it. */
2607 return (access (filename
, 1) >= 0);
2609 #endif /* not DOS_NT */
2612 /* Return nonzero if file FILENAME exists and can be written. */
2615 check_writable (filename
)
2620 if (stat (filename
, &st
) < 0)
2622 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2623 #else /* not MSDOS */
2624 #ifdef HAVE_EUIDACCESS
2625 return (euidaccess (filename
, 2) >= 0);
2627 /* Access isn't quite right because it uses the real uid
2628 and we really want to test with the effective uid.
2629 But Unix doesn't give us a right way to do it.
2630 Opening with O_WRONLY could work for an ordinary file,
2631 but would lose for directories. */
2632 return (access (filename
, 2) >= 0);
2634 #endif /* not MSDOS */
2637 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2638 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2639 See also `file-readable-p' and `file-attributes'.")
2641 Lisp_Object filename
;
2643 Lisp_Object absname
;
2644 Lisp_Object handler
;
2645 struct stat statbuf
;
2647 CHECK_STRING (filename
, 0);
2648 absname
= Fexpand_file_name (filename
, Qnil
);
2650 /* If the file name has special constructs in it,
2651 call the corresponding file handler. */
2652 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2653 if (!NILP (handler
))
2654 return call2 (handler
, Qfile_exists_p
, absname
);
2656 absname
= ENCODE_FILE (absname
);
2658 return (stat (XSTRING (absname
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2661 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2662 "Return t if FILENAME can be executed by you.\n\
2663 For a directory, this means you can access files in that directory.")
2665 Lisp_Object filename
;
2668 Lisp_Object absname
;
2669 Lisp_Object handler
;
2671 CHECK_STRING (filename
, 0);
2672 absname
= Fexpand_file_name (filename
, Qnil
);
2674 /* If the file name has special constructs in it,
2675 call the corresponding file handler. */
2676 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2677 if (!NILP (handler
))
2678 return call2 (handler
, Qfile_executable_p
, absname
);
2680 absname
= ENCODE_FILE (absname
);
2682 return (check_executable (XSTRING (absname
)->data
) ? Qt
: Qnil
);
2685 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2686 "Return t if file FILENAME exists and you can read it.\n\
2687 See also `file-exists-p' and `file-attributes'.")
2689 Lisp_Object filename
;
2691 Lisp_Object absname
;
2692 Lisp_Object handler
;
2695 struct stat statbuf
;
2697 CHECK_STRING (filename
, 0);
2698 absname
= Fexpand_file_name (filename
, Qnil
);
2700 /* If the file name has special constructs in it,
2701 call the corresponding file handler. */
2702 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2703 if (!NILP (handler
))
2704 return call2 (handler
, Qfile_readable_p
, absname
);
2706 absname
= ENCODE_FILE (absname
);
2709 /* Under MS-DOS and Windows, open does not work for directories. */
2710 if (access (XSTRING (absname
)->data
, 0) == 0)
2713 #else /* not DOS_NT */
2715 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2716 /* Opening a fifo without O_NONBLOCK can wait.
2717 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2718 except in the case of a fifo, on a system which handles it. */
2719 desc
= stat (XSTRING (absname
)->data
, &statbuf
);
2722 if (S_ISFIFO (statbuf
.st_mode
))
2723 flags
|= O_NONBLOCK
;
2725 desc
= open (XSTRING (absname
)->data
, flags
);
2730 #endif /* not DOS_NT */
2733 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2735 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2736 "Return t if file FILENAME can be written or created by you.")
2738 Lisp_Object filename
;
2740 Lisp_Object absname
, dir
, encoded
;
2741 Lisp_Object handler
;
2742 struct stat statbuf
;
2744 CHECK_STRING (filename
, 0);
2745 absname
= Fexpand_file_name (filename
, Qnil
);
2747 /* If the file name has special constructs in it,
2748 call the corresponding file handler. */
2749 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2750 if (!NILP (handler
))
2751 return call2 (handler
, Qfile_writable_p
, absname
);
2753 encoded
= ENCODE_FILE (absname
);
2754 if (stat (XSTRING (encoded
)->data
, &statbuf
) >= 0)
2755 return (check_writable (XSTRING (encoded
)->data
)
2758 dir
= Ffile_name_directory (absname
);
2761 dir
= Fdirectory_file_name (dir
);
2765 dir
= Fdirectory_file_name (dir
);
2768 dir
= ENCODE_FILE (dir
);
2769 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2773 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2774 "Access file FILENAME, and get an error if that does not work.\n\
2775 The second argument STRING is used in the error message.\n\
2776 If there is no error, we return nil.")
2778 Lisp_Object filename
, string
;
2780 Lisp_Object handler
, encoded_filename
;
2783 CHECK_STRING (filename
, 0);
2785 /* If the file name has special constructs in it,
2786 call the corresponding file handler. */
2787 handler
= Ffind_file_name_handler (filename
, Qaccess_file
);
2788 if (!NILP (handler
))
2789 return call3 (handler
, Qaccess_file
, filename
, string
);
2791 encoded_filename
= ENCODE_FILE (filename
);
2793 fd
= open (XSTRING (encoded_filename
)->data
, O_RDONLY
);
2795 report_file_error (XSTRING (string
)->data
, Fcons (filename
, Qnil
));
2801 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2802 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2803 The value is the name of the file to which it is linked.\n\
2804 Otherwise returns nil.")
2806 Lisp_Object filename
;
2813 Lisp_Object handler
;
2815 CHECK_STRING (filename
, 0);
2816 filename
= Fexpand_file_name (filename
, Qnil
);
2818 /* If the file name has special constructs in it,
2819 call the corresponding file handler. */
2820 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2821 if (!NILP (handler
))
2822 return call2 (handler
, Qfile_symlink_p
, filename
);
2824 filename
= ENCODE_FILE (filename
);
2829 buf
= (char *) xmalloc (bufsize
);
2830 bzero (buf
, bufsize
);
2831 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2832 if (valsize
< bufsize
) break;
2833 /* Buffer was not long enough */
2842 val
= make_string (buf
, valsize
);
2844 return Fdecode_coding_string (val
, Vfile_name_coding_system
, Qt
);
2845 #else /* not S_IFLNK */
2847 #endif /* not S_IFLNK */
2850 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2851 "Return t if FILENAME names an existing directory.")
2853 Lisp_Object filename
;
2855 register Lisp_Object absname
;
2857 Lisp_Object handler
;
2859 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2861 /* If the file name has special constructs in it,
2862 call the corresponding file handler. */
2863 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2864 if (!NILP (handler
))
2865 return call2 (handler
, Qfile_directory_p
, absname
);
2867 absname
= ENCODE_FILE (absname
);
2869 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2871 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2874 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2875 "Return t if file FILENAME is the name of a directory as a file,\n\
2876 and files in that directory can be opened by you. In order to use a\n\
2877 directory as a buffer's current directory, this predicate must return true.\n\
2878 A directory name spec may be given instead; then the value is t\n\
2879 if the directory so specified exists and really is a readable and\n\
2880 searchable directory.")
2882 Lisp_Object filename
;
2884 Lisp_Object handler
;
2886 struct gcpro gcpro1
;
2888 /* If the file name has special constructs in it,
2889 call the corresponding file handler. */
2890 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2891 if (!NILP (handler
))
2892 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2894 /* It's an unlikely combination, but yes we really do need to gcpro:
2895 Suppose that file-accessible-directory-p has no handler, but
2896 file-directory-p does have a handler; this handler causes a GC which
2897 relocates the string in `filename'; and finally file-directory-p
2898 returns non-nil. Then we would end up passing a garbaged string
2899 to file-executable-p. */
2901 tem
= (NILP (Ffile_directory_p (filename
))
2902 || NILP (Ffile_executable_p (filename
)));
2904 return tem
? Qnil
: Qt
;
2907 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2908 "Return t if file FILENAME is the name of a regular file.\n\
2909 This is the sort of file that holds an ordinary stream of data bytes.")
2911 Lisp_Object filename
;
2913 register Lisp_Object absname
;
2915 Lisp_Object handler
;
2917 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2919 /* If the file name has special constructs in it,
2920 call the corresponding file handler. */
2921 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
2922 if (!NILP (handler
))
2923 return call2 (handler
, Qfile_regular_p
, absname
);
2925 absname
= ENCODE_FILE (absname
);
2927 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2929 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2932 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2933 "Return mode bits of file named FILENAME, as an integer.")
2935 Lisp_Object filename
;
2937 Lisp_Object absname
;
2939 Lisp_Object handler
;
2941 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2943 /* If the file name has special constructs in it,
2944 call the corresponding file handler. */
2945 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
2946 if (!NILP (handler
))
2947 return call2 (handler
, Qfile_modes
, absname
);
2949 absname
= ENCODE_FILE (absname
);
2951 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2953 #if defined (MSDOS) && __DJGPP__ < 2
2954 if (check_executable (XSTRING (absname
)->data
))
2955 st
.st_mode
|= S_IEXEC
;
2956 #endif /* MSDOS && __DJGPP__ < 2 */
2958 return make_number (st
.st_mode
& 07777);
2961 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2962 "Set mode bits of file named FILENAME to MODE (an integer).\n\
2963 Only the 12 low bits of MODE are used.")
2965 Lisp_Object filename
, mode
;
2967 Lisp_Object absname
, encoded_absname
;
2968 Lisp_Object handler
;
2970 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
2971 CHECK_NUMBER (mode
, 1);
2973 /* If the file name has special constructs in it,
2974 call the corresponding file handler. */
2975 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
2976 if (!NILP (handler
))
2977 return call3 (handler
, Qset_file_modes
, absname
, mode
);
2979 encoded_absname
= ENCODE_FILE (absname
);
2981 if (chmod (XSTRING (encoded_absname
)->data
, XINT (mode
)) < 0)
2982 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
2987 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2988 "Set the file permission bits for newly created files.\n\
2989 The argument MODE should be an integer; only the low 9 bits are used.\n\
2990 This setting is inherited by subprocesses.")
2994 CHECK_NUMBER (mode
, 0);
2996 umask ((~ XINT (mode
)) & 0777);
3001 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3002 "Return the default file protection for created files.\n\
3003 The value is an integer.")
3009 realmask
= umask (0);
3012 XSETINT (value
, (~ realmask
) & 0777);
3018 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3019 "Tell Unix to finish all pending disk updates.")
3028 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3029 "Return t if file FILE1 is newer than file FILE2.\n\
3030 If FILE1 does not exist, the answer is nil;\n\
3031 otherwise, if FILE2 does not exist, the answer is t.")
3033 Lisp_Object file1
, file2
;
3035 Lisp_Object absname1
, absname2
;
3038 Lisp_Object handler
;
3039 struct gcpro gcpro1
, gcpro2
;
3041 CHECK_STRING (file1
, 0);
3042 CHECK_STRING (file2
, 0);
3045 GCPRO2 (absname1
, file2
);
3046 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3047 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3050 /* If the file name has special constructs in it,
3051 call the corresponding file handler. */
3052 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3054 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3055 if (!NILP (handler
))
3056 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3058 GCPRO2 (absname1
, absname2
);
3059 absname1
= ENCODE_FILE (absname1
);
3060 absname2
= ENCODE_FILE (absname2
);
3063 if (stat (XSTRING (absname1
)->data
, &st
) < 0)
3066 mtime1
= st
.st_mtime
;
3068 if (stat (XSTRING (absname2
)->data
, &st
) < 0)
3071 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3075 Lisp_Object Qfind_buffer_file_type
;
3078 #ifndef READ_BUF_SIZE
3079 #define READ_BUF_SIZE (64 << 10)
3082 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3084 "Insert contents of file FILENAME after point.\n\
3085 Returns list of absolute file name and length of data inserted.\n\
3086 If second argument VISIT is non-nil, the buffer's visited filename\n\
3087 and last save file modtime are set, and it is marked unmodified.\n\
3088 If visiting and the file does not exist, visiting is completed\n\
3089 before the error is signaled.\n\
3090 The optional third and fourth arguments BEG and END\n\
3091 specify what portion of the file to insert.\n\
3092 If VISIT is non-nil, BEG and END must be nil.\n\
3094 If optional fifth argument REPLACE is non-nil,\n\
3095 it means replace the current buffer contents (in the accessible portion)\n\
3096 with the file contents. This is better than simply deleting and inserting\n\
3097 the whole thing because (1) it preserves some marker positions\n\
3098 and (2) it puts less data in the undo list.\n\
3099 When REPLACE is non-nil, the value is the number of characters actually read,\n\
3100 which is often less than the number of characters to be read.\n\
3101 This does code conversion according to the value of\n\
3102 `coding-system-for-read' or `file-coding-system-alist',\n\
3103 and sets the variable `last-coding-system-used' to the coding system\n\
3105 (filename
, visit
, beg
, end
, replace
)
3106 Lisp_Object filename
, visit
, beg
, end
, replace
;
3110 register int inserted
= 0;
3111 register int how_much
;
3112 register int unprocessed
;
3113 int count
= specpdl_ptr
- specpdl
;
3114 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3115 Lisp_Object handler
, val
, insval
, orig_filename
;
3118 int not_regular
= 0;
3119 char read_buf
[READ_BUF_SIZE
];
3120 struct coding_system coding
;
3121 unsigned char buffer
[1 << 14];
3122 int replace_handled
= 0;
3124 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3125 error ("Cannot do file visiting in an indirect buffer");
3127 if (!NILP (current_buffer
->read_only
))
3128 Fbarf_if_buffer_read_only ();
3132 orig_filename
= Qnil
;
3134 GCPRO4 (filename
, val
, p
, orig_filename
);
3136 CHECK_STRING (filename
, 0);
3137 filename
= Fexpand_file_name (filename
, Qnil
);
3139 /* If the file name has special constructs in it,
3140 call the corresponding file handler. */
3141 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3142 if (!NILP (handler
))
3144 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3145 visit
, beg
, end
, replace
);
3149 orig_filename
= filename
;
3150 filename
= ENCODE_FILE (filename
);
3155 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3157 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
3158 || fstat (fd
, &st
) < 0)
3159 #endif /* not APOLLO */
3161 if (fd
>= 0) close (fd
);
3164 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3167 if (!NILP (Vcoding_system_for_read
))
3168 current_buffer
->buffer_file_coding_system
= Vcoding_system_for_read
;
3173 /* This code will need to be changed in order to work on named
3174 pipes, and it's probably just not worth it. So we should at
3175 least signal an error. */
3176 if (!S_ISREG (st
.st_mode
))
3183 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3184 Fsignal (Qfile_error
,
3185 Fcons (build_string ("not a regular file"),
3186 Fcons (orig_filename
, Qnil
)));
3191 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
3194 /* Replacement should preserve point as it preserves markers. */
3195 if (!NILP (replace
))
3196 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3198 record_unwind_protect (close_file_unwind
, make_number (fd
));
3200 /* Supposedly happens on VMS. */
3201 if (! not_regular
&& st
.st_size
< 0)
3202 error ("File size is negative");
3204 if (!NILP (beg
) || !NILP (end
))
3206 error ("Attempt to visit less than an entire file");
3209 CHECK_NUMBER (beg
, 0);
3211 XSETFASTINT (beg
, 0);
3214 CHECK_NUMBER (end
, 0);
3219 XSETINT (end
, st
.st_size
);
3220 if (XINT (end
) != st
.st_size
)
3221 error ("Maximum buffer size exceeded");
3225 /* Decide the coding-system of the file. */
3227 Lisp_Object val
= Qnil
;
3229 if (!NILP (Vcoding_system_for_read
))
3230 val
= Vcoding_system_for_read
;
3231 else if (NILP (current_buffer
->enable_multibyte_characters
))
3235 if (! NILP (Vset_auto_coding_function
))
3237 /* Find a coding system specified in the heading two lines
3238 or in the tailing several lines of the file. We assume
3239 that the 1K-byte and 3K-byte for heading and tailing
3240 respectively are sufficient fot this purpose. */
3241 int how_many
, nread
;
3243 if (st
.st_size
<= (1024 * 4))
3244 nread
= read (fd
, read_buf
, 1024 * 4);
3247 nread
= read (fd
, read_buf
, 1024);
3250 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3251 report_file_error ("Setting file position",
3252 Fcons (orig_filename
, Qnil
));
3253 nread
+= read (fd
, read_buf
+ nread
, 1024 * 3);
3258 error ("IO error reading %s: %s",
3259 XSTRING (orig_filename
)->data
, strerror (errno
));
3262 val
= call1 (Vset_auto_coding_function
,
3263 make_string (read_buf
, nread
));
3264 /* Rewind the file for the actual read done later. */
3265 if (lseek (fd
, 0, 0) < 0)
3266 report_file_error ("Setting file position",
3267 Fcons (orig_filename
, Qnil
));
3272 Lisp_Object args
[6], coding_systems
;
3274 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
,
3275 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3276 coding_systems
= Ffind_operation_coding_system (6, args
);
3277 if (CONSP (coding_systems
)) val
= XCONS (coding_systems
)->car
;
3280 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3283 /* If requested, replace the accessible part of the buffer
3284 with the file contents. Avoid replacing text at the
3285 beginning or end of the buffer that matches the file contents;
3286 that preserves markers pointing to the unchanged parts.
3288 Here we implement this feature in an optimized way
3289 for the case where code conversion is NOT needed.
3290 The following if-statement handles the case of conversion
3291 in a less optimal way.
3293 If the code conversion is "automatic" then we try using this
3294 method and hope for the best.
3295 But if we discover the need for conversion, we give up on this method
3296 and let the following if-statement handle the replace job. */
3298 && CODING_MAY_REQUIRE_NO_CONVERSION (&coding
))
3300 int same_at_start
= BEGV
;
3301 int same_at_end
= ZV
;
3303 /* There is still a possibility we will find the need to do code
3304 conversion. If that happens, we set this variable to 1 to
3305 give up on handling REPLACE in the optimized way. */
3306 int giveup_match_end
= 0;
3308 if (XINT (beg
) != 0)
3310 if (lseek (fd
, XINT (beg
), 0) < 0)
3311 report_file_error ("Setting file position",
3312 Fcons (orig_filename
, Qnil
));
3317 /* Count how many chars at the start of the file
3318 match the text at the beginning of the buffer. */
3323 nread
= read (fd
, buffer
, sizeof buffer
);
3325 error ("IO error reading %s: %s",
3326 XSTRING (orig_filename
)->data
, strerror (errno
));
3327 else if (nread
== 0)
3330 if (coding
.type
== coding_type_undecided
)
3331 detect_coding (&coding
, buffer
, nread
);
3332 if (coding
.type
!= coding_type_undecided
3333 && coding
.type
!= coding_type_no_conversion
3334 && coding
.type
!= coding_type_emacs_mule
)
3335 /* We found that the file should be decoded somehow.
3336 Let's give up here. */
3338 giveup_match_end
= 1;
3342 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3343 detect_eol (&coding
, buffer
, nread
);
3344 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3345 && coding
.eol_type
!= CODING_EOL_LF
)
3346 /* We found that the format of eol should be decoded.
3347 Let's give up here. */
3349 giveup_match_end
= 1;
3354 while (bufpos
< nread
&& same_at_start
< ZV
3355 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3356 same_at_start
++, bufpos
++;
3357 /* If we found a discrepancy, stop the scan.
3358 Otherwise loop around and scan the next bufferful. */
3359 if (bufpos
!= nread
)
3363 /* If the file matches the buffer completely,
3364 there's no need to replace anything. */
3365 if (same_at_start
- BEGV
== XINT (end
))
3369 /* Truncate the buffer to the size of the file. */
3370 del_range_1 (same_at_start
, same_at_end
, 0);
3375 /* Count how many chars at the end of the file
3376 match the text at the end of the buffer. But, if we have
3377 already found that decoding is necessary, don't waste time. */
3378 while (!giveup_match_end
)
3380 int total_read
, nread
, bufpos
, curpos
, trial
;
3382 /* At what file position are we now scanning? */
3383 curpos
= XINT (end
) - (ZV
- same_at_end
);
3384 /* If the entire file matches the buffer tail, stop the scan. */
3387 /* How much can we scan in the next step? */
3388 trial
= min (curpos
, sizeof buffer
);
3389 if (lseek (fd
, curpos
- trial
, 0) < 0)
3390 report_file_error ("Setting file position",
3391 Fcons (orig_filename
, Qnil
));
3394 while (total_read
< trial
)
3396 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
3398 error ("IO error reading %s: %s",
3399 XSTRING (orig_filename
)->data
, strerror (errno
));
3400 total_read
+= nread
;
3402 /* Scan this bufferful from the end, comparing with
3403 the Emacs buffer. */
3404 bufpos
= total_read
;
3405 /* Compare with same_at_start to avoid counting some buffer text
3406 as matching both at the file's beginning and at the end. */
3407 while (bufpos
> 0 && same_at_end
> same_at_start
3408 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3409 same_at_end
--, bufpos
--;
3411 /* If we found a discrepancy, stop the scan.
3412 Otherwise loop around and scan the preceding bufferful. */
3415 /* If this discrepancy is because of code conversion,
3416 we cannot use this method; giveup and try the other. */
3417 if (same_at_end
> same_at_start
3418 && FETCH_BYTE (same_at_end
- 1) >= 0200
3419 && ! NILP (current_buffer
->enable_multibyte_characters
)
3420 && ! CODING_REQUIRE_NO_CONVERSION (&coding
))
3421 giveup_match_end
= 1;
3427 if (! giveup_match_end
)
3429 /* We win! We can handle REPLACE the optimized way. */
3431 /* Extends the end of non-matching text area to multibyte
3432 character boundary. */
3433 if (! NILP (current_buffer
->enable_multibyte_characters
))
3434 while (same_at_end
< ZV
&& ! CHAR_HEAD_P (POS_ADDR (same_at_end
)))
3437 /* Don't try to reuse the same piece of text twice. */
3438 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
3440 same_at_end
+= overlap
;
3442 /* Arrange to read only the nonmatching middle part of the file. */
3443 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV
));
3444 XSETFASTINT (end
, XINT (end
) - (ZV
- same_at_end
));
3446 del_range_1 (same_at_start
, same_at_end
, 0);
3447 /* Insert from the file at the proper position. */
3448 SET_PT (same_at_start
);
3450 /* If display currently starts at beginning of line,
3451 keep it that way. */
3452 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3453 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3455 replace_handled
= 1;
3459 /* If requested, replace the accessible part of the buffer
3460 with the file contents. Avoid replacing text at the
3461 beginning or end of the buffer that matches the file contents;
3462 that preserves markers pointing to the unchanged parts.
3464 Here we implement this feature for the case where code conversion
3465 is needed, in a simple way that needs a lot of memory.
3466 The preceding if-statement handles the case of no conversion
3467 in a more optimized way. */
3468 if (!NILP (replace
) && ! replace_handled
)
3470 int same_at_start
= BEGV
;
3471 int same_at_end
= ZV
;
3474 /* Make sure that the gap is large enough. */
3475 int bufsize
= 2 * st
.st_size
;
3476 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
3478 /* First read the whole file, performing code conversion into
3479 CONVERSION_BUFFER. */
3481 if (lseek (fd
, XINT (beg
), 0) < 0)
3483 free (conversion_buffer
);
3484 report_file_error ("Setting file position",
3485 Fcons (orig_filename
, Qnil
));
3488 total
= st
.st_size
; /* Total bytes in the file. */
3489 how_much
= 0; /* Bytes read from file so far. */
3490 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3491 unprocessed
= 0; /* Bytes not processed in previous loop. */
3493 while (how_much
< total
)
3495 /* try is reserved in some compilers (Microsoft C) */
3496 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3497 char *destination
= read_buf
+ unprocessed
;
3500 /* Allow quitting out of the actual I/O. */
3503 this = read (fd
, destination
, trytry
);
3506 if (this < 0 || this + unprocessed
== 0)
3514 if (! CODING_REQUIRE_NO_CONVERSION (&coding
))
3516 int require
, produced
, consumed
;
3518 this += unprocessed
;
3520 /* If we are using more space than estimated,
3521 make CONVERSION_BUFFER bigger. */
3522 require
= decoding_buffer_size (&coding
, this);
3523 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
3525 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
3526 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
3529 /* Convert this batch with results in CONVERSION_BUFFER. */
3530 if (how_much
>= total
) /* This is the last block. */
3531 coding
.last_block
= 1;
3532 produced
= decode_coding (&coding
, read_buf
,
3533 conversion_buffer
+ inserted
,
3534 this, bufsize
- inserted
,
3537 /* Save for next iteration whatever we didn't convert. */
3538 unprocessed
= this - consumed
;
3539 bcopy (read_buf
+ consumed
, read_buf
, unprocessed
);
3546 /* At this point, INSERTED is how many characters
3547 are present in CONVERSION_BUFFER.
3548 HOW_MUCH should equal TOTAL,
3549 or should be <= 0 if we couldn't read the file. */
3553 free (conversion_buffer
);
3556 error ("IO error reading %s: %s",
3557 XSTRING (orig_filename
)->data
, strerror (errno
));
3558 else if (how_much
== -2)
3559 error ("maximum buffer size exceeded");
3562 /* Compare the beginning of the converted file
3563 with the buffer text. */
3566 while (bufpos
< inserted
&& same_at_start
< same_at_end
3567 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
3568 same_at_start
++, bufpos
++;
3570 /* If the file matches the buffer completely,
3571 there's no need to replace anything. */
3573 if (bufpos
== inserted
)
3575 free (conversion_buffer
);
3578 /* Truncate the buffer to the size of the file. */
3579 del_range_1 (same_at_start
, same_at_end
, 0);
3583 /* Scan this bufferful from the end, comparing with
3584 the Emacs buffer. */
3587 /* Compare with same_at_start to avoid counting some buffer text
3588 as matching both at the file's beginning and at the end. */
3589 while (bufpos
> 0 && same_at_end
> same_at_start
3590 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
3591 same_at_end
--, bufpos
--;
3593 /* Don't try to reuse the same piece of text twice. */
3594 overlap
= same_at_start
- BEGV
- (same_at_end
+ inserted
- ZV
);
3596 same_at_end
+= overlap
;
3598 /* If display currently starts at beginning of line,
3599 keep it that way. */
3600 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3601 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3603 /* Replace the chars that we need to replace,
3604 and update INSERTED to equal the number of bytes
3605 we are taking from the file. */
3606 inserted
-= (Z
- same_at_end
) + (same_at_start
- BEG
);
3607 move_gap (same_at_start
);
3608 del_range_1 (same_at_start
, same_at_end
, 0);
3609 SET_PT (same_at_start
);
3610 insert_1 (conversion_buffer
+ same_at_start
- BEG
, inserted
, 0, 0);
3612 free (conversion_buffer
);
3621 register Lisp_Object temp
;
3623 total
= XINT (end
) - XINT (beg
);
3625 /* Make sure point-max won't overflow after this insertion. */
3626 XSETINT (temp
, total
);
3627 if (total
!= XINT (temp
))
3628 error ("Maximum buffer size exceeded");
3631 /* For a special file, all we can do is guess. */
3632 total
= READ_BUF_SIZE
;
3634 if (NILP (visit
) && total
> 0)
3635 prepare_to_modify_buffer (PT
, PT
, NULL
);
3638 if (GAP_SIZE
< total
)
3639 make_gap (total
- GAP_SIZE
);
3641 if (XINT (beg
) != 0 || !NILP (replace
))
3643 if (lseek (fd
, XINT (beg
), 0) < 0)
3644 report_file_error ("Setting file position",
3645 Fcons (orig_filename
, Qnil
));
3648 /* In the following loop, HOW_MUCH contains the total bytes read so
3649 far. Before exiting the loop, it is set to -1 if I/O error
3650 occurs, set to -2 if the maximum buffer size is exceeded. */
3652 /* Total bytes inserted. */
3654 /* Bytes not processed in the previous loop because short gap size. */
3656 while (how_much
< total
)
3658 /* try is reserved in some compilers (Microsoft C) */
3659 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3660 char *destination
= (CODING_REQUIRE_NO_CONVERSION (&coding
)
3661 ? (char *) (POS_ADDR (PT
+ inserted
- 1) + 1)
3662 : read_buf
+ unprocessed
);
3665 /* Allow quitting out of the actual I/O. */
3668 this = read (fd
, destination
, trytry
);
3671 if (this < 0 || this + unprocessed
== 0)
3677 /* For a regular file, where TOTAL is the real size,
3678 count HOW_MUCH to compare with it.
3679 For a special file, where TOTAL is just a buffer size,
3680 so don't bother counting in HOW_MUCH.
3681 (INSERTED is where we count the number of characters inserted.) */
3685 if (! CODING_REQUIRE_NO_CONVERSION (&coding
))
3687 int require
, produced
, consumed
;
3689 this += unprocessed
;
3690 /* Make sure that the gap is large enough. */
3691 require
= decoding_buffer_size (&coding
, this);
3692 if (GAP_SIZE
< require
)
3693 make_gap (require
- GAP_SIZE
);
3697 if (how_much
>= total
) /* This is the last block. */
3698 coding
.last_block
= 1;
3702 /* If we encounter EOF, say it is the last block. (The
3703 data this will apply to is the UNPROCESSED characters
3704 carried over from the last batch.) */
3706 coding
.last_block
= 1;
3709 produced
= decode_coding (&coding
, read_buf
,
3710 POS_ADDR (PT
+ inserted
- 1) + 1,
3711 this, GAP_SIZE
, &consumed
);
3716 XSET (temp
, Lisp_Int
, Z
+ produced
);
3717 if (Z
+ produced
!= XINT (temp
))
3723 unprocessed
= this - consumed
;
3724 bcopy (read_buf
+ consumed
, read_buf
, unprocessed
);
3733 /* Put an anchor to ensure multi-byte form ends at gap. */
3740 /* Use the conversion type to determine buffer-file-type
3741 (find-buffer-file-type is now used to help determine the
3743 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3744 && coding
.eol_type
!= CODING_EOL_LF
)
3745 current_buffer
->buffer_file_type
= Qnil
;
3747 current_buffer
->buffer_file_type
= Qt
;
3750 /* We don't have to consider file type of MSDOS because all files
3751 are read as binary and end-of-line format has already been
3752 decoded appropriately. */
3755 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
3756 /* Determine file type from name and remove LFs from CR-LFs if the file
3757 is deemed to be a text file. */
3759 current_buffer
->buffer_file_type
3760 = call1 (Qfind_buffer_file_type
, orig_filename
);
3761 if (NILP (current_buffer
->buffer_file_type
))
3764 = inserted
- crlf_to_lf (inserted
, POS_ADDR (PT
- 1) + 1);
3767 GPT
-= reduced_size
;
3768 GAP_SIZE
+= reduced_size
;
3769 inserted
-= reduced_size
;
3777 record_insert (PT
, inserted
);
3779 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
3780 offset_intervals (current_buffer
, PT
, inserted
);
3786 /* Discard the unwind protect for closing the file. */
3790 error ("IO error reading %s: %s",
3791 XSTRING (orig_filename
)->data
, strerror (errno
));
3792 else if (how_much
== -2)
3793 error ("maximum buffer size exceeded");
3800 if (!EQ (current_buffer
->undo_list
, Qt
))
3801 current_buffer
->undo_list
= Qnil
;
3803 stat (XSTRING (filename
)->data
, &st
);
3808 current_buffer
->modtime
= st
.st_mtime
;
3809 current_buffer
->filename
= orig_filename
;
3812 SAVE_MODIFF
= MODIFF
;
3813 current_buffer
->auto_save_modified
= MODIFF
;
3814 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3815 #ifdef CLASH_DETECTION
3818 if (!NILP (current_buffer
->file_truename
))
3819 unlock_file (current_buffer
->file_truename
);
3820 unlock_file (filename
);
3822 #endif /* CLASH_DETECTION */
3824 Fsignal (Qfile_error
,
3825 Fcons (build_string ("not a regular file"),
3826 Fcons (orig_filename
, Qnil
)));
3828 /* If visiting nonexistent file, return nil. */
3829 if (current_buffer
->modtime
== -1)
3830 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3833 /* Decode file format */
3836 insval
= call3 (Qformat_decode
,
3837 Qnil
, make_number (inserted
), visit
);
3838 CHECK_NUMBER (insval
, 0);
3839 inserted
= XFASTINT (insval
);
3842 /* Call after-change hooks for the inserted text, aside from the case
3843 of normal visiting (not with REPLACE), which is done in a new buffer
3844 "before" the buffer is changed. */
3845 if (inserted
> 0 && total
> 0
3846 && (NILP (visit
) || !NILP (replace
)))
3847 signal_after_change (PT
, 0, inserted
);
3851 p
= Vafter_insert_file_functions
;
3852 if (!NILP (coding
.post_read_conversion
))
3853 p
= Fcons (coding
.post_read_conversion
, p
);
3857 insval
= call1 (Fcar (p
), make_number (inserted
));
3860 CHECK_NUMBER (insval
, 0);
3861 inserted
= XFASTINT (insval
);
3869 val
= Fcons (orig_filename
,
3870 Fcons (make_number (inserted
),
3873 RETURN_UNGCPRO (unbind_to (count
, val
));
3876 static Lisp_Object
build_annotations ();
3877 extern Lisp_Object
Ffile_locked_p ();
3879 /* If build_annotations switched buffers, switch back to BUF.
3880 Kill the temporary buffer that was selected in the meantime.
3882 Since this kill only the last temporary buffer, some buffers remain
3883 not killed if build_annotations switched buffers more than once.
3887 build_annotations_unwind (buf
)
3892 if (XBUFFER (buf
) == current_buffer
)
3894 tembuf
= Fcurrent_buffer ();
3896 Fkill_buffer (tembuf
);
3900 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 6,
3901 "r\nFWrite region to file: ",
3902 "Write current region into specified file.\n\
3903 When called from a program, takes three arguments:\n\
3904 START, END and FILENAME. START and END are buffer positions.\n\
3905 Optional fourth argument APPEND if non-nil means\n\
3906 append to existing file contents (if any).\n\
3907 Optional fifth argument VISIT if t means\n\
3908 set the last-save-file-modtime of buffer to this file's modtime\n\
3909 and mark buffer not modified.\n\
3910 If VISIT is a string, it is a second file name;\n\
3911 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
3912 VISIT is also the file name to lock and unlock for clash detection.\n\
3913 If VISIT is neither t nor nil nor a string,\n\
3914 that means do not print the \"Wrote file\" message.\n\
3915 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
3916 use for locking and unlocking, overriding FILENAME and VISIT.\n\
3917 Kludgy feature: if START is a string, then that string is written\n\
3918 to the file, instead of any buffer contents, and END is ignored.")
3919 (start
, end
, filename
, append
, visit
, lockname
)
3920 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
3928 int count
= specpdl_ptr
- specpdl
;
3931 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3933 Lisp_Object handler
;
3934 Lisp_Object visit_file
;
3935 Lisp_Object annotations
;
3936 Lisp_Object encoded_filename
;
3937 int visiting
, quietly
;
3938 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3939 struct buffer
*given_buffer
;
3941 int buffer_file_type
= O_BINARY
;
3943 struct coding_system coding
;
3945 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3946 error ("Cannot do file visiting in an indirect buffer");
3948 if (!NILP (start
) && !STRINGP (start
))
3949 validate_region (&start
, &end
);
3951 GCPRO4 (start
, filename
, visit
, lockname
);
3953 /* Decide the coding-system to encode the data with. */
3959 else if (!NILP (Vcoding_system_for_write
))
3960 val
= Vcoding_system_for_write
;
3961 else if (NILP (current_buffer
->enable_multibyte_characters
))
3963 /* If the variable `buffer-file-coding-system' is set locally,
3964 it means that the file was read with some kind of code
3965 conversion or the varialbe is explicitely set by users. We
3966 had better write it out with the same coding system even if
3967 `enable-multibyte-characters' is nil.
3969 If is is not set locally, we anyway have to convert EOL
3970 format if the default value of `buffer-file-coding-system'
3971 tells that it is not Unix-like (LF only) format. */
3972 val
= current_buffer
->buffer_file_coding_system
;
3973 if (NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
3975 struct coding_system coding_temp
;
3977 setup_coding_system (Fcheck_coding_system (val
), &coding_temp
);
3978 if (coding_temp
.eol_type
== CODING_EOL_CRLF
3979 || coding_temp
.eol_type
== CODING_EOL_CR
)
3981 setup_coding_system (Qemacs_mule
, &coding
);
3982 coding
.eol_type
= coding_temp
.eol_type
;
3983 goto done_setup_coding
;
3990 Lisp_Object args
[7], coding_systems
;
3992 args
[0] = Qwrite_region
, args
[1] = start
, args
[2] = end
,
3993 args
[3] = filename
, args
[4] = append
, args
[5] = visit
,
3995 coding_systems
= Ffind_operation_coding_system (7, args
);
3996 val
= (CONSP (coding_systems
) && !NILP (XCONS (coding_systems
)->cdr
)
3997 ? XCONS (coding_systems
)->cdr
3998 : current_buffer
->buffer_file_coding_system
);
4000 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4003 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4004 coding
.selective
= 1;
4007 filename
= Fexpand_file_name (filename
, Qnil
);
4008 if (STRINGP (visit
))
4009 visit_file
= Fexpand_file_name (visit
, Qnil
);
4011 visit_file
= filename
;
4014 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4015 quietly
= !NILP (visit
);
4019 if (NILP (lockname
))
4020 lockname
= visit_file
;
4022 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4024 /* If the file name has special constructs in it,
4025 call the corresponding file handler. */
4026 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4027 /* If FILENAME has no handler, see if VISIT has one. */
4028 if (NILP (handler
) && STRINGP (visit
))
4029 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4031 if (!NILP (handler
))
4034 val
= call6 (handler
, Qwrite_region
, start
, end
,
4035 filename
, append
, visit
);
4039 SAVE_MODIFF
= MODIFF
;
4040 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4041 current_buffer
->filename
= visit_file
;
4047 /* Special kludge to simplify auto-saving. */
4050 XSETFASTINT (start
, BEG
);
4051 XSETFASTINT (end
, Z
);
4054 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4055 count1
= specpdl_ptr
- specpdl
;
4057 given_buffer
= current_buffer
;
4058 annotations
= build_annotations (start
, end
, coding
.pre_write_conversion
);
4059 if (current_buffer
!= given_buffer
)
4061 XSETFASTINT (start
, BEGV
);
4062 XSETFASTINT (end
, ZV
);
4065 #ifdef CLASH_DETECTION
4068 #if 0 /* This causes trouble for GNUS. */
4069 /* If we've locked this file for some other buffer,
4070 query before proceeding. */
4071 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4072 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4075 lock_file (lockname
);
4077 #endif /* CLASH_DETECTION */
4079 encoded_filename
= ENCODE_FILE (filename
);
4081 fn
= XSTRING (encoded_filename
)->data
;
4085 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
4086 #else /* not DOS_NT */
4087 desc
= open (fn
, O_WRONLY
);
4088 #endif /* not DOS_NT */
4090 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4092 if (auto_saving
) /* Overwrite any previous version of autosave file */
4094 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4095 desc
= open (fn
, O_RDWR
);
4097 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4098 ? XSTRING (current_buffer
->filename
)->data
: 0,
4101 else /* Write to temporary name and rename if no errors */
4103 Lisp_Object temp_name
;
4104 temp_name
= Ffile_name_directory (filename
);
4106 if (!NILP (temp_name
))
4108 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4109 build_string ("$$SAVE$$")));
4110 fname
= XSTRING (filename
)->data
;
4111 fn
= XSTRING (temp_name
)->data
;
4112 desc
= creat_copy_attrs (fname
, fn
);
4115 /* If we can't open the temporary file, try creating a new
4116 version of the original file. VMS "creat" creates a
4117 new version rather than truncating an existing file. */
4120 desc
= creat (fn
, 0666);
4121 #if 0 /* This can clobber an existing file and fail to replace it,
4122 if the user runs out of space. */
4125 /* We can't make a new version;
4126 try to truncate and rewrite existing version if any. */
4128 desc
= open (fn
, O_RDWR
);
4134 desc
= creat (fn
, 0666);
4139 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
4140 S_IREAD
| S_IWRITE
);
4141 #else /* not DOS_NT */
4142 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
4143 #endif /* not DOS_NT */
4144 #endif /* not VMS */
4150 #ifdef CLASH_DETECTION
4152 if (!auto_saving
) unlock_file (lockname
);
4154 #endif /* CLASH_DETECTION */
4155 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4158 record_unwind_protect (close_file_unwind
, make_number (desc
));
4161 if (lseek (desc
, 0, 2) < 0)
4163 #ifdef CLASH_DETECTION
4164 if (!auto_saving
) unlock_file (lockname
);
4165 #endif /* CLASH_DETECTION */
4166 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4171 * Kludge Warning: The VMS C RTL likes to insert carriage returns
4172 * if we do writes that don't end with a carriage return. Furthermore
4173 * it cannot handle writes of more then 16K. The modified
4174 * version of "sys_write" in SYSDEP.C (see comment there) copes with
4175 * this EXCEPT for the last record (iff it doesn't end with a carriage
4176 * return). This implies that if your buffer doesn't end with a carriage
4177 * return, you get one free... tough. However it also means that if
4178 * we make two calls to sys_write (a la the following code) you can
4179 * get one at the gap as well. The easiest way to fix this (honest)
4180 * is to move the gap to the next newline (or the end of the buffer).
4185 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4186 move_gap (find_next_newline (GPT
, 1));
4188 /* Whether VMS or not, we must move the gap to the next of newline
4189 when we must put designation sequences at beginning of line. */
4190 if (INTEGERP (start
)
4191 && coding
.type
== coding_type_iso2022
4192 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
4193 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4194 move_gap (find_next_newline (GPT
, 1));
4200 if (STRINGP (start
))
4202 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
4203 XSTRING (start
)->size
, 0, &annotations
, &coding
);
4206 else if (XINT (start
) != XINT (end
))
4209 if (XINT (start
) < GPT
)
4211 register int end1
= XINT (end
);
4213 failure
= 0 > a_write (desc
, POS_ADDR (tem
),
4214 min (GPT
, end1
) - tem
, tem
, &annotations
,
4216 nwritten
+= min (GPT
, end1
) - tem
;
4220 if (XINT (end
) > GPT
&& !failure
)
4223 tem
= max (tem
, GPT
);
4224 failure
= 0 > a_write (desc
, POS_ADDR (tem
), XINT (end
) - tem
,
4225 tem
, &annotations
, &coding
);
4226 nwritten
+= XINT (end
) - tem
;
4232 /* If file was empty, still need to write the annotations */
4233 coding
.last_block
= 1;
4234 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
, &coding
);
4238 if (coding
.require_flushing
&& !coding
.last_block
)
4240 /* We have to flush out a data. */
4241 coding
.last_block
= 1;
4242 failure
= 0 > e_write (desc
, "", 0, &coding
);
4249 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4250 Disk full in NFS may be reported here. */
4251 /* mib says that closing the file will try to write as fast as NFS can do
4252 it, and that means the fsync here is not crucial for autosave files. */
4253 if (!auto_saving
&& fsync (desc
) < 0)
4255 /* If fsync fails with EINTR, don't treat that as serious. */
4257 failure
= 1, save_errno
= errno
;
4261 /* Spurious "file has changed on disk" warnings have been
4262 observed on Suns as well.
4263 It seems that `close' can change the modtime, under nfs.
4265 (This has supposedly been fixed in Sunos 4,
4266 but who knows about all the other machines with NFS?) */
4269 /* On VMS and APOLLO, must do the stat after the close
4270 since closing changes the modtime. */
4273 /* Recall that #if defined does not work on VMS. */
4280 /* NFS can report a write failure now. */
4281 if (close (desc
) < 0)
4282 failure
= 1, save_errno
= errno
;
4285 /* If we wrote to a temporary name and had no errors, rename to real name. */
4289 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
4297 /* Discard the unwind protect for close_file_unwind. */
4298 specpdl_ptr
= specpdl
+ count1
;
4299 /* Restore the original current buffer. */
4300 visit_file
= unbind_to (count
, visit_file
);
4302 #ifdef CLASH_DETECTION
4304 unlock_file (lockname
);
4305 #endif /* CLASH_DETECTION */
4307 /* Do this before reporting IO error
4308 to avoid a "file has changed on disk" warning on
4309 next attempt to save. */
4311 current_buffer
->modtime
= st
.st_mtime
;
4314 error ("IO error writing %s: %s", XSTRING (filename
)->data
,
4315 strerror (save_errno
));
4319 SAVE_MODIFF
= MODIFF
;
4320 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4321 current_buffer
->filename
= visit_file
;
4322 update_mode_lines
++;
4328 message ("Wrote %s", XSTRING (visit_file
)->data
);
4333 Lisp_Object
merge ();
4335 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4336 "Return t if (car A) is numerically less than (car B).")
4340 return Flss (Fcar (a
), Fcar (b
));
4343 /* Build the complete list of annotations appropriate for writing out
4344 the text between START and END, by calling all the functions in
4345 write-region-annotate-functions and merging the lists they return.
4346 If one of these functions switches to a different buffer, we assume
4347 that buffer contains altered text. Therefore, the caller must
4348 make sure to restore the current buffer in all cases,
4349 as save-excursion would do. */
4352 build_annotations (start
, end
, pre_write_conversion
)
4353 Lisp_Object start
, end
, pre_write_conversion
;
4355 Lisp_Object annotations
;
4357 struct gcpro gcpro1
, gcpro2
;
4358 Lisp_Object original_buffer
;
4360 XSETBUFFER (original_buffer
, current_buffer
);
4363 p
= Vwrite_region_annotate_functions
;
4364 GCPRO2 (annotations
, p
);
4367 struct buffer
*given_buffer
= current_buffer
;
4368 Vwrite_region_annotations_so_far
= annotations
;
4369 res
= call2 (Fcar (p
), start
, end
);
4370 /* If the function makes a different buffer current,
4371 assume that means this buffer contains altered text to be output.
4372 Reset START and END from the buffer bounds
4373 and discard all previous annotations because they should have
4374 been dealt with by this function. */
4375 if (current_buffer
!= given_buffer
)
4377 XSETFASTINT (start
, BEGV
);
4378 XSETFASTINT (end
, ZV
);
4381 Flength (res
); /* Check basic validity of return value */
4382 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4386 /* Now do the same for annotation functions implied by the file-format */
4387 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
4388 p
= Vauto_save_file_format
;
4390 p
= current_buffer
->file_format
;
4393 struct buffer
*given_buffer
= current_buffer
;
4394 Vwrite_region_annotations_so_far
= annotations
;
4395 res
= call4 (Qformat_annotate_function
, Fcar (p
), start
, end
,
4397 if (current_buffer
!= given_buffer
)
4399 XSETFASTINT (start
, BEGV
);
4400 XSETFASTINT (end
, ZV
);
4404 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4408 /* At last, do the same for the function PRE_WRITE_CONVERSION
4409 implied by the current coding-system. */
4410 if (!NILP (pre_write_conversion
))
4412 struct buffer
*given_buffer
= current_buffer
;
4413 Vwrite_region_annotations_so_far
= annotations
;
4414 res
= call2 (pre_write_conversion
, start
, end
);
4416 annotations
= (current_buffer
!= given_buffer
4418 : merge (annotations
, res
, Qcar_less_than_car
));
4425 /* Write to descriptor DESC the LEN characters starting at ADDR,
4426 assuming they start at position POS in the buffer.
4427 Intersperse with them the annotations from *ANNOT
4428 (those which fall within the range of positions POS to POS + LEN),
4429 each at its appropriate position.
4431 Modify *ANNOT by discarding elements as we output them.
4432 The return value is negative in case of system call failure. */
4435 a_write (desc
, addr
, len
, pos
, annot
, coding
)
4437 register char *addr
;
4441 struct coding_system
*coding
;
4445 int lastpos
= pos
+ len
;
4447 while (NILP (*annot
) || CONSP (*annot
))
4449 tem
= Fcar_safe (Fcar (*annot
));
4450 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
4451 nextpos
= XFASTINT (tem
);
4453 return e_write (desc
, addr
, lastpos
- pos
, coding
);
4456 if (0 > e_write (desc
, addr
, nextpos
- pos
, coding
))
4458 addr
+= nextpos
- pos
;
4461 tem
= Fcdr (Fcar (*annot
));
4464 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
,
4468 *annot
= Fcdr (*annot
);
4472 #ifndef WRITE_BUF_SIZE
4473 #define WRITE_BUF_SIZE (16 * 1024)
4477 e_write (desc
, addr
, len
, coding
)
4479 register char *addr
;
4481 struct coding_system
*coding
;
4483 char buf
[WRITE_BUF_SIZE
];
4484 int produced
, consumed
;
4486 /* We used to have a code for handling selective display here. But,
4487 now it is handled within encode_coding. */
4490 produced
= encode_coding (coding
, addr
, buf
, len
, WRITE_BUF_SIZE
,
4492 len
-= consumed
, addr
+= consumed
;
4495 produced
-= write (desc
, buf
, produced
);
4496 if (produced
) return -1;
4504 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
4505 Sverify_visited_file_modtime
, 1, 1, 0,
4506 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
4507 This means that the file has not been changed since it was visited or saved.")
4513 Lisp_Object handler
;
4514 Lisp_Object filename
;
4516 CHECK_BUFFER (buf
, 0);
4519 if (!STRINGP (b
->filename
)) return Qt
;
4520 if (b
->modtime
== 0) return Qt
;
4522 /* If the file name has special constructs in it,
4523 call the corresponding file handler. */
4524 handler
= Ffind_file_name_handler (b
->filename
,
4525 Qverify_visited_file_modtime
);
4526 if (!NILP (handler
))
4527 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
4529 filename
= ENCODE_FILE (b
->filename
);
4531 if (stat (XSTRING (filename
)->data
, &st
) < 0)
4533 /* If the file doesn't exist now and didn't exist before,
4534 we say that it isn't modified, provided the error is a tame one. */
4535 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
4540 if (st
.st_mtime
== b
->modtime
4541 /* If both are positive, accept them if they are off by one second. */
4542 || (st
.st_mtime
> 0 && b
->modtime
> 0
4543 && (st
.st_mtime
== b
->modtime
+ 1
4544 || st
.st_mtime
== b
->modtime
- 1)))
4549 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
4550 Sclear_visited_file_modtime
, 0, 0, 0,
4551 "Clear out records of last mod time of visited file.\n\
4552 Next attempt to save will certainly not complain of a discrepancy.")
4555 current_buffer
->modtime
= 0;
4559 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
4560 Svisited_file_modtime
, 0, 0, 0,
4561 "Return the current buffer's recorded visited file modification time.\n\
4562 The value is a list of the form (HIGH . LOW), like the time values\n\
4563 that `file-attributes' returns.")
4566 return long_to_cons ((unsigned long) current_buffer
->modtime
);
4569 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
4570 Sset_visited_file_modtime
, 0, 1, 0,
4571 "Update buffer's recorded modification time from the visited file's time.\n\
4572 Useful if the buffer was not read from the file normally\n\
4573 or if the file itself has been changed for some known benign reason.\n\
4574 An argument specifies the modification time value to use\n\
4575 \(instead of that of the visited file), in the form of a list\n\
4576 \(HIGH . LOW) or (HIGH LOW).")
4578 Lisp_Object time_list
;
4580 if (!NILP (time_list
))
4581 current_buffer
->modtime
= cons_to_long (time_list
);
4584 register Lisp_Object filename
;
4586 Lisp_Object handler
;
4588 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
4590 /* If the file name has special constructs in it,
4591 call the corresponding file handler. */
4592 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
4593 if (!NILP (handler
))
4594 /* The handler can find the file name the same way we did. */
4595 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
4597 filename
= ENCODE_FILE (filename
);
4599 if (stat (XSTRING (filename
)->data
, &st
) >= 0)
4600 current_buffer
->modtime
= st
.st_mtime
;
4610 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
4611 Fsleep_for (make_number (1), Qnil
);
4612 message ("Autosaving...error!for %s", XSTRING (current_buffer
->name
)->data
);
4613 Fsleep_for (make_number (1), Qnil
);
4614 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
4615 Fsleep_for (make_number (1), Qnil
);
4625 /* Get visited file's mode to become the auto save file's mode. */
4626 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
4627 /* But make sure we can overwrite it later! */
4628 auto_save_mode_bits
= st
.st_mode
| 0600;
4630 auto_save_mode_bits
= 0666;
4633 Fwrite_region (Qnil
, Qnil
,
4634 current_buffer
->auto_save_file_name
,
4635 Qnil
, Qlambda
, Qnil
);
4639 do_auto_save_unwind (stream
) /* used as unwind-protect function */
4644 fclose ((FILE *) (XFASTINT (XCONS (stream
)->car
) << 16
4645 | XFASTINT (XCONS (stream
)->cdr
)));
4650 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
4653 minibuffer_auto_raise
= XINT (value
);
4657 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
4658 "Auto-save all buffers that need it.\n\
4659 This is all buffers that have auto-saving enabled\n\
4660 and are changed since last auto-saved.\n\
4661 Auto-saving writes the buffer into a file\n\
4662 so that your editing is not lost if the system crashes.\n\
4663 This file is not the file you visited; that changes only when you save.\n\
4664 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
4665 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
4666 A non-nil CURRENT-ONLY argument means save only current buffer.")
4667 (no_message
, current_only
)
4668 Lisp_Object no_message
, current_only
;
4670 struct buffer
*old
= current_buffer
, *b
;
4671 Lisp_Object tail
, buf
;
4673 char *omessage
= echo_area_glyphs
;
4674 int omessage_length
= echo_area_glyphs_length
;
4675 int do_handled_files
;
4678 Lisp_Object lispstream
;
4679 int count
= specpdl_ptr
- specpdl
;
4681 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
4683 /* Ordinarily don't quit within this function,
4684 but don't make it impossible to quit (in case we get hung in I/O). */
4688 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
4689 point to non-strings reached from Vbuffer_alist. */
4694 if (!NILP (Vrun_hooks
))
4695 call1 (Vrun_hooks
, intern ("auto-save-hook"));
4697 if (STRINGP (Vauto_save_list_file_name
))
4699 Lisp_Object listfile
;
4700 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
4701 stream
= fopen (XSTRING (listfile
)->data
, "w");
4704 /* Arrange to close that file whether or not we get an error.
4705 Also reset auto_saving to 0. */
4706 lispstream
= Fcons (Qnil
, Qnil
);
4707 XSETFASTINT (XCONS (lispstream
)->car
, (EMACS_UINT
)stream
>> 16);
4708 XSETFASTINT (XCONS (lispstream
)->cdr
, (EMACS_UINT
)stream
& 0xffff);
4719 record_unwind_protect (do_auto_save_unwind
, lispstream
);
4720 record_unwind_protect (do_auto_save_unwind_1
,
4721 make_number (minibuffer_auto_raise
));
4722 minibuffer_auto_raise
= 0;
4725 /* First, save all files which don't have handlers. If Emacs is
4726 crashing, the handlers may tweak what is causing Emacs to crash
4727 in the first place, and it would be a shame if Emacs failed to
4728 autosave perfectly ordinary files because it couldn't handle some
4730 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
4731 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
4733 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
4736 /* Record all the buffers that have auto save mode
4737 in the special file that lists them. For each of these buffers,
4738 Record visited name (if any) and auto save name. */
4739 if (STRINGP (b
->auto_save_file_name
)
4740 && stream
!= NULL
&& do_handled_files
== 0)
4742 if (!NILP (b
->filename
))
4744 fwrite (XSTRING (b
->filename
)->data
, 1,
4745 XSTRING (b
->filename
)->size
, stream
);
4747 putc ('\n', stream
);
4748 fwrite (XSTRING (b
->auto_save_file_name
)->data
, 1,
4749 XSTRING (b
->auto_save_file_name
)->size
, stream
);
4750 putc ('\n', stream
);
4753 if (!NILP (current_only
)
4754 && b
!= current_buffer
)
4757 /* Don't auto-save indirect buffers.
4758 The base buffer takes care of it. */
4762 /* Check for auto save enabled
4763 and file changed since last auto save
4764 and file changed since last real save. */
4765 if (STRINGP (b
->auto_save_file_name
)
4766 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
4767 && b
->auto_save_modified
< BUF_MODIFF (b
)
4768 /* -1 means we've turned off autosaving for a while--see below. */
4769 && XINT (b
->save_length
) >= 0
4770 && (do_handled_files
4771 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
4774 EMACS_TIME before_time
, after_time
;
4776 EMACS_GET_TIME (before_time
);
4778 /* If we had a failure, don't try again for 20 minutes. */
4779 if (b
->auto_save_failure_time
>= 0
4780 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
4783 if ((XFASTINT (b
->save_length
) * 10
4784 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
4785 /* A short file is likely to change a large fraction;
4786 spare the user annoying messages. */
4787 && XFASTINT (b
->save_length
) > 5000
4788 /* These messages are frequent and annoying for `*mail*'. */
4789 && !EQ (b
->filename
, Qnil
)
4790 && NILP (no_message
))
4792 /* It has shrunk too much; turn off auto-saving here. */
4793 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
4794 message ("Buffer %s has shrunk a lot; auto save turned off there",
4795 XSTRING (b
->name
)->data
);
4796 minibuffer_auto_raise
= 0;
4797 /* Turn off auto-saving until there's a real save,
4798 and prevent any more warnings. */
4799 XSETINT (b
->save_length
, -1);
4800 Fsleep_for (make_number (1), Qnil
);
4803 set_buffer_internal (b
);
4804 if (!auto_saved
&& NILP (no_message
))
4805 message1 ("Auto-saving...");
4806 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
4808 b
->auto_save_modified
= BUF_MODIFF (b
);
4809 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4810 set_buffer_internal (old
);
4812 EMACS_GET_TIME (after_time
);
4814 /* If auto-save took more than 60 seconds,
4815 assume it was an NFS failure that got a timeout. */
4816 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
4817 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
4821 /* Prevent another auto save till enough input events come in. */
4822 record_auto_save ();
4824 if (auto_saved
&& NILP (no_message
))
4828 sit_for (1, 0, 0, 0, 0);
4829 message2 (omessage
, omessage_length
);
4832 message1 ("Auto-saving...done");
4837 unbind_to (count
, Qnil
);
4841 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
4842 Sset_buffer_auto_saved
, 0, 0, 0,
4843 "Mark current buffer as auto-saved with its current text.\n\
4844 No auto-save file will be written until the buffer changes again.")
4847 current_buffer
->auto_save_modified
= MODIFF
;
4848 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4849 current_buffer
->auto_save_failure_time
= -1;
4853 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
4854 Sclear_buffer_auto_save_failure
, 0, 0, 0,
4855 "Clear any record of a recent auto-save failure in the current buffer.")
4858 current_buffer
->auto_save_failure_time
= -1;
4862 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
4864 "Return t if buffer has been auto-saved since last read in or saved.")
4867 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
4870 /* Reading and completing file names */
4871 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
4873 /* In the string VAL, change each $ to $$ and return the result. */
4876 double_dollars (val
)
4879 register unsigned char *old
, *new;
4883 osize
= XSTRING (val
)->size
;
4884 /* Quote "$" as "$$" to get it past substitute-in-file-name */
4885 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
4886 if (*old
++ == '$') count
++;
4889 old
= XSTRING (val
)->data
;
4890 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
4891 new = XSTRING (val
)->data
;
4892 for (n
= osize
; n
> 0; n
--)
4905 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
4907 "Internal subroutine for read-file-name. Do not call this.")
4908 (string
, dir
, action
)
4909 Lisp_Object string
, dir
, action
;
4910 /* action is nil for complete, t for return list of completions,
4911 lambda for verify final value */
4913 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
4915 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4917 CHECK_STRING (string
, 0);
4924 /* No need to protect ACTION--we only compare it with t and nil. */
4925 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
4927 if (XSTRING (string
)->size
== 0)
4929 if (EQ (action
, Qlambda
))
4937 orig_string
= string
;
4938 string
= Fsubstitute_in_file_name (string
);
4939 changed
= NILP (Fstring_equal (string
, orig_string
));
4940 name
= Ffile_name_nondirectory (string
);
4941 val
= Ffile_name_directory (string
);
4943 realdir
= Fexpand_file_name (val
, realdir
);
4948 specdir
= Ffile_name_directory (string
);
4949 val
= Ffile_name_completion (name
, realdir
);
4954 return double_dollars (string
);
4958 if (!NILP (specdir
))
4959 val
= concat2 (specdir
, val
);
4961 return double_dollars (val
);
4964 #endif /* not VMS */
4968 if (EQ (action
, Qt
))
4969 return Ffile_name_all_completions (name
, realdir
);
4970 /* Only other case actually used is ACTION = lambda */
4972 /* Supposedly this helps commands such as `cd' that read directory names,
4973 but can someone explain how it helps them? -- RMS */
4974 if (XSTRING (name
)->size
== 0)
4977 return Ffile_exists_p (string
);
4980 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4981 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
4982 Value is not expanded---you must call `expand-file-name' yourself.\n\
4983 Default name to DEFAULT-FILENAME if user enters a null string.\n\
4984 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
4985 except that if INITIAL is specified, that combined with DIR is used.)\n\
4986 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
4987 Non-nil and non-t means also require confirmation after completion.\n\
4988 Fifth arg INITIAL specifies text to start with.\n\
4989 DIR defaults to current buffer's directory default.")
4990 (prompt
, dir
, default_filename
, mustmatch
, initial
)
4991 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
4993 Lisp_Object val
, insdef
, insdef1
, tem
;
4994 struct gcpro gcpro1
, gcpro2
;
4995 register char *homedir
;
4999 dir
= current_buffer
->directory
;
5000 if (NILP (default_filename
))
5002 if (! NILP (initial
))
5003 default_filename
= Fexpand_file_name (initial
, dir
);
5005 default_filename
= current_buffer
->filename
;
5008 /* If dir starts with user's homedir, change that to ~. */
5009 homedir
= (char *) egetenv ("HOME");
5011 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
5012 CORRECT_DIR_SEPS (homedir
);
5016 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
5017 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
5019 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
5020 XSTRING (dir
)->size
- strlen (homedir
) + 1);
5021 XSTRING (dir
)->data
[0] = '~';
5024 if (insert_default_directory
&& STRINGP (dir
))
5027 if (!NILP (initial
))
5029 Lisp_Object args
[2], pos
;
5033 insdef
= Fconcat (2, args
);
5034 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
5035 insdef1
= Fcons (double_dollars (insdef
), pos
);
5038 insdef1
= double_dollars (insdef
);
5040 else if (STRINGP (initial
))
5043 insdef1
= Fcons (double_dollars (insdef
), make_number (0));
5046 insdef
= Qnil
, insdef1
= Qnil
;
5049 count
= specpdl_ptr
- specpdl
;
5050 specbind (intern ("completion-ignore-case"), Qt
);
5053 GCPRO2 (insdef
, default_filename
);
5054 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
5055 dir
, mustmatch
, insdef1
,
5056 Qfile_name_history
, default_filename
, Qnil
);
5057 /* If Fcompleting_read returned the default string itself
5058 (rather than a new string with the same contents),
5059 it has to mean that the user typed RET with the minibuffer empty.
5060 In that case, we really want to return ""
5061 so that commands such as set-visited-file-name can distinguish. */
5062 if (EQ (val
, default_filename
))
5063 val
= build_string ("");
5066 unbind_to (count
, Qnil
);
5071 error ("No file name specified");
5072 tem
= Fstring_equal (val
, insdef
);
5073 if (!NILP (tem
) && !NILP (default_filename
))
5074 return default_filename
;
5075 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
5077 if (!NILP (default_filename
))
5078 return default_filename
;
5080 error ("No default file name");
5082 return Fsubstitute_in_file_name (val
);
5085 #if 0 /* Old version */
5086 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
5087 /* Don't confuse make-docfile by having two doc strings for this function.
5088 make-docfile does not pay attention to #if, for good reason! */
5090 (prompt
, dir
, defalt
, mustmatch
, initial
)
5091 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
5093 Lisp_Object val
, insdef
, tem
;
5094 struct gcpro gcpro1
, gcpro2
;
5095 register char *homedir
;
5099 dir
= current_buffer
->directory
;
5101 defalt
= current_buffer
->filename
;
5103 /* If dir starts with user's homedir, change that to ~. */
5104 homedir
= (char *) egetenv ("HOME");
5107 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
5108 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
5110 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
5111 XSTRING (dir
)->size
- strlen (homedir
) + 1);
5112 XSTRING (dir
)->data
[0] = '~';
5115 if (!NILP (initial
))
5117 else if (insert_default_directory
)
5120 insdef
= build_string ("");
5123 count
= specpdl_ptr
- specpdl
;
5124 specbind (intern ("completion-ignore-case"), Qt
);
5127 GCPRO2 (insdef
, defalt
);
5128 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
5130 insert_default_directory
? insdef
: Qnil
,
5131 Qfile_name_history
, Qnil
, Qnil
);
5134 unbind_to (count
, Qnil
);
5139 error ("No file name specified");
5140 tem
= Fstring_equal (val
, insdef
);
5141 if (!NILP (tem
) && !NILP (defalt
))
5143 return Fsubstitute_in_file_name (val
);
5145 #endif /* Old version */
5149 Qexpand_file_name
= intern ("expand-file-name");
5150 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
5151 Qdirectory_file_name
= intern ("directory-file-name");
5152 Qfile_name_directory
= intern ("file-name-directory");
5153 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
5154 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
5155 Qfile_name_as_directory
= intern ("file-name-as-directory");
5156 Qcopy_file
= intern ("copy-file");
5157 Qmake_directory_internal
= intern ("make-directory-internal");
5158 Qdelete_directory
= intern ("delete-directory");
5159 Qdelete_file
= intern ("delete-file");
5160 Qrename_file
= intern ("rename-file");
5161 Qadd_name_to_file
= intern ("add-name-to-file");
5162 Qmake_symbolic_link
= intern ("make-symbolic-link");
5163 Qfile_exists_p
= intern ("file-exists-p");
5164 Qfile_executable_p
= intern ("file-executable-p");
5165 Qfile_readable_p
= intern ("file-readable-p");
5166 Qfile_writable_p
= intern ("file-writable-p");
5167 Qfile_symlink_p
= intern ("file-symlink-p");
5168 Qaccess_file
= intern ("access-file");
5169 Qfile_directory_p
= intern ("file-directory-p");
5170 Qfile_regular_p
= intern ("file-regular-p");
5171 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
5172 Qfile_modes
= intern ("file-modes");
5173 Qset_file_modes
= intern ("set-file-modes");
5174 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
5175 Qinsert_file_contents
= intern ("insert-file-contents");
5176 Qwrite_region
= intern ("write-region");
5177 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
5178 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
5180 staticpro (&Qexpand_file_name
);
5181 staticpro (&Qsubstitute_in_file_name
);
5182 staticpro (&Qdirectory_file_name
);
5183 staticpro (&Qfile_name_directory
);
5184 staticpro (&Qfile_name_nondirectory
);
5185 staticpro (&Qunhandled_file_name_directory
);
5186 staticpro (&Qfile_name_as_directory
);
5187 staticpro (&Qcopy_file
);
5188 staticpro (&Qmake_directory_internal
);
5189 staticpro (&Qdelete_directory
);
5190 staticpro (&Qdelete_file
);
5191 staticpro (&Qrename_file
);
5192 staticpro (&Qadd_name_to_file
);
5193 staticpro (&Qmake_symbolic_link
);
5194 staticpro (&Qfile_exists_p
);
5195 staticpro (&Qfile_executable_p
);
5196 staticpro (&Qfile_readable_p
);
5197 staticpro (&Qfile_writable_p
);
5198 staticpro (&Qaccess_file
);
5199 staticpro (&Qfile_symlink_p
);
5200 staticpro (&Qfile_directory_p
);
5201 staticpro (&Qfile_regular_p
);
5202 staticpro (&Qfile_accessible_directory_p
);
5203 staticpro (&Qfile_modes
);
5204 staticpro (&Qset_file_modes
);
5205 staticpro (&Qfile_newer_than_file_p
);
5206 staticpro (&Qinsert_file_contents
);
5207 staticpro (&Qwrite_region
);
5208 staticpro (&Qverify_visited_file_modtime
);
5209 staticpro (&Qset_visited_file_modtime
);
5211 Qfile_name_history
= intern ("file-name-history");
5212 Fset (Qfile_name_history
, Qnil
);
5213 staticpro (&Qfile_name_history
);
5215 Qfile_error
= intern ("file-error");
5216 staticpro (&Qfile_error
);
5217 Qfile_already_exists
= intern ("file-already-exists");
5218 staticpro (&Qfile_already_exists
);
5219 Qfile_date_error
= intern ("file-date-error");
5220 staticpro (&Qfile_date_error
);
5223 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
5224 staticpro (&Qfind_buffer_file_type
);
5227 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
5228 "*Coding system for encoding file names.");
5229 Vfile_name_coding_system
= Qnil
;
5231 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
5232 "*Format in which to write auto-save files.\n\
5233 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
5234 If it is t, which is the default, auto-save files are written in the\n\
5235 same format as a regular save would use.");
5236 Vauto_save_file_format
= Qt
;
5238 Qformat_decode
= intern ("format-decode");
5239 staticpro (&Qformat_decode
);
5240 Qformat_annotate_function
= intern ("format-annotate-function");
5241 staticpro (&Qformat_annotate_function
);
5243 Qcar_less_than_car
= intern ("car-less-than-car");
5244 staticpro (&Qcar_less_than_car
);
5246 Fput (Qfile_error
, Qerror_conditions
,
5247 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
5248 Fput (Qfile_error
, Qerror_message
,
5249 build_string ("File error"));
5251 Fput (Qfile_already_exists
, Qerror_conditions
,
5252 Fcons (Qfile_already_exists
,
5253 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5254 Fput (Qfile_already_exists
, Qerror_message
,
5255 build_string ("File already exists"));
5257 Fput (Qfile_date_error
, Qerror_conditions
,
5258 Fcons (Qfile_date_error
,
5259 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5260 Fput (Qfile_date_error
, Qerror_message
,
5261 build_string ("Cannot set file date"));
5263 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
5264 "*Non-nil means when reading a filename start with default dir in minibuffer.");
5265 insert_default_directory
= 1;
5267 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
5268 "*Non-nil means write new files with record format `stmlf'.\n\
5269 nil means use format `var'. This variable is meaningful only on VMS.");
5270 vms_stmlf_recfm
= 0;
5272 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
5273 "Directory separator character for built-in functions that return file names.\n\
5274 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
5275 This variable affects the built-in functions only on Windows,\n\
5276 on other platforms, it is initialized so that Lisp code can find out\n\
5277 what the normal separator is.");
5278 XSETFASTINT (Vdirectory_sep_char
, '/');
5280 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5281 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
5282 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
5285 The first argument given to HANDLER is the name of the I/O primitive\n\
5286 to be handled; the remaining arguments are the arguments that were\n\
5287 passed to that primitive. For example, if you do\n\
5288 (file-exists-p FILENAME)\n\
5289 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
5290 (funcall HANDLER 'file-exists-p FILENAME)\n\
5291 The function `find-file-name-handler' checks this list for a handler\n\
5292 for its argument.");
5293 Vfile_name_handler_alist
= Qnil
;
5295 DEFVAR_LISP ("set-auto-coding-function",
5296 &Vset_auto_coding_function
,
5297 "If non-nil, a function to call to decide a coding system of file.\n\
5298 One argument is passed to this function: the string of concatination\n\
5299 or the heading 1K-byte and the tailing 3K-byte of a file to be read.\n\
5300 This function should return a coding system to decode the file contents\n\
5301 specified in the heading lines with the format:\n\
5302 -*- ... coding: CODING-SYSTEM; ... -*-\n\
5303 or local variable spec of the tailing lines with `coding:' tag.");
5304 Vset_auto_coding_function
= Qnil
;
5306 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5307 "A list of functions to be called at the end of `insert-file-contents'.\n\
5308 Each is passed one argument, the number of bytes inserted. It should return\n\
5309 the new byte count, and leave point the same. If `insert-file-contents' is\n\
5310 intercepted by a handler from `file-name-handler-alist', that handler is\n\
5311 responsible for calling the after-insert-file-functions if appropriate.");
5312 Vafter_insert_file_functions
= Qnil
;
5314 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5315 "A list of functions to be called at the start of `write-region'.\n\
5316 Each is passed two arguments, START and END as for `write-region'.\n\
5317 These are usually two numbers but not always; see the documentation\n\
5318 for `write-region'. The function should return a list of pairs\n\
5319 of the form (POSITION . STRING), consisting of strings to be effectively\n\
5320 inserted at the specified positions of the file being written (1 means to\n\
5321 insert before the first byte written). The POSITIONs must be sorted into\n\
5322 increasing order. If there are several functions in the list, the several\n\
5323 lists are merged destructively.");
5324 Vwrite_region_annotate_functions
= Qnil
;
5326 DEFVAR_LISP ("write-region-annotations-so-far",
5327 &Vwrite_region_annotations_so_far
,
5328 "When an annotation function is called, this holds the previous annotations.\n\
5329 These are the annotations made by other annotation functions\n\
5330 that were already called. See also `write-region-annotate-functions'.");
5331 Vwrite_region_annotations_so_far
= Qnil
;
5333 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5334 "A list of file name handlers that temporarily should not be used.\n\
5335 This applies only to the operation `inhibit-file-name-operation'.");
5336 Vinhibit_file_name_handlers
= Qnil
;
5338 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5339 "The operation for which `inhibit-file-name-handlers' is applicable.");
5340 Vinhibit_file_name_operation
= Qnil
;
5342 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5343 "File name in which we write a list of all auto save file names.\n\
5344 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
5345 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
5347 Vauto_save_list_file_name
= Qnil
;
5349 defsubr (&Sfind_file_name_handler
);
5350 defsubr (&Sfile_name_directory
);
5351 defsubr (&Sfile_name_nondirectory
);
5352 defsubr (&Sunhandled_file_name_directory
);
5353 defsubr (&Sfile_name_as_directory
);
5354 defsubr (&Sdirectory_file_name
);
5355 defsubr (&Smake_temp_name
);
5356 defsubr (&Sexpand_file_name
);
5357 defsubr (&Ssubstitute_in_file_name
);
5358 defsubr (&Scopy_file
);
5359 defsubr (&Smake_directory_internal
);
5360 defsubr (&Sdelete_directory
);
5361 defsubr (&Sdelete_file
);
5362 defsubr (&Srename_file
);
5363 defsubr (&Sadd_name_to_file
);
5365 defsubr (&Smake_symbolic_link
);
5366 #endif /* S_IFLNK */
5368 defsubr (&Sdefine_logical_name
);
5371 defsubr (&Ssysnetunam
);
5372 #endif /* HPUX_NET */
5373 defsubr (&Sfile_name_absolute_p
);
5374 defsubr (&Sfile_exists_p
);
5375 defsubr (&Sfile_executable_p
);
5376 defsubr (&Sfile_readable_p
);
5377 defsubr (&Sfile_writable_p
);
5378 defsubr (&Saccess_file
);
5379 defsubr (&Sfile_symlink_p
);
5380 defsubr (&Sfile_directory_p
);
5381 defsubr (&Sfile_accessible_directory_p
);
5382 defsubr (&Sfile_regular_p
);
5383 defsubr (&Sfile_modes
);
5384 defsubr (&Sset_file_modes
);
5385 defsubr (&Sset_default_file_modes
);
5386 defsubr (&Sdefault_file_modes
);
5387 defsubr (&Sfile_newer_than_file_p
);
5388 defsubr (&Sinsert_file_contents
);
5389 defsubr (&Swrite_region
);
5390 defsubr (&Scar_less_than_car
);
5391 defsubr (&Sverify_visited_file_modtime
);
5392 defsubr (&Sclear_visited_file_modtime
);
5393 defsubr (&Svisited_file_modtime
);
5394 defsubr (&Sset_visited_file_modtime
);
5395 defsubr (&Sdo_auto_save
);
5396 defsubr (&Sset_buffer_auto_saved
);
5397 defsubr (&Sclear_buffer_auto_save_failure
);
5398 defsubr (&Srecent_auto_save_p
);
5400 defsubr (&Sread_file_name_internal
);
5401 defsubr (&Sread_file_name
);
5404 defsubr (&Sunix_sync
);