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
)));
252 close_file_unwind (fd
)
255 close (XFASTINT (fd
));
259 /* Restore point, having saved it as a marker. */
262 restore_point_unwind (location
)
263 Lisp_Object location
;
265 SET_PT (marker_position (location
));
266 Fset_marker (location
, Qnil
, Qnil
);
270 Lisp_Object Qexpand_file_name
;
271 Lisp_Object Qsubstitute_in_file_name
;
272 Lisp_Object Qdirectory_file_name
;
273 Lisp_Object Qfile_name_directory
;
274 Lisp_Object Qfile_name_nondirectory
;
275 Lisp_Object Qunhandled_file_name_directory
;
276 Lisp_Object Qfile_name_as_directory
;
277 Lisp_Object Qcopy_file
;
278 Lisp_Object Qmake_directory_internal
;
279 Lisp_Object Qdelete_directory
;
280 Lisp_Object Qdelete_file
;
281 Lisp_Object Qrename_file
;
282 Lisp_Object Qadd_name_to_file
;
283 Lisp_Object Qmake_symbolic_link
;
284 Lisp_Object Qfile_exists_p
;
285 Lisp_Object Qfile_executable_p
;
286 Lisp_Object Qfile_readable_p
;
287 Lisp_Object Qfile_writable_p
;
288 Lisp_Object Qfile_symlink_p
;
289 Lisp_Object Qaccess_file
;
290 Lisp_Object Qfile_directory_p
;
291 Lisp_Object Qfile_regular_p
;
292 Lisp_Object Qfile_accessible_directory_p
;
293 Lisp_Object Qfile_modes
;
294 Lisp_Object Qset_file_modes
;
295 Lisp_Object Qfile_newer_than_file_p
;
296 Lisp_Object Qinsert_file_contents
;
297 Lisp_Object Qwrite_region
;
298 Lisp_Object Qverify_visited_file_modtime
;
299 Lisp_Object Qset_visited_file_modtime
;
301 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
302 "Return FILENAME's handler function for OPERATION, if it has one.\n\
303 Otherwise, return nil.\n\
304 A file name is handled if one of the regular expressions in\n\
305 `file-name-handler-alist' matches it.\n\n\
306 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
307 any handlers that are members of `inhibit-file-name-handlers',\n\
308 but we still do run any other handlers. This lets handlers\n\
309 use the standard functions without calling themselves recursively.")
310 (filename
, operation
)
311 Lisp_Object filename
, operation
;
313 /* This function must not munge the match data. */
314 Lisp_Object chain
, inhibited_handlers
;
316 CHECK_STRING (filename
, 0);
318 if (EQ (operation
, Vinhibit_file_name_operation
))
319 inhibited_handlers
= Vinhibit_file_name_handlers
;
321 inhibited_handlers
= Qnil
;
323 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
324 chain
= XCONS (chain
)->cdr
)
327 elt
= XCONS (chain
)->car
;
331 string
= XCONS (elt
)->car
;
332 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
334 Lisp_Object handler
, tem
;
336 handler
= XCONS (elt
)->cdr
;
337 tem
= Fmemq (handler
, inhibited_handlers
);
348 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
350 "Return the directory component in file name FILENAME.\n\
351 Return nil if FILENAME does not include a directory.\n\
352 Otherwise return a directory spec.\n\
353 Given a Unix syntax file name, returns a string ending in slash;\n\
354 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
356 Lisp_Object filename
;
358 register unsigned char *beg
;
359 register unsigned char *p
;
362 CHECK_STRING (filename
, 0);
364 /* If the file name has special constructs in it,
365 call the corresponding file handler. */
366 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
368 return call2 (handler
, Qfile_name_directory
, filename
);
370 #ifdef FILE_SYSTEM_CASE
371 filename
= FILE_SYSTEM_CASE (filename
);
373 beg
= XSTRING (filename
)->data
;
375 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
377 p
= beg
+ XSTRING (filename
)->size
;
379 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
381 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
384 /* only recognise drive specifier at beginning */
385 && !(p
[-1] == ':' && p
== beg
+ 2)
392 /* Expansion of "c:" to drive and default directory. */
393 if (p
== beg
+ 2 && beg
[1] == ':')
395 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
396 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
397 if (getdefdir (toupper (*beg
) - 'A' + 1, res
))
399 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
402 p
= beg
+ strlen (beg
);
405 CORRECT_DIR_SEPS (beg
);
407 return make_string (beg
, p
- beg
);
410 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
412 "Return file name FILENAME sans its directory.\n\
413 For example, in a Unix-syntax file name,\n\
414 this is everything after the last slash,\n\
415 or the entire name if it contains no slash.")
417 Lisp_Object filename
;
419 register unsigned char *beg
, *p
, *end
;
422 CHECK_STRING (filename
, 0);
424 /* If the file name has special constructs in it,
425 call the corresponding file handler. */
426 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
428 return call2 (handler
, Qfile_name_nondirectory
, filename
);
430 beg
= XSTRING (filename
)->data
;
431 end
= p
= beg
+ XSTRING (filename
)->size
;
433 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
435 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
438 /* only recognise drive specifier at beginning */
439 && !(p
[-1] == ':' && p
== beg
+ 2)
443 return make_string (p
, end
- p
);
446 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
, Sunhandled_file_name_directory
, 1, 1, 0,
447 "Return a directly usable directory name somehow associated with FILENAME.\n\
448 A `directly usable' directory name is one that may be used without the\n\
449 intervention of any file handler.\n\
450 If FILENAME is a directly usable file itself, return\n\
451 (file-name-directory FILENAME).\n\
452 The `call-process' and `start-process' functions use this function to\n\
453 get a current directory to run processes in.")
455 Lisp_Object filename
;
459 /* If the file name has special constructs in it,
460 call the corresponding file handler. */
461 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
463 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
465 return Ffile_name_directory (filename
);
470 file_name_as_directory (out
, in
)
473 int size
= strlen (in
) - 1;
478 /* Is it already a directory string? */
479 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
481 /* Is it a VMS directory file name? If so, hack VMS syntax. */
482 else if (! index (in
, '/')
483 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
484 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
485 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
486 || ! strncmp (&in
[size
- 5], ".dir", 4))
487 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
488 && in
[size
] == '1')))
490 register char *p
, *dot
;
494 dir:x.dir --> dir:[x]
495 dir:[x]y.dir --> dir:[x.y] */
497 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
500 strncpy (out
, in
, p
- in
);
519 dot
= index (p
, '.');
522 /* blindly remove any extension */
523 size
= strlen (out
) + (dot
- p
);
524 strncat (out
, p
, dot
- p
);
535 /* For Unix syntax, Append a slash if necessary */
536 if (!IS_DIRECTORY_SEP (out
[size
]))
538 out
[size
+ 1] = DIRECTORY_SEP
;
539 out
[size
+ 2] = '\0';
542 CORRECT_DIR_SEPS (out
);
548 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
549 Sfile_name_as_directory
, 1, 1, 0,
550 "Return a string representing file FILENAME interpreted as a directory.\n\
551 This operation exists because a directory is also a file, but its name as\n\
552 a directory is different from its name as a file.\n\
553 The result can be used as the value of `default-directory'\n\
554 or passed as second argument to `expand-file-name'.\n\
555 For a Unix-syntax file name, just appends a slash.\n\
556 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
563 CHECK_STRING (file
, 0);
567 /* If the file name has special constructs in it,
568 call the corresponding file handler. */
569 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
571 return call2 (handler
, Qfile_name_as_directory
, file
);
573 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
574 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
578 * Convert from directory name to filename.
580 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
581 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
582 * On UNIX, it's simple: just make sure there isn't a terminating /
584 * Value is nonzero if the string output is different from the input.
587 directory_file_name (src
, dst
)
595 struct FAB fab
= cc$rms_fab
;
596 struct NAM nam
= cc$rms_nam
;
597 char esa
[NAM$C_MAXRSS
];
602 if (! index (src
, '/')
603 && (src
[slen
- 1] == ']'
604 || src
[slen
- 1] == ':'
605 || src
[slen
- 1] == '>'))
607 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
609 fab
.fab$b_fns
= slen
;
610 fab
.fab$l_nam
= &nam
;
611 fab
.fab$l_fop
= FAB$M_NAM
;
614 nam
.nam$b_ess
= sizeof esa
;
615 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
617 /* We call SYS$PARSE to handle such things as [--] for us. */
618 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
620 slen
= nam
.nam$b_esl
;
621 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
626 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
628 /* what about when we have logical_name:???? */
629 if (src
[slen
- 1] == ':')
630 { /* Xlate logical name and see what we get */
631 ptr
= strcpy (dst
, src
); /* upper case for getenv */
634 if ('a' <= *ptr
&& *ptr
<= 'z')
638 dst
[slen
- 1] = 0; /* remove colon */
639 if (!(src
= egetenv (dst
)))
641 /* should we jump to the beginning of this procedure?
642 Good points: allows us to use logical names that xlate
644 Bad points: can be a problem if we just translated to a device
646 For now, I'll punt and always expect VMS names, and hope for
649 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
650 { /* no recursion here! */
656 { /* not a directory spec */
661 bracket
= src
[slen
- 1];
663 /* If bracket is ']' or '>', bracket - 2 is the corresponding
665 ptr
= index (src
, bracket
- 2);
667 { /* no opening bracket */
671 if (!(rptr
= rindex (src
, '.')))
674 strncpy (dst
, src
, slen
);
678 dst
[slen
++] = bracket
;
683 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
684 then translate the device and recurse. */
685 if (dst
[slen
- 1] == ':'
686 && dst
[slen
- 2] != ':' /* skip decnet nodes */
687 && strcmp (src
+ slen
, "[000000]") == 0)
689 dst
[slen
- 1] = '\0';
690 if ((ptr
= egetenv (dst
))
691 && (rlen
= strlen (ptr
) - 1) > 0
692 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
693 && ptr
[rlen
- 1] == '.')
695 char * buf
= (char *) alloca (strlen (ptr
) + 1);
699 return directory_file_name (buf
, dst
);
704 strcat (dst
, "[000000]");
708 rlen
= strlen (rptr
) - 1;
709 strncat (dst
, rptr
, rlen
);
710 dst
[slen
+ rlen
] = '\0';
711 strcat (dst
, ".DIR.1");
715 /* Process as Unix format: just remove any final slash.
716 But leave "/" unchanged; do not change it to "". */
719 /* Handle // as root for apollo's. */
720 if ((slen
> 2 && dst
[slen
- 1] == '/')
721 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
725 && IS_DIRECTORY_SEP (dst
[slen
- 1])
727 && !IS_ANY_SEP (dst
[slen
- 2])
733 CORRECT_DIR_SEPS (dst
);
738 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
740 "Returns the file name of the directory named DIRECTORY.\n\
741 This is the name of the file that holds the data for the directory DIRECTORY.\n\
742 This operation exists because a directory is also a file, but its name as\n\
743 a directory is different from its name as a file.\n\
744 In Unix-syntax, this function just removes the final slash.\n\
745 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
746 it returns a file name such as \"[X]Y.DIR.1\".")
748 Lisp_Object directory
;
753 CHECK_STRING (directory
, 0);
755 if (NILP (directory
))
758 /* If the file name has special constructs in it,
759 call the corresponding file handler. */
760 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
762 return call2 (handler
, Qdirectory_file_name
, directory
);
765 /* 20 extra chars is insufficient for VMS, since we might perform a
766 logical name translation. an equivalence string can be up to 255
767 chars long, so grab that much extra space... - sss */
768 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
770 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
772 directory_file_name (XSTRING (directory
)->data
, buf
);
773 return build_string (buf
);
776 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
777 "Generate temporary file name (string) starting with PREFIX (a string).\n\
778 The Emacs process number forms part of the result,\n\
779 so there is no danger of generating a name being used by another process.\n\
780 In addition, this function makes an attempt to choose a name\n\
781 which has no existing file.")
787 /* Don't use too many characters of the restricted 8+3 DOS
789 val
= concat2 (prefix
, build_string ("a.XXX"));
791 val
= concat2 (prefix
, build_string ("XXXXXX"));
793 mktemp (XSTRING (val
)->data
);
795 CORRECT_DIR_SEPS (XSTRING (val
)->data
);
800 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
801 "Convert filename NAME to absolute, and canonicalize it.\n\
802 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative\n\
803 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,\n\
804 the current buffer's value of default-directory is used.\n\
805 File name components that are `.' are removed, and \n\
806 so are file name components followed by `..', along with the `..' itself;\n\
807 note that these simplifications are done without checking the resulting\n\
808 file names in the file system.\n\
809 An initial `~/' expands to your home directory.\n\
810 An initial `~USER/' expands to USER's home directory.\n\
811 See also the function `substitute-in-file-name'.")
812 (name
, default_directory
)
813 Lisp_Object name
, default_directory
;
817 register unsigned char *newdir
, *p
, *o
;
819 unsigned char *target
;
822 unsigned char * colon
= 0;
823 unsigned char * close
= 0;
824 unsigned char * slash
= 0;
825 unsigned char * brack
= 0;
826 int lbrack
= 0, rbrack
= 0;
831 int collapse_newdir
= 1;
836 CHECK_STRING (name
, 0);
838 /* If the file name has special constructs in it,
839 call the corresponding file handler. */
840 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
842 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
844 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
845 if (NILP (default_directory
))
846 default_directory
= current_buffer
->directory
;
847 if (! STRINGP (default_directory
))
848 default_directory
= build_string ("/");
850 if (!NILP (default_directory
))
852 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
854 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
857 o
= XSTRING (default_directory
)->data
;
859 /* Make sure DEFAULT_DIRECTORY is properly expanded.
860 It would be better to do this down below where we actually use
861 default_directory. Unfortunately, calling Fexpand_file_name recursively
862 could invoke GC, and the strings might be relocated. This would
863 be annoying because we have pointers into strings lying around
864 that would need adjusting, and people would add new pointers to
865 the code and forget to adjust them, resulting in intermittent bugs.
866 Putting this call here avoids all that crud.
868 The EQ test avoids infinite recursion. */
869 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
870 /* Save time in some common cases - as long as default_directory
871 is not relative, it can be canonicalized with name below (if it
872 is needed at all) without requiring it to be expanded now. */
874 /* Detect MSDOS file names with drive specifiers. */
875 && ! (IS_DRIVE (o
[0]) && (IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2])))
877 /* Detect Windows file names in UNC format. */
878 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
880 #else /* not DOS_NT */
881 /* Detect Unix absolute file names (/... alone is not absolute on
883 && ! (IS_DIRECTORY_SEP (o
[0]))
884 #endif /* not DOS_NT */
890 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
895 /* Filenames on VMS are always upper case. */
896 name
= Fupcase (name
);
898 #ifdef FILE_SYSTEM_CASE
899 name
= FILE_SYSTEM_CASE (name
);
902 nm
= XSTRING (name
)->data
;
905 /* We will force directory separators to be either all \ or /, so make
906 a local copy to modify, even if there ends up being no change. */
907 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
909 /* Find and remove drive specifier if present; this makes nm absolute
910 even if the rest of the name appears to be relative. */
912 unsigned char *colon
= rindex (nm
, ':');
915 /* Only recognize colon as part of drive specifier if there is a
916 single alphabetic character preceeding the colon (and if the
917 character before the drive letter, if present, is a directory
918 separator); this is to support the remote system syntax used by
919 ange-ftp, and the "po:username" syntax for POP mailboxes. */
923 else if (IS_DRIVE (colon
[-1])
924 && (colon
== nm
+ 1 || IS_DIRECTORY_SEP (colon
[-2])))
931 while (--colon
>= nm
)
938 /* If we see "c://somedir", we want to strip the first slash after the
939 colon when stripping the drive letter. Otherwise, this expands to
941 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
943 #endif /* WINDOWSNT */
947 /* Discard any previous drive specifier if nm is now in UNC format. */
948 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
954 /* If nm is absolute, look for /./ or /../ sequences; if none are
955 found, we can probably return right away. We will avoid allocating
956 a new string if name is already fully expanded. */
958 IS_DIRECTORY_SEP (nm
[0])
963 && (drive
|| IS_DIRECTORY_SEP (nm
[1]))
970 /* If it turns out that the filename we want to return is just a
971 suffix of FILENAME, we don't need to go through and edit
972 things; we just need to construct a new string using data
973 starting at the middle of FILENAME. If we set lose to a
974 non-zero value, that means we've discovered that we can't do
981 /* Since we know the name is absolute, we can assume that each
982 element starts with a "/". */
984 /* "." and ".." are hairy. */
985 if (IS_DIRECTORY_SEP (p
[0])
987 && (IS_DIRECTORY_SEP (p
[2])
989 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
996 /* if dev:[dir]/, move nm to / */
997 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
998 nm
= (brack
? brack
+ 1 : colon
+ 1);
1007 /* VMS pre V4.4,convert '-'s in filenames. */
1008 if (lbrack
== rbrack
)
1010 if (dots
< 2) /* this is to allow negative version numbers */
1015 if (lbrack
> rbrack
&&
1016 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1017 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1023 /* count open brackets, reset close bracket pointer */
1024 if (p
[0] == '[' || p
[0] == '<')
1025 lbrack
++, brack
= 0;
1026 /* count close brackets, set close bracket pointer */
1027 if (p
[0] == ']' || p
[0] == '>')
1028 rbrack
++, brack
= p
;
1029 /* detect ][ or >< */
1030 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1032 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1033 nm
= p
+ 1, lose
= 1;
1034 if (p
[0] == ':' && (colon
|| slash
))
1035 /* if dev1:[dir]dev2:, move nm to dev2: */
1041 /* if /name/dev:, move nm to dev: */
1044 /* if node::dev:, move colon following dev */
1045 else if (colon
&& colon
[-1] == ':')
1047 /* if dev1:dev2:, move nm to dev2: */
1048 else if (colon
&& colon
[-1] != ':')
1053 if (p
[0] == ':' && !colon
)
1059 if (lbrack
== rbrack
)
1062 else if (p
[0] == '.')
1070 if (index (nm
, '/'))
1071 return build_string (sys_translate_unix (nm
));
1074 /* Make sure directories are all separated with / or \ as
1075 desired, but avoid allocation of a new string when not
1077 CORRECT_DIR_SEPS (nm
);
1079 if (IS_DIRECTORY_SEP (nm
[1]))
1081 if (strcmp (nm
, XSTRING (name
)->data
) != 0)
1082 name
= build_string (nm
);
1086 /* drive must be set, so this is okay */
1087 if (strcmp (nm
- 2, XSTRING (name
)->data
) != 0)
1089 name
= make_string (nm
- 2, p
- nm
+ 2);
1090 XSTRING (name
)->data
[0] = DRIVE_LETTER (drive
);
1091 XSTRING (name
)->data
[1] = ':';
1094 #else /* not DOS_NT */
1095 if (nm
== XSTRING (name
)->data
)
1097 return build_string (nm
);
1098 #endif /* not DOS_NT */
1102 /* At this point, nm might or might not be an absolute file name. We
1103 need to expand ~ or ~user if present, otherwise prefix nm with
1104 default_directory if nm is not absolute, and finally collapse /./
1105 and /foo/../ sequences.
1107 We set newdir to be the appropriate prefix if one is needed:
1108 - the relevant user directory if nm starts with ~ or ~user
1109 - the specified drive's working dir (DOS/NT only) if nm does not
1111 - the value of default_directory.
1113 Note that these prefixes are not guaranteed to be absolute (except
1114 for the working dir of a drive). Therefore, to ensure we always
1115 return an absolute name, if the final prefix is not absolute we
1116 append it to the current working directory. */
1120 if (nm
[0] == '~') /* prefix ~ */
1122 if (IS_DIRECTORY_SEP (nm
[1])
1126 || nm
[1] == 0) /* ~ by itself */
1128 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1129 newdir
= (unsigned char *) "";
1132 collapse_newdir
= 0;
1135 nm
++; /* Don't leave the slash in nm. */
1138 else /* ~user/filename */
1140 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1145 o
= (unsigned char *) alloca (p
- nm
+ 1);
1146 bcopy ((char *) nm
, o
, p
- nm
);
1149 pw
= (struct passwd
*) getpwnam (o
+ 1);
1152 newdir
= (unsigned char *) pw
-> pw_dir
;
1154 nm
= p
+ 1; /* skip the terminator */
1158 collapse_newdir
= 0;
1163 /* If we don't find a user of that name, leave the name
1164 unchanged; don't move nm forward to p. */
1169 /* On DOS and Windows, nm is absolute if a drive name was specified;
1170 use the drive's current directory as the prefix if needed. */
1171 if (!newdir
&& drive
)
1173 /* Get default directory if needed to make nm absolute. */
1174 if (!IS_DIRECTORY_SEP (nm
[0]))
1176 newdir
= alloca (MAXPATHLEN
+ 1);
1177 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1182 /* Either nm starts with /, or drive isn't mounted. */
1183 newdir
= alloca (4);
1184 newdir
[0] = DRIVE_LETTER (drive
);
1192 /* Finally, if no prefix has been specified and nm is not absolute,
1193 then it must be expanded relative to default_directory. */
1197 /* /... alone is not absolute on DOS and Windows. */
1198 && !IS_DIRECTORY_SEP (nm
[0])
1201 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1208 newdir
= XSTRING (default_directory
)->data
;
1214 /* First ensure newdir is an absolute name. */
1216 /* Detect MSDOS file names with drive specifiers. */
1217 ! (IS_DRIVE (newdir
[0])
1218 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1220 /* Detect Windows file names in UNC format. */
1221 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1225 /* Effectively, let newdir be (expand-file-name newdir cwd).
1226 Because of the admonition against calling expand-file-name
1227 when we have pointers into lisp strings, we accomplish this
1228 indirectly by prepending newdir to nm if necessary, and using
1229 cwd (or the wd of newdir's drive) as the new newdir. */
1231 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1236 if (!IS_DIRECTORY_SEP (nm
[0]))
1238 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1239 file_name_as_directory (tmp
, newdir
);
1243 newdir
= alloca (MAXPATHLEN
+ 1);
1246 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1253 /* Strip off drive name from prefix, if present. */
1254 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1260 /* Keep only a prefix from newdir if nm starts with slash
1261 (//server/share for UNC, nothing otherwise). */
1262 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1265 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1267 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1269 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1271 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1283 /* Get rid of any slash at the end of newdir, unless newdir is
1284 just // (an incomplete UNC name). */
1285 length
= strlen (newdir
);
1286 if (length
> 0 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1288 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1292 unsigned char *temp
= (unsigned char *) alloca (length
);
1293 bcopy (newdir
, temp
, length
- 1);
1294 temp
[length
- 1] = 0;
1302 /* Now concatenate the directory and name to new space in the stack frame */
1303 tlen
+= strlen (nm
) + 1;
1305 /* Add reserved space for drive name. (The Microsoft x86 compiler
1306 produces incorrect code if the following two lines are combined.) */
1307 target
= (unsigned char *) alloca (tlen
+ 2);
1309 #else /* not DOS_NT */
1310 target
= (unsigned char *) alloca (tlen
);
1311 #endif /* not DOS_NT */
1317 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1318 strcpy (target
, newdir
);
1321 file_name_as_directory (target
, newdir
);
1324 strcat (target
, nm
);
1326 if (index (target
, '/'))
1327 strcpy (target
, sys_translate_unix (target
));
1330 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1332 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1340 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1346 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1347 /* brackets are offset from each other by 2 */
1350 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1351 /* convert [foo][bar] to [bar] */
1352 while (o
[-1] != '[' && o
[-1] != '<')
1354 else if (*p
== '-' && *o
!= '.')
1357 else if (p
[0] == '-' && o
[-1] == '.' &&
1358 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1359 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1363 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1364 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1366 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1368 /* else [foo.-] ==> [-] */
1374 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1375 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1381 if (!IS_DIRECTORY_SEP (*p
))
1385 else if (IS_DIRECTORY_SEP (p
[0])
1387 && (IS_DIRECTORY_SEP (p
[2])
1390 /* If "/." is the entire filename, keep the "/". Otherwise,
1391 just delete the whole "/.". */
1392 if (o
== target
&& p
[2] == '\0')
1396 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1397 /* `/../' is the "superroot" on certain file systems. */
1399 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1401 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1403 /* Keep initial / only if this is the whole name. */
1404 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1412 #endif /* not VMS */
1416 /* At last, set drive name. */
1418 /* Except for network file name. */
1419 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1420 #endif /* WINDOWSNT */
1422 if (!drive
) abort ();
1424 target
[0] = DRIVE_LETTER (drive
);
1427 CORRECT_DIR_SEPS (target
);
1430 return make_string (target
, o
- target
);
1434 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1435 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1436 "Convert FILENAME to absolute, and canonicalize it.\n\
1437 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1438 (does not start with slash); if DEFAULT is nil or missing,\n\
1439 the current buffer's value of default-directory is used.\n\
1440 Filenames containing `.' or `..' as components are simplified;\n\
1441 initial `~/' expands to your home directory.\n\
1442 See also the function `substitute-in-file-name'.")
1444 Lisp_Object name
, defalt
;
1448 register unsigned char *newdir
, *p
, *o
;
1450 unsigned char *target
;
1454 unsigned char * colon
= 0;
1455 unsigned char * close
= 0;
1456 unsigned char * slash
= 0;
1457 unsigned char * brack
= 0;
1458 int lbrack
= 0, rbrack
= 0;
1462 CHECK_STRING (name
, 0);
1465 /* Filenames on VMS are always upper case. */
1466 name
= Fupcase (name
);
1469 nm
= XSTRING (name
)->data
;
1471 /* If nm is absolute, flush ...// and detect /./ and /../.
1472 If no /./ or /../ we can return right away. */
1484 if (p
[0] == '/' && p
[1] == '/'
1486 /* // at start of filename is meaningful on Apollo system. */
1491 if (p
[0] == '/' && p
[1] == '~')
1492 nm
= p
+ 1, lose
= 1;
1493 if (p
[0] == '/' && p
[1] == '.'
1494 && (p
[2] == '/' || p
[2] == 0
1495 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1501 /* if dev:[dir]/, move nm to / */
1502 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1503 nm
= (brack
? brack
+ 1 : colon
+ 1);
1504 lbrack
= rbrack
= 0;
1512 /* VMS pre V4.4,convert '-'s in filenames. */
1513 if (lbrack
== rbrack
)
1515 if (dots
< 2) /* this is to allow negative version numbers */
1520 if (lbrack
> rbrack
&&
1521 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1522 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1528 /* count open brackets, reset close bracket pointer */
1529 if (p
[0] == '[' || p
[0] == '<')
1530 lbrack
++, brack
= 0;
1531 /* count close brackets, set close bracket pointer */
1532 if (p
[0] == ']' || p
[0] == '>')
1533 rbrack
++, brack
= p
;
1534 /* detect ][ or >< */
1535 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1537 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1538 nm
= p
+ 1, lose
= 1;
1539 if (p
[0] == ':' && (colon
|| slash
))
1540 /* if dev1:[dir]dev2:, move nm to dev2: */
1546 /* If /name/dev:, move nm to dev: */
1549 /* If node::dev:, move colon following dev */
1550 else if (colon
&& colon
[-1] == ':')
1552 /* If dev1:dev2:, move nm to dev2: */
1553 else if (colon
&& colon
[-1] != ':')
1558 if (p
[0] == ':' && !colon
)
1564 if (lbrack
== rbrack
)
1567 else if (p
[0] == '.')
1575 if (index (nm
, '/'))
1576 return build_string (sys_translate_unix (nm
));
1578 if (nm
== XSTRING (name
)->data
)
1580 return build_string (nm
);
1584 /* Now determine directory to start with and put it in NEWDIR */
1588 if (nm
[0] == '~') /* prefix ~ */
1593 || nm
[1] == 0)/* ~/filename */
1595 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1596 newdir
= (unsigned char *) "";
1599 nm
++; /* Don't leave the slash in nm. */
1602 else /* ~user/filename */
1604 /* Get past ~ to user */
1605 unsigned char *user
= nm
+ 1;
1606 /* Find end of name. */
1607 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1608 int len
= ptr
? ptr
- user
: strlen (user
);
1610 unsigned char *ptr1
= index (user
, ':');
1611 if (ptr1
!= 0 && ptr1
- user
< len
)
1614 /* Copy the user name into temp storage. */
1615 o
= (unsigned char *) alloca (len
+ 1);
1616 bcopy ((char *) user
, o
, len
);
1619 /* Look up the user name. */
1620 pw
= (struct passwd
*) getpwnam (o
+ 1);
1622 error ("\"%s\" isn't a registered user", o
+ 1);
1624 newdir
= (unsigned char *) pw
->pw_dir
;
1626 /* Discard the user name from NM. */
1633 #endif /* not VMS */
1637 defalt
= current_buffer
->directory
;
1638 CHECK_STRING (defalt
, 1);
1639 newdir
= XSTRING (defalt
)->data
;
1642 /* Now concatenate the directory and name to new space in the stack frame */
1644 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1645 target
= (unsigned char *) alloca (tlen
);
1651 if (nm
[0] == 0 || nm
[0] == '/')
1652 strcpy (target
, newdir
);
1655 file_name_as_directory (target
, newdir
);
1658 strcat (target
, nm
);
1660 if (index (target
, '/'))
1661 strcpy (target
, sys_translate_unix (target
));
1664 /* Now canonicalize by removing /. and /foo/.. if they appear */
1672 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1678 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1679 /* brackets are offset from each other by 2 */
1682 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1683 /* convert [foo][bar] to [bar] */
1684 while (o
[-1] != '[' && o
[-1] != '<')
1686 else if (*p
== '-' && *o
!= '.')
1689 else if (p
[0] == '-' && o
[-1] == '.' &&
1690 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1691 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1695 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1696 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1698 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1700 /* else [foo.-] ==> [-] */
1706 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1707 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1717 else if (!strncmp (p
, "//", 2)
1719 /* // at start of filename is meaningful in Apollo system. */
1727 else if (p
[0] == '/' && p
[1] == '.' &&
1728 (p
[2] == '/' || p
[2] == 0))
1730 else if (!strncmp (p
, "/..", 3)
1731 /* `/../' is the "superroot" on certain file systems. */
1733 && (p
[3] == '/' || p
[3] == 0))
1735 while (o
!= target
&& *--o
!= '/')
1738 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1742 if (o
== target
&& *o
== '/')
1750 #endif /* not VMS */
1753 return make_string (target
, o
- target
);
1757 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1758 Ssubstitute_in_file_name
, 1, 1, 0,
1759 "Substitute environment variables referred to in FILENAME.\n\
1760 `$FOO' where FOO is an environment variable name means to substitute\n\
1761 the value of that variable. The variable name should be terminated\n\
1762 with a character not a letter, digit or underscore; otherwise, enclose\n\
1763 the entire variable name in braces.\n\
1764 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1765 On VMS, `$' substitution is not done; this function does little and only\n\
1766 duplicates what `expand-file-name' does.")
1768 Lisp_Object filename
;
1772 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1773 unsigned char *target
;
1775 int substituted
= 0;
1777 Lisp_Object handler
;
1779 CHECK_STRING (filename
, 0);
1781 /* If the file name has special constructs in it,
1782 call the corresponding file handler. */
1783 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1784 if (!NILP (handler
))
1785 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1787 nm
= XSTRING (filename
)->data
;
1789 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1790 CORRECT_DIR_SEPS (nm
);
1791 substituted
= (strcmp (nm
, XSTRING (filename
)->data
) != 0);
1793 endp
= nm
+ XSTRING (filename
)->size
;
1795 /* If /~ or // appears, discard everything through first slash. */
1797 for (p
= nm
; p
!= endp
; p
++)
1800 #if defined (APOLLO) || defined (WINDOWSNT)
1801 /* // at start of file name is meaningful in Apollo and
1802 WindowsNT systems. */
1803 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1804 #else /* not (APOLLO || WINDOWSNT) */
1805 || IS_DIRECTORY_SEP (p
[0])
1806 #endif /* not (APOLLO || WINDOWSNT) */
1811 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1813 || IS_DIRECTORY_SEP (p
[-1])))
1819 /* see comment in expand-file-name about drive specifiers */
1820 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1821 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1830 return build_string (nm
);
1833 /* See if any variables are substituted into the string
1834 and find the total length of their values in `total' */
1836 for (p
= nm
; p
!= endp
;)
1846 /* "$$" means a single "$" */
1855 while (p
!= endp
&& *p
!= '}') p
++;
1856 if (*p
!= '}') goto missingclose
;
1862 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1866 /* Copy out the variable name */
1867 target
= (unsigned char *) alloca (s
- o
+ 1);
1868 strncpy (target
, o
, s
- o
);
1871 strupr (target
); /* $home == $HOME etc. */
1874 /* Get variable value */
1875 o
= (unsigned char *) egetenv (target
);
1876 if (!o
) goto badvar
;
1877 total
+= strlen (o
);
1884 /* If substitution required, recopy the string and do it */
1885 /* Make space in stack frame for the new copy */
1886 xnm
= (unsigned char *) alloca (XSTRING (filename
)->size
+ total
+ 1);
1889 /* Copy the rest of the name through, replacing $ constructs with values */
1906 while (p
!= endp
&& *p
!= '}') p
++;
1907 if (*p
!= '}') goto missingclose
;
1913 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1917 /* Copy out the variable name */
1918 target
= (unsigned char *) alloca (s
- o
+ 1);
1919 strncpy (target
, o
, s
- o
);
1922 strupr (target
); /* $home == $HOME etc. */
1925 /* Get variable value */
1926 o
= (unsigned char *) egetenv (target
);
1936 /* If /~ or // appears, discard everything through first slash. */
1938 for (p
= xnm
; p
!= x
; p
++)
1940 #if defined (APOLLO) || defined (WINDOWSNT)
1941 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
1942 #else /* not (APOLLO || WINDOWSNT) */
1943 || IS_DIRECTORY_SEP (p
[0])
1944 #endif /* not (APOLLO || WINDOWSNT) */
1946 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
1949 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1950 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1954 return make_string (xnm
, x
- xnm
);
1957 error ("Bad format environment-variable substitution");
1959 error ("Missing \"}\" in environment-variable substitution");
1961 error ("Substituting nonexistent environment variable \"%s\"", target
);
1964 #endif /* not VMS */
1967 /* A slightly faster and more convenient way to get
1968 (directory-file-name (expand-file-name FOO)). */
1971 expand_and_dir_to_file (filename
, defdir
)
1972 Lisp_Object filename
, defdir
;
1974 register Lisp_Object absname
;
1976 absname
= Fexpand_file_name (filename
, defdir
);
1979 register int c
= XSTRING (absname
)->data
[XSTRING (absname
)->size
- 1];
1980 if (c
== ':' || c
== ']' || c
== '>')
1981 absname
= Fdirectory_file_name (absname
);
1984 /* Remove final slash, if any (unless this is the root dir).
1985 stat behaves differently depending! */
1986 if (XSTRING (absname
)->size
> 1
1987 && IS_DIRECTORY_SEP (XSTRING (absname
)->data
[XSTRING (absname
)->size
- 1])
1988 && !IS_DEVICE_SEP (XSTRING (absname
)->data
[XSTRING (absname
)->size
-2]))
1989 /* We cannot take shortcuts; they might be wrong for magic file names. */
1990 absname
= Fdirectory_file_name (absname
);
1995 /* Signal an error if the file ABSNAME already exists.
1996 If INTERACTIVE is nonzero, ask the user whether to proceed,
1997 and bypass the error if the user says to go ahead.
1998 QUERYSTRING is a name for the action that is being considered
2000 *STATPTR is used to store the stat information if the file exists.
2001 If the file does not exist, STATPTR->st_mode is set to 0. */
2004 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
)
2005 Lisp_Object absname
;
2006 unsigned char *querystring
;
2008 struct stat
*statptr
;
2010 register Lisp_Object tem
;
2011 struct stat statbuf
;
2012 struct gcpro gcpro1
;
2014 /* stat is a good way to tell whether the file exists,
2015 regardless of what access permissions it has. */
2016 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
2019 Fsignal (Qfile_already_exists
,
2020 Fcons (build_string ("File already exists"),
2021 Fcons (absname
, Qnil
)));
2023 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
2024 XSTRING (absname
)->data
, querystring
));
2027 Fsignal (Qfile_already_exists
,
2028 Fcons (build_string ("File already exists"),
2029 Fcons (absname
, Qnil
)));
2036 statptr
->st_mode
= 0;
2041 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2042 "fCopy file: \nFCopy %s to file: \np\nP",
2043 "Copy FILE to NEWNAME. Both args must be strings.\n\
2044 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
2045 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
2046 A number as third arg means request confirmation if NEWNAME already exists.\n\
2047 This is what happens in interactive use with M-x.\n\
2048 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
2049 last-modified time as the old one. (This works on only some systems.)\n\
2050 A prefix arg makes KEEP-TIME non-nil.")
2051 (file
, newname
, ok_if_already_exists
, keep_date
)
2052 Lisp_Object file
, newname
, ok_if_already_exists
, keep_date
;
2055 char buf
[16 * 1024];
2056 struct stat st
, out_st
;
2057 Lisp_Object handler
;
2058 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2059 int count
= specpdl_ptr
- specpdl
;
2060 int input_file_statable_p
;
2061 Lisp_Object encoded_file
, encoded_newname
;
2063 encoded_file
= encoded_newname
= Qnil
;
2064 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2065 CHECK_STRING (file
, 0);
2066 CHECK_STRING (newname
, 1);
2068 file
= Fexpand_file_name (file
, Qnil
);
2069 newname
= Fexpand_file_name (newname
, Qnil
);
2071 /* If the input file name has special constructs in it,
2072 call the corresponding file handler. */
2073 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2074 /* Likewise for output file name. */
2076 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2077 if (!NILP (handler
))
2078 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2079 ok_if_already_exists
, keep_date
));
2081 encoded_file
= ENCODE_FILE (file
);
2082 encoded_newname
= ENCODE_FILE (newname
);
2084 if (NILP (ok_if_already_exists
)
2085 || INTEGERP (ok_if_already_exists
))
2086 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2087 INTEGERP (ok_if_already_exists
), &out_st
);
2088 else if (stat (XSTRING (encoded_newname
)->data
, &out_st
) < 0)
2091 ifd
= open (XSTRING (encoded_file
)->data
, O_RDONLY
);
2093 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2095 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2097 /* We can only copy regular files and symbolic links. Other files are not
2099 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2101 #if !defined (MSDOS) || __DJGPP__ > 1
2102 if (out_st
.st_mode
!= 0
2103 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2106 report_file_error ("Input and output files are the same",
2107 Fcons (file
, Fcons (newname
, Qnil
)));
2111 #if defined (S_ISREG) && defined (S_ISLNK)
2112 if (input_file_statable_p
)
2114 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2116 #if defined (EISDIR)
2117 /* Get a better looking error message. */
2120 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2123 #endif /* S_ISREG && S_ISLNK */
2126 /* Create the copy file with the same record format as the input file */
2127 ofd
= sys_creat (XSTRING (encoded_newname
)->data
, 0666, ifd
);
2130 /* System's default file type was set to binary by _fmode in emacs.c. */
2131 ofd
= creat (XSTRING (encoded_newname
)->data
, S_IREAD
| S_IWRITE
);
2132 #else /* not MSDOS */
2133 ofd
= creat (XSTRING (encoded_newname
)->data
, 0666);
2134 #endif /* not MSDOS */
2137 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2139 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2143 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
2144 if (write (ofd
, buf
, n
) != n
)
2145 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2148 /* Closing the output clobbers the file times on some systems. */
2149 if (close (ofd
) < 0)
2150 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2152 if (input_file_statable_p
)
2154 if (!NILP (keep_date
))
2156 EMACS_TIME atime
, mtime
;
2157 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2158 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2159 if (set_file_times (XSTRING (encoded_newname
)->data
,
2161 Fsignal (Qfile_date_error
,
2162 Fcons (build_string ("Cannot set file date"),
2163 Fcons (newname
, Qnil
)));
2166 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2168 #if defined (__DJGPP__) && __DJGPP__ > 1
2169 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2170 and if it can't, it tells so. Otherwise, under MSDOS we usually
2171 get only the READ bit, which will make the copied file read-only,
2172 so it's better not to chmod at all. */
2173 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2174 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2175 #endif /* DJGPP version 2 or newer */
2181 /* Discard the unwind protects. */
2182 specpdl_ptr
= specpdl
+ count
;
2188 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2189 Smake_directory_internal
, 1, 1, 0,
2190 "Create a new directory named DIRECTORY.")
2192 Lisp_Object directory
;
2195 Lisp_Object handler
;
2196 Lisp_Object encoded_dir
;
2198 CHECK_STRING (directory
, 0);
2199 directory
= Fexpand_file_name (directory
, Qnil
);
2201 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2202 if (!NILP (handler
))
2203 return call2 (handler
, Qmake_directory_internal
, directory
);
2205 encoded_dir
= ENCODE_FILE (directory
);
2207 dir
= XSTRING (encoded_dir
)->data
;
2210 if (mkdir (dir
) != 0)
2212 if (mkdir (dir
, 0777) != 0)
2214 report_file_error ("Creating directory", Flist (1, &directory
));
2219 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2220 "Delete the directory named DIRECTORY.")
2222 Lisp_Object directory
;
2225 Lisp_Object handler
;
2226 Lisp_Object encoded_dir
;
2228 CHECK_STRING (directory
, 0);
2229 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2231 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2232 if (!NILP (handler
))
2233 return call2 (handler
, Qdelete_directory
, directory
);
2235 encoded_dir
= ENCODE_FILE (directory
);
2237 dir
= XSTRING (encoded_dir
)->data
;
2239 if (rmdir (dir
) != 0)
2240 report_file_error ("Removing directory", Flist (1, &directory
));
2245 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2246 "Delete file named FILENAME.\n\
2247 If file has multiple names, it continues to exist with the other names.")
2249 Lisp_Object filename
;
2251 Lisp_Object handler
;
2252 Lisp_Object encoded_file
;
2254 CHECK_STRING (filename
, 0);
2255 filename
= Fexpand_file_name (filename
, Qnil
);
2257 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2258 if (!NILP (handler
))
2259 return call2 (handler
, Qdelete_file
, filename
);
2261 encoded_file
= ENCODE_FILE (filename
);
2263 if (0 > unlink (XSTRING (encoded_file
)->data
))
2264 report_file_error ("Removing old name", Flist (1, &filename
));
2269 internal_delete_file_1 (ignore
)
2275 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2278 internal_delete_file (filename
)
2279 Lisp_Object filename
;
2281 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2282 Qt
, internal_delete_file_1
));
2285 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2286 "fRename file: \nFRename %s to file: \np",
2287 "Rename FILE as NEWNAME. Both args strings.\n\
2288 If file has names other than FILE, it continues to have those names.\n\
2289 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2290 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2291 A number as third arg means request confirmation if NEWNAME already exists.\n\
2292 This is what happens in interactive use with M-x.")
2293 (file
, newname
, ok_if_already_exists
)
2294 Lisp_Object file
, newname
, ok_if_already_exists
;
2297 Lisp_Object args
[2];
2299 Lisp_Object handler
;
2300 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2301 Lisp_Object encoded_file
, encoded_newname
;
2303 encoded_file
= encoded_newname
= Qnil
;
2304 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2305 CHECK_STRING (file
, 0);
2306 CHECK_STRING (newname
, 1);
2307 file
= Fexpand_file_name (file
, Qnil
);
2308 newname
= Fexpand_file_name (newname
, Qnil
);
2310 /* If the file name has special constructs in it,
2311 call the corresponding file handler. */
2312 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2314 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2315 if (!NILP (handler
))
2316 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2317 file
, newname
, ok_if_already_exists
));
2319 encoded_file
= ENCODE_FILE (file
);
2320 encoded_newname
= ENCODE_FILE (newname
);
2322 if (NILP (ok_if_already_exists
)
2323 || INTEGERP (ok_if_already_exists
))
2324 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2325 INTEGERP (ok_if_already_exists
), 0);
2327 if (0 > rename (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2329 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
)
2330 || 0 > unlink (XSTRING (encoded_file
)->data
))
2335 Fcopy_file (file
, newname
,
2336 /* We have already prompted if it was an integer,
2337 so don't have copy-file prompt again. */
2338 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2339 Fdelete_file (file
);
2346 report_file_error ("Renaming", Flist (2, args
));
2349 report_file_error ("Renaming", Flist (2, &file
));
2356 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2357 "fAdd name to file: \nFName to add to %s: \np",
2358 "Give FILE additional name NEWNAME. Both args strings.\n\
2359 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2360 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2361 A number as third arg means request confirmation if NEWNAME already exists.\n\
2362 This is what happens in interactive use with M-x.")
2363 (file
, newname
, ok_if_already_exists
)
2364 Lisp_Object file
, newname
, ok_if_already_exists
;
2367 Lisp_Object args
[2];
2369 Lisp_Object handler
;
2370 Lisp_Object encoded_file
, encoded_newname
;
2371 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2373 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2374 encoded_file
= encoded_newname
= Qnil
;
2375 CHECK_STRING (file
, 0);
2376 CHECK_STRING (newname
, 1);
2377 file
= Fexpand_file_name (file
, Qnil
);
2378 newname
= Fexpand_file_name (newname
, Qnil
);
2380 /* If the file name has special constructs in it,
2381 call the corresponding file handler. */
2382 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2383 if (!NILP (handler
))
2384 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2385 newname
, ok_if_already_exists
));
2387 /* If the new name has special constructs in it,
2388 call the corresponding file handler. */
2389 handler
= Ffind_file_name_handler (newname
, 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 encoded_file
= ENCODE_FILE (file
);
2395 encoded_newname
= ENCODE_FILE (newname
);
2397 if (NILP (ok_if_already_exists
)
2398 || INTEGERP (ok_if_already_exists
))
2399 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2400 INTEGERP (ok_if_already_exists
), 0);
2402 unlink (XSTRING (newname
)->data
);
2403 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2408 report_file_error ("Adding new name", Flist (2, args
));
2410 report_file_error ("Adding new name", Flist (2, &file
));
2419 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2420 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2421 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2422 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2423 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2424 A number as third arg means request confirmation if LINKNAME already exists.\n\
2425 This happens for interactive use with M-x.")
2426 (filename
, linkname
, ok_if_already_exists
)
2427 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2430 Lisp_Object args
[2];
2432 Lisp_Object handler
;
2433 Lisp_Object encoded_filename
, encoded_linkname
;
2434 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2436 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2437 encoded_filename
= encoded_linkname
= Qnil
;
2438 CHECK_STRING (filename
, 0);
2439 CHECK_STRING (linkname
, 1);
2440 /* If the link target has a ~, we must expand it to get
2441 a truly valid file name. Otherwise, do not expand;
2442 we want to permit links to relative file names. */
2443 if (XSTRING (filename
)->data
[0] == '~')
2444 filename
= Fexpand_file_name (filename
, Qnil
);
2445 linkname
= Fexpand_file_name (linkname
, Qnil
);
2447 /* If the file name has special constructs in it,
2448 call the corresponding file handler. */
2449 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2450 if (!NILP (handler
))
2451 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2452 linkname
, ok_if_already_exists
));
2454 /* If the new link name has special constructs in it,
2455 call the corresponding file handler. */
2456 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2457 if (!NILP (handler
))
2458 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2459 linkname
, ok_if_already_exists
));
2461 encoded_filename
= ENCODE_FILE (filename
);
2462 encoded_linkname
= ENCODE_FILE (linkname
);
2464 if (NILP (ok_if_already_exists
)
2465 || INTEGERP (ok_if_already_exists
))
2466 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2467 INTEGERP (ok_if_already_exists
), 0);
2468 if (0 > symlink (XSTRING (encoded_filename
)->data
,
2469 XSTRING (encoded_linkname
)->data
))
2471 /* If we didn't complain already, silently delete existing file. */
2472 if (errno
== EEXIST
)
2474 unlink (XSTRING (encoded_linkname
)->data
);
2475 if (0 <= symlink (XSTRING (encoded_filename
)->data
,
2476 XSTRING (encoded_linkname
)->data
))
2486 report_file_error ("Making symbolic link", Flist (2, args
));
2488 report_file_error ("Making symbolic link", Flist (2, &filename
));
2494 #endif /* S_IFLNK */
2498 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2499 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2500 "Define the job-wide logical name NAME to have the value STRING.\n\
2501 If STRING is nil or a null string, the logical name NAME is deleted.")
2506 CHECK_STRING (name
, 0);
2508 delete_logical_name (XSTRING (name
)->data
);
2511 CHECK_STRING (string
, 1);
2513 if (XSTRING (string
)->size
== 0)
2514 delete_logical_name (XSTRING (name
)->data
);
2516 define_logical_name (XSTRING (name
)->data
, XSTRING (string
)->data
);
2525 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2526 "Open a network connection to PATH using LOGIN as the login string.")
2528 Lisp_Object path
, login
;
2532 CHECK_STRING (path
, 0);
2533 CHECK_STRING (login
, 0);
2535 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2537 if (netresult
== -1)
2542 #endif /* HPUX_NET */
2544 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2546 "Return t if file FILENAME specifies an absolute file name.\n\
2547 On Unix, this is a name starting with a `/' or a `~'.")
2549 Lisp_Object filename
;
2553 CHECK_STRING (filename
, 0);
2554 ptr
= XSTRING (filename
)->data
;
2555 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2557 /* ??? This criterion is probably wrong for '<'. */
2558 || index (ptr
, ':') || index (ptr
, '<')
2559 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2563 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2571 /* Return nonzero if file FILENAME exists and can be executed. */
2574 check_executable (filename
)
2578 int len
= strlen (filename
);
2581 if (stat (filename
, &st
) < 0)
2583 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2584 return ((st
.st_mode
& S_IEXEC
) != 0);
2586 return (S_ISREG (st
.st_mode
)
2588 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2589 || stricmp (suffix
, ".exe") == 0
2590 || stricmp (suffix
, ".bat") == 0)
2591 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2592 #endif /* not WINDOWSNT */
2593 #else /* not DOS_NT */
2594 #ifdef HAVE_EUIDACCESS
2595 return (euidaccess (filename
, 1) >= 0);
2597 /* Access isn't quite right because it uses the real uid
2598 and we really want to test with the effective uid.
2599 But Unix doesn't give us a right way to do it. */
2600 return (access (filename
, 1) >= 0);
2602 #endif /* not DOS_NT */
2605 /* Return nonzero if file FILENAME exists and can be written. */
2608 check_writable (filename
)
2613 if (stat (filename
, &st
) < 0)
2615 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2616 #else /* not MSDOS */
2617 #ifdef HAVE_EUIDACCESS
2618 return (euidaccess (filename
, 2) >= 0);
2620 /* Access isn't quite right because it uses the real uid
2621 and we really want to test with the effective uid.
2622 But Unix doesn't give us a right way to do it.
2623 Opening with O_WRONLY could work for an ordinary file,
2624 but would lose for directories. */
2625 return (access (filename
, 2) >= 0);
2627 #endif /* not MSDOS */
2630 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2631 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2632 See also `file-readable-p' and `file-attributes'.")
2634 Lisp_Object filename
;
2636 Lisp_Object absname
;
2637 Lisp_Object handler
;
2638 struct stat statbuf
;
2640 CHECK_STRING (filename
, 0);
2641 absname
= Fexpand_file_name (filename
, Qnil
);
2643 /* If the file name has special constructs in it,
2644 call the corresponding file handler. */
2645 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2646 if (!NILP (handler
))
2647 return call2 (handler
, Qfile_exists_p
, absname
);
2649 absname
= ENCODE_FILE (absname
);
2651 return (stat (XSTRING (absname
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2654 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2655 "Return t if FILENAME can be executed by you.\n\
2656 For a directory, this means you can access files in that directory.")
2658 Lisp_Object filename
;
2661 Lisp_Object absname
;
2662 Lisp_Object handler
;
2664 CHECK_STRING (filename
, 0);
2665 absname
= Fexpand_file_name (filename
, Qnil
);
2667 /* If the file name has special constructs in it,
2668 call the corresponding file handler. */
2669 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2670 if (!NILP (handler
))
2671 return call2 (handler
, Qfile_executable_p
, absname
);
2673 absname
= ENCODE_FILE (absname
);
2675 return (check_executable (XSTRING (absname
)->data
) ? Qt
: Qnil
);
2678 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2679 "Return t if file FILENAME exists and you can read it.\n\
2680 See also `file-exists-p' and `file-attributes'.")
2682 Lisp_Object filename
;
2684 Lisp_Object absname
;
2685 Lisp_Object handler
;
2688 struct stat statbuf
;
2690 CHECK_STRING (filename
, 0);
2691 absname
= Fexpand_file_name (filename
, Qnil
);
2693 /* If the file name has special constructs in it,
2694 call the corresponding file handler. */
2695 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2696 if (!NILP (handler
))
2697 return call2 (handler
, Qfile_readable_p
, absname
);
2699 absname
= ENCODE_FILE (absname
);
2702 /* Under MS-DOS and Windows, open does not work for directories. */
2703 if (access (XSTRING (absname
)->data
, 0) == 0)
2706 #else /* not DOS_NT */
2708 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2709 /* Opening a fifo without O_NONBLOCK can wait.
2710 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2711 except in the case of a fifo, on a system which handles it. */
2712 desc
= stat (XSTRING (absname
)->data
, &statbuf
);
2715 if (S_ISFIFO (statbuf
.st_mode
))
2716 flags
|= O_NONBLOCK
;
2718 desc
= open (XSTRING (absname
)->data
, flags
);
2723 #endif /* not DOS_NT */
2726 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2728 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2729 "Return t if file FILENAME can be written or created by you.")
2731 Lisp_Object filename
;
2733 Lisp_Object absname
, dir
, encoded
;
2734 Lisp_Object handler
;
2735 struct stat statbuf
;
2737 CHECK_STRING (filename
, 0);
2738 absname
= Fexpand_file_name (filename
, Qnil
);
2740 /* If the file name has special constructs in it,
2741 call the corresponding file handler. */
2742 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2743 if (!NILP (handler
))
2744 return call2 (handler
, Qfile_writable_p
, absname
);
2746 encoded
= ENCODE_FILE (absname
);
2747 if (stat (XSTRING (encoded
)->data
, &statbuf
) >= 0)
2748 return (check_writable (XSTRING (encoded
)->data
)
2751 dir
= Ffile_name_directory (absname
);
2754 dir
= Fdirectory_file_name (dir
);
2758 dir
= Fdirectory_file_name (dir
);
2761 dir
= ENCODE_FILE (dir
);
2762 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2766 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2767 "Access file FILENAME, and get an error if that does not work.\n\
2768 The second argument STRING is used in the error message.\n\
2769 If there is no error, we return nil.")
2771 Lisp_Object filename
, string
;
2773 Lisp_Object handler
, encoded_filename
;
2776 CHECK_STRING (filename
, 0);
2778 /* If the file name has special constructs in it,
2779 call the corresponding file handler. */
2780 handler
= Ffind_file_name_handler (filename
, Qaccess_file
);
2781 if (!NILP (handler
))
2782 return call3 (handler
, Qaccess_file
, filename
, string
);
2784 encoded_filename
= ENCODE_FILE (filename
);
2786 fd
= open (XSTRING (encoded_filename
)->data
, O_RDONLY
);
2788 report_file_error (XSTRING (string
)->data
, Fcons (filename
, Qnil
));
2794 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2795 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2796 The value is the name of the file to which it is linked.\n\
2797 Otherwise returns nil.")
2799 Lisp_Object filename
;
2806 Lisp_Object handler
;
2808 CHECK_STRING (filename
, 0);
2809 filename
= Fexpand_file_name (filename
, Qnil
);
2811 /* If the file name has special constructs in it,
2812 call the corresponding file handler. */
2813 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2814 if (!NILP (handler
))
2815 return call2 (handler
, Qfile_symlink_p
, filename
);
2817 filename
= ENCODE_FILE (filename
);
2822 buf
= (char *) xmalloc (bufsize
);
2823 bzero (buf
, bufsize
);
2824 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2825 if (valsize
< bufsize
) break;
2826 /* Buffer was not long enough */
2835 val
= make_string (buf
, valsize
);
2837 return Fdecode_coding_string (val
, Vfile_name_coding_system
, Qt
);
2838 #else /* not S_IFLNK */
2840 #endif /* not S_IFLNK */
2843 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2844 "Return t if FILENAME names an existing directory.")
2846 Lisp_Object filename
;
2848 register Lisp_Object absname
;
2850 Lisp_Object handler
;
2852 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2854 /* If the file name has special constructs in it,
2855 call the corresponding file handler. */
2856 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2857 if (!NILP (handler
))
2858 return call2 (handler
, Qfile_directory_p
, absname
);
2860 absname
= ENCODE_FILE (absname
);
2862 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2864 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2867 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2868 "Return t if file FILENAME is the name of a directory as a file,\n\
2869 and files in that directory can be opened by you. In order to use a\n\
2870 directory as a buffer's current directory, this predicate must return true.\n\
2871 A directory name spec may be given instead; then the value is t\n\
2872 if the directory so specified exists and really is a readable and\n\
2873 searchable directory.")
2875 Lisp_Object filename
;
2877 Lisp_Object handler
;
2879 struct gcpro gcpro1
;
2881 /* If the file name has special constructs in it,
2882 call the corresponding file handler. */
2883 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2884 if (!NILP (handler
))
2885 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2887 /* It's an unlikely combination, but yes we really do need to gcpro:
2888 Suppose that file-accessible-directory-p has no handler, but
2889 file-directory-p does have a handler; this handler causes a GC which
2890 relocates the string in `filename'; and finally file-directory-p
2891 returns non-nil. Then we would end up passing a garbaged string
2892 to file-executable-p. */
2894 tem
= (NILP (Ffile_directory_p (filename
))
2895 || NILP (Ffile_executable_p (filename
)));
2897 return tem
? Qnil
: Qt
;
2900 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2901 "Return t if file FILENAME is the name of a regular file.\n\
2902 This is the sort of file that holds an ordinary stream of data bytes.")
2904 Lisp_Object filename
;
2906 register Lisp_Object absname
;
2908 Lisp_Object handler
;
2910 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2912 /* If the file name has special constructs in it,
2913 call the corresponding file handler. */
2914 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
2915 if (!NILP (handler
))
2916 return call2 (handler
, Qfile_regular_p
, absname
);
2918 absname
= ENCODE_FILE (absname
);
2920 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2922 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2925 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2926 "Return mode bits of file named FILENAME, as an integer.")
2928 Lisp_Object filename
;
2930 Lisp_Object absname
;
2932 Lisp_Object handler
;
2934 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2936 /* If the file name has special constructs in it,
2937 call the corresponding file handler. */
2938 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
2939 if (!NILP (handler
))
2940 return call2 (handler
, Qfile_modes
, absname
);
2942 absname
= ENCODE_FILE (absname
);
2944 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2946 #if defined (MSDOS) && __DJGPP__ < 2
2947 if (check_executable (XSTRING (absname
)->data
))
2948 st
.st_mode
|= S_IEXEC
;
2949 #endif /* MSDOS && __DJGPP__ < 2 */
2951 return make_number (st
.st_mode
& 07777);
2954 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2955 "Set mode bits of file named FILENAME to MODE (an integer).\n\
2956 Only the 12 low bits of MODE are used.")
2958 Lisp_Object filename
, mode
;
2960 Lisp_Object absname
, encoded_absname
;
2961 Lisp_Object handler
;
2963 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
2964 CHECK_NUMBER (mode
, 1);
2966 /* If the file name has special constructs in it,
2967 call the corresponding file handler. */
2968 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
2969 if (!NILP (handler
))
2970 return call3 (handler
, Qset_file_modes
, absname
, mode
);
2972 encoded_absname
= ENCODE_FILE (absname
);
2974 if (chmod (XSTRING (encoded_absname
)->data
, XINT (mode
)) < 0)
2975 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
2980 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2981 "Set the file permission bits for newly created files.\n\
2982 The argument MODE should be an integer; only the low 9 bits are used.\n\
2983 This setting is inherited by subprocesses.")
2987 CHECK_NUMBER (mode
, 0);
2989 umask ((~ XINT (mode
)) & 0777);
2994 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2995 "Return the default file protection for created files.\n\
2996 The value is an integer.")
3002 realmask
= umask (0);
3005 XSETINT (value
, (~ realmask
) & 0777);
3011 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3012 "Tell Unix to finish all pending disk updates.")
3021 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3022 "Return t if file FILE1 is newer than file FILE2.\n\
3023 If FILE1 does not exist, the answer is nil;\n\
3024 otherwise, if FILE2 does not exist, the answer is t.")
3026 Lisp_Object file1
, file2
;
3028 Lisp_Object absname1
, absname2
;
3031 Lisp_Object handler
;
3032 struct gcpro gcpro1
, gcpro2
;
3034 CHECK_STRING (file1
, 0);
3035 CHECK_STRING (file2
, 0);
3038 GCPRO2 (absname1
, file2
);
3039 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3040 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3043 /* If the file name has special constructs in it,
3044 call the corresponding file handler. */
3045 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3047 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3048 if (!NILP (handler
))
3049 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3051 GCPRO2 (absname1
, absname2
);
3052 absname1
= ENCODE_FILE (absname1
);
3053 absname2
= ENCODE_FILE (absname2
);
3056 if (stat (XSTRING (absname1
)->data
, &st
) < 0)
3059 mtime1
= st
.st_mtime
;
3061 if (stat (XSTRING (absname2
)->data
, &st
) < 0)
3064 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3068 Lisp_Object Qfind_buffer_file_type
;
3071 #ifndef READ_BUF_SIZE
3072 #define READ_BUF_SIZE (64 << 10)
3075 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3077 "Insert contents of file FILENAME after point.\n\
3078 Returns list of absolute file name and length of data inserted.\n\
3079 If second argument VISIT is non-nil, the buffer's visited filename\n\
3080 and last save file modtime are set, and it is marked unmodified.\n\
3081 If visiting and the file does not exist, visiting is completed\n\
3082 before the error is signaled.\n\
3083 The optional third and fourth arguments BEG and END\n\
3084 specify what portion of the file to insert.\n\
3085 If VISIT is non-nil, BEG and END must be nil.\n\
3087 If optional fifth argument REPLACE is non-nil,\n\
3088 it means replace the current buffer contents (in the accessible portion)\n\
3089 with the file contents. This is better than simply deleting and inserting\n\
3090 the whole thing because (1) it preserves some marker positions\n\
3091 and (2) it puts less data in the undo list.\n\
3092 When REPLACE is non-nil, the value is the number of characters actually read,\n\
3093 which is often less than the number of characters to be read.\n\
3094 This does code conversion according to the value of\n\
3095 `coding-system-for-read' or `file-coding-system-alist',\n\
3096 and sets the variable `last-coding-system-used' to the coding system\n\
3098 (filename
, visit
, beg
, end
, replace
)
3099 Lisp_Object filename
, visit
, beg
, end
, replace
;
3103 register int inserted
= 0;
3104 register int how_much
;
3105 register int unprocessed
;
3106 int count
= specpdl_ptr
- specpdl
;
3107 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3108 Lisp_Object handler
, val
, insval
, orig_filename
;
3111 int not_regular
= 0;
3112 char read_buf
[READ_BUF_SIZE
];
3113 struct coding_system coding
;
3114 unsigned char buffer
[1 << 14];
3115 int replace_handled
= 0;
3117 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3118 error ("Cannot do file visiting in an indirect buffer");
3120 if (!NILP (current_buffer
->read_only
))
3121 Fbarf_if_buffer_read_only ();
3125 orig_filename
= Qnil
;
3127 GCPRO4 (filename
, val
, p
, orig_filename
);
3129 CHECK_STRING (filename
, 0);
3130 filename
= Fexpand_file_name (filename
, Qnil
);
3132 /* If the file name has special constructs in it,
3133 call the corresponding file handler. */
3134 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3135 if (!NILP (handler
))
3137 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3138 visit
, beg
, end
, replace
);
3142 orig_filename
= filename
;
3143 filename
= ENCODE_FILE (filename
);
3148 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3150 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
3151 || fstat (fd
, &st
) < 0)
3152 #endif /* not APOLLO */
3154 if (fd
>= 0) close (fd
);
3157 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3160 if (!NILP (Vcoding_system_for_read
))
3161 current_buffer
->buffer_file_coding_system
= Vcoding_system_for_read
;
3166 /* This code will need to be changed in order to work on named
3167 pipes, and it's probably just not worth it. So we should at
3168 least signal an error. */
3169 if (!S_ISREG (st
.st_mode
))
3176 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3177 Fsignal (Qfile_error
,
3178 Fcons (build_string ("not a regular file"),
3179 Fcons (orig_filename
, Qnil
)));
3184 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
3187 /* Replacement should preserve point as it preserves markers. */
3188 if (!NILP (replace
))
3189 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3191 record_unwind_protect (close_file_unwind
, make_number (fd
));
3193 /* Supposedly happens on VMS. */
3194 if (! not_regular
&& st
.st_size
< 0)
3195 error ("File size is negative");
3197 if (!NILP (beg
) || !NILP (end
))
3199 error ("Attempt to visit less than an entire file");
3202 CHECK_NUMBER (beg
, 0);
3204 XSETFASTINT (beg
, 0);
3207 CHECK_NUMBER (end
, 0);
3212 XSETINT (end
, st
.st_size
);
3213 if (XINT (end
) != st
.st_size
)
3214 error ("Maximum buffer size exceeded");
3218 /* Decide the coding-system of the file. */
3220 Lisp_Object val
= Qnil
;
3222 if (!NILP (Vcoding_system_for_read
))
3223 val
= Vcoding_system_for_read
;
3224 else if (NILP (current_buffer
->enable_multibyte_characters
))
3228 if (! NILP (Vset_auto_coding_function
))
3230 /* Find a coding system specified in the heading two lines
3231 or in the tailing several lines of the file. We assume
3232 that the 1K-byte and 3K-byte for heading and tailing
3233 respectively are sufficient fot this purpose. */
3234 int how_many
, nread
;
3236 if (st
.st_size
<= (1024 * 4))
3237 nread
= read (fd
, read_buf
, 1024 * 4);
3240 nread
= read (fd
, read_buf
, 1024);
3243 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3244 report_file_error ("Setting file position",
3245 Fcons (orig_filename
, Qnil
));
3246 nread
+= read (fd
, read_buf
+ nread
, 1024 * 3);
3251 error ("IO error reading %s: %s",
3252 XSTRING (orig_filename
)->data
, strerror (errno
));
3255 val
= call1 (Vset_auto_coding_function
,
3256 make_string (read_buf
, nread
));
3257 /* Rewind the file for the actual read done later. */
3258 if (lseek (fd
, 0, 0) < 0)
3259 report_file_error ("Setting file position",
3260 Fcons (orig_filename
, Qnil
));
3265 Lisp_Object args
[6], coding_systems
;
3267 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
,
3268 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3269 coding_systems
= Ffind_operation_coding_system (6, args
);
3270 if (CONSP (coding_systems
)) val
= XCONS (coding_systems
)->car
;
3273 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3276 /* If requested, replace the accessible part of the buffer
3277 with the file contents. Avoid replacing text at the
3278 beginning or end of the buffer that matches the file contents;
3279 that preserves markers pointing to the unchanged parts.
3281 Here we implement this feature in an optimized way
3282 for the case where code conversion is NOT needed.
3283 The following if-statement handles the case of conversion
3284 in a less optimal way.
3286 If the code conversion is "automatic" then we try using this
3287 method and hope for the best.
3288 But if we discover the need for conversion, we give up on this method
3289 and let the following if-statement handle the replace job. */
3291 && ! CODING_REQUIRE_DECODING (&coding
))
3293 int same_at_start
= BEGV
;
3294 int same_at_end
= ZV
;
3296 /* There is still a possibility we will find the need to do code
3297 conversion. If that happens, we set this variable to 1 to
3298 give up on handling REPLACE in the optimized way. */
3299 int giveup_match_end
= 0;
3301 if (XINT (beg
) != 0)
3303 if (lseek (fd
, XINT (beg
), 0) < 0)
3304 report_file_error ("Setting file position",
3305 Fcons (orig_filename
, Qnil
));
3310 /* Count how many chars at the start of the file
3311 match the text at the beginning of the buffer. */
3316 nread
= read (fd
, buffer
, sizeof buffer
);
3318 error ("IO error reading %s: %s",
3319 XSTRING (orig_filename
)->data
, strerror (errno
));
3320 else if (nread
== 0)
3323 if (coding
.type
== coding_type_undecided
)
3324 detect_coding (&coding
, buffer
, nread
);
3325 if (CODING_REQUIRE_DECODING (&coding
))
3326 /* We found that the file should be decoded somehow.
3327 Let's give up here. */
3329 giveup_match_end
= 1;
3333 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3334 detect_eol (&coding
, buffer
, nread
);
3335 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3336 && coding
.eol_type
!= CODING_EOL_LF
)
3337 /* We found that the format of eol should be decoded.
3338 Let's give up here. */
3340 giveup_match_end
= 1;
3345 while (bufpos
< nread
&& same_at_start
< ZV
3346 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3347 same_at_start
++, bufpos
++;
3348 /* If we found a discrepancy, stop the scan.
3349 Otherwise loop around and scan the next bufferful. */
3350 if (bufpos
!= nread
)
3354 /* If the file matches the buffer completely,
3355 there's no need to replace anything. */
3356 if (same_at_start
- BEGV
== XINT (end
))
3360 /* Truncate the buffer to the size of the file. */
3361 del_range_1 (same_at_start
, same_at_end
, 0);
3366 /* Count how many chars at the end of the file
3367 match the text at the end of the buffer. But, if we have
3368 already found that decoding is necessary, don't waste time. */
3369 while (!giveup_match_end
)
3371 int total_read
, nread
, bufpos
, curpos
, trial
;
3373 /* At what file position are we now scanning? */
3374 curpos
= XINT (end
) - (ZV
- same_at_end
);
3375 /* If the entire file matches the buffer tail, stop the scan. */
3378 /* How much can we scan in the next step? */
3379 trial
= min (curpos
, sizeof buffer
);
3380 if (lseek (fd
, curpos
- trial
, 0) < 0)
3381 report_file_error ("Setting file position",
3382 Fcons (orig_filename
, Qnil
));
3385 while (total_read
< trial
)
3387 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
3389 error ("IO error reading %s: %s",
3390 XSTRING (orig_filename
)->data
, strerror (errno
));
3391 total_read
+= nread
;
3393 /* Scan this bufferful from the end, comparing with
3394 the Emacs buffer. */
3395 bufpos
= total_read
;
3396 /* Compare with same_at_start to avoid counting some buffer text
3397 as matching both at the file's beginning and at the end. */
3398 while (bufpos
> 0 && same_at_end
> same_at_start
3399 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3400 same_at_end
--, bufpos
--;
3402 /* If we found a discrepancy, stop the scan.
3403 Otherwise loop around and scan the preceding bufferful. */
3406 /* If this discrepancy is because of code conversion,
3407 we cannot use this method; giveup and try the other. */
3408 if (same_at_end
> same_at_start
3409 && FETCH_BYTE (same_at_end
- 1) >= 0200
3410 && ! NILP (current_buffer
->enable_multibyte_characters
)
3411 && (CODING_REQUIRE_DECODING (&coding
)
3412 || CODING_REQUIRE_DETECTION (&coding
)))
3413 giveup_match_end
= 1;
3419 if (! giveup_match_end
)
3421 /* We win! We can handle REPLACE the optimized way. */
3423 /* Extends the end of non-matching text area to multibyte
3424 character boundary. */
3425 if (! NILP (current_buffer
->enable_multibyte_characters
))
3426 while (same_at_end
< ZV
&& ! CHAR_HEAD_P (POS_ADDR (same_at_end
)))
3429 /* Don't try to reuse the same piece of text twice. */
3430 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
3432 same_at_end
+= overlap
;
3434 /* Arrange to read only the nonmatching middle part of the file. */
3435 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV
));
3436 XSETFASTINT (end
, XINT (end
) - (ZV
- same_at_end
));
3438 del_range_1 (same_at_start
, same_at_end
, 0);
3439 /* Insert from the file at the proper position. */
3440 SET_PT (same_at_start
);
3442 /* If display currently starts at beginning of line,
3443 keep it that way. */
3444 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3445 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3447 replace_handled
= 1;
3451 /* If requested, replace the accessible part of the buffer
3452 with the file contents. Avoid replacing text at the
3453 beginning or end of the buffer that matches the file contents;
3454 that preserves markers pointing to the unchanged parts.
3456 Here we implement this feature for the case where code conversion
3457 is needed, in a simple way that needs a lot of memory.
3458 The preceding if-statement handles the case of no conversion
3459 in a more optimized way. */
3460 if (!NILP (replace
) && ! replace_handled
)
3462 int same_at_start
= BEGV
;
3463 int same_at_end
= ZV
;
3466 /* Make sure that the gap is large enough. */
3467 int bufsize
= 2 * st
.st_size
;
3468 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
3470 /* First read the whole file, performing code conversion into
3471 CONVERSION_BUFFER. */
3473 if (lseek (fd
, XINT (beg
), 0) < 0)
3475 free (conversion_buffer
);
3476 report_file_error ("Setting file position",
3477 Fcons (orig_filename
, Qnil
));
3480 total
= st
.st_size
; /* Total bytes in the file. */
3481 how_much
= 0; /* Bytes read from file so far. */
3482 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3483 unprocessed
= 0; /* Bytes not processed in previous loop. */
3485 while (how_much
< total
)
3487 /* try is reserved in some compilers (Microsoft C) */
3488 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3489 char *destination
= read_buf
+ unprocessed
;
3492 /* Allow quitting out of the actual I/O. */
3495 this = read (fd
, destination
, trytry
);
3498 if (this < 0 || this + unprocessed
== 0)
3506 if (CODING_REQUIRE_DECODING (&coding
)
3507 || CODING_REQUIRE_DETECTION (&coding
))
3509 int require
, produced
, consumed
;
3511 this += unprocessed
;
3513 /* If we are using more space than estimated,
3514 make CONVERSION_BUFFER bigger. */
3515 require
= decoding_buffer_size (&coding
, this);
3516 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
3518 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
3519 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
3522 /* Convert this batch with results in CONVERSION_BUFFER. */
3523 if (how_much
>= total
) /* This is the last block. */
3524 coding
.last_block
= 1;
3525 produced
= decode_coding (&coding
, read_buf
,
3526 conversion_buffer
+ inserted
,
3527 this, bufsize
- inserted
,
3530 /* Save for next iteration whatever we didn't convert. */
3531 unprocessed
= this - consumed
;
3532 bcopy (read_buf
+ consumed
, read_buf
, unprocessed
);
3539 /* At this point, INSERTED is how many characters
3540 are present in CONVERSION_BUFFER.
3541 HOW_MUCH should equal TOTAL,
3542 or should be <= 0 if we couldn't read the file. */
3546 free (conversion_buffer
);
3549 error ("IO error reading %s: %s",
3550 XSTRING (orig_filename
)->data
, strerror (errno
));
3551 else if (how_much
== -2)
3552 error ("maximum buffer size exceeded");
3555 /* Compare the beginning of the converted file
3556 with the buffer text. */
3559 while (bufpos
< inserted
&& same_at_start
< same_at_end
3560 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
3561 same_at_start
++, bufpos
++;
3563 /* If the file matches the buffer completely,
3564 there's no need to replace anything. */
3566 if (bufpos
== inserted
)
3568 free (conversion_buffer
);
3571 /* Truncate the buffer to the size of the file. */
3572 del_range_1 (same_at_start
, same_at_end
, 0);
3576 /* Scan this bufferful from the end, comparing with
3577 the Emacs buffer. */
3580 /* Compare with same_at_start to avoid counting some buffer text
3581 as matching both at the file's beginning and at the end. */
3582 while (bufpos
> 0 && same_at_end
> same_at_start
3583 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
3584 same_at_end
--, bufpos
--;
3586 /* Don't try to reuse the same piece of text twice. */
3587 overlap
= same_at_start
- BEGV
- (same_at_end
+ inserted
- ZV
);
3589 same_at_end
+= overlap
;
3591 /* If display currently starts at beginning of line,
3592 keep it that way. */
3593 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3594 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3596 /* Replace the chars that we need to replace,
3597 and update INSERTED to equal the number of bytes
3598 we are taking from the file. */
3599 inserted
-= (Z
- same_at_end
) + (same_at_start
- BEG
);
3600 move_gap (same_at_start
);
3601 del_range_1 (same_at_start
, same_at_end
, 0);
3602 SET_PT (same_at_start
);
3603 insert_1 (conversion_buffer
+ same_at_start
- BEG
, inserted
, 0, 0);
3605 free (conversion_buffer
);
3614 register Lisp_Object temp
;
3616 total
= XINT (end
) - XINT (beg
);
3618 /* Make sure point-max won't overflow after this insertion. */
3619 XSETINT (temp
, total
);
3620 if (total
!= XINT (temp
))
3621 error ("Maximum buffer size exceeded");
3624 /* For a special file, all we can do is guess. */
3625 total
= READ_BUF_SIZE
;
3627 if (NILP (visit
) && total
> 0)
3628 prepare_to_modify_buffer (PT
, PT
, NULL
);
3631 if (GAP_SIZE
< total
)
3632 make_gap (total
- GAP_SIZE
);
3634 if (XINT (beg
) != 0 || !NILP (replace
))
3636 if (lseek (fd
, XINT (beg
), 0) < 0)
3637 report_file_error ("Setting file position",
3638 Fcons (orig_filename
, Qnil
));
3641 /* In the following loop, HOW_MUCH contains the total bytes read so
3642 far. Before exiting the loop, it is set to -1 if I/O error
3643 occurs, set to -2 if the maximum buffer size is exceeded. */
3645 /* Total bytes inserted. */
3647 /* Bytes not processed in the previous loop because short gap size. */
3649 while (how_much
< total
)
3651 /* try is reserved in some compilers (Microsoft C) */
3652 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3653 char *destination
= (! (CODING_REQUIRE_DECODING (&coding
)
3654 || CODING_REQUIRE_DETECTION (&coding
))
3655 ? (char *) (POS_ADDR (PT
+ inserted
- 1) + 1)
3656 : read_buf
+ unprocessed
);
3659 /* Allow quitting out of the actual I/O. */
3662 this = read (fd
, destination
, trytry
);
3665 if (this < 0 || this + unprocessed
== 0)
3671 /* For a regular file, where TOTAL is the real size,
3672 count HOW_MUCH to compare with it.
3673 For a special file, where TOTAL is just a buffer size,
3674 so don't bother counting in HOW_MUCH.
3675 (INSERTED is where we count the number of characters inserted.) */
3679 if (CODING_REQUIRE_DECODING (&coding
)
3680 || CODING_REQUIRE_DETECTION (&coding
))
3682 int require
, produced
, consumed
;
3684 this += unprocessed
;
3685 /* Make sure that the gap is large enough. */
3686 require
= decoding_buffer_size (&coding
, this);
3687 if (GAP_SIZE
< require
)
3688 make_gap (require
- GAP_SIZE
);
3692 if (how_much
>= total
) /* This is the last block. */
3693 coding
.last_block
= 1;
3697 /* If we encounter EOF, say it is the last block. (The
3698 data this will apply to is the UNPROCESSED characters
3699 carried over from the last batch.) */
3701 coding
.last_block
= 1;
3704 produced
= decode_coding (&coding
, read_buf
,
3705 POS_ADDR (PT
+ inserted
- 1) + 1,
3706 this, GAP_SIZE
, &consumed
);
3711 XSET (temp
, Lisp_Int
, Z
+ produced
);
3712 if (Z
+ produced
!= XINT (temp
))
3718 unprocessed
= this - consumed
;
3719 bcopy (read_buf
+ consumed
, read_buf
, unprocessed
);
3728 /* Put an anchor to ensure multi-byte form ends at gap. */
3735 /* Use the conversion type to determine buffer-file-type
3736 (find-buffer-file-type is now used to help determine the
3738 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3739 && coding
.eol_type
!= CODING_EOL_LF
)
3740 current_buffer
->buffer_file_type
= Qnil
;
3742 current_buffer
->buffer_file_type
= Qt
;
3745 /* We don't have to consider file type of MSDOS because all files
3746 are read as binary and end-of-line format has already been
3747 decoded appropriately. */
3750 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
3751 /* Determine file type from name and remove LFs from CR-LFs if the file
3752 is deemed to be a text file. */
3754 current_buffer
->buffer_file_type
3755 = call1 (Qfind_buffer_file_type
, orig_filename
);
3756 if (NILP (current_buffer
->buffer_file_type
))
3759 = inserted
- crlf_to_lf (inserted
, POS_ADDR (PT
- 1) + 1);
3762 GPT
-= reduced_size
;
3763 GAP_SIZE
+= reduced_size
;
3764 inserted
-= reduced_size
;
3772 record_insert (PT
, inserted
);
3774 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
3775 offset_intervals (current_buffer
, PT
, inserted
);
3781 /* Discard the unwind protect for closing the file. */
3785 error ("IO error reading %s: %s",
3786 XSTRING (orig_filename
)->data
, strerror (errno
));
3787 else if (how_much
== -2)
3788 error ("maximum buffer size exceeded");
3795 if (!EQ (current_buffer
->undo_list
, Qt
))
3796 current_buffer
->undo_list
= Qnil
;
3798 stat (XSTRING (filename
)->data
, &st
);
3803 current_buffer
->modtime
= st
.st_mtime
;
3804 current_buffer
->filename
= orig_filename
;
3807 SAVE_MODIFF
= MODIFF
;
3808 current_buffer
->auto_save_modified
= MODIFF
;
3809 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3810 #ifdef CLASH_DETECTION
3813 if (!NILP (current_buffer
->file_truename
))
3814 unlock_file (current_buffer
->file_truename
);
3815 unlock_file (filename
);
3817 #endif /* CLASH_DETECTION */
3819 Fsignal (Qfile_error
,
3820 Fcons (build_string ("not a regular file"),
3821 Fcons (orig_filename
, Qnil
)));
3823 /* If visiting nonexistent file, return nil. */
3824 if (current_buffer
->modtime
== -1)
3825 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3828 /* Decode file format */
3831 insval
= call3 (Qformat_decode
,
3832 Qnil
, make_number (inserted
), visit
);
3833 CHECK_NUMBER (insval
, 0);
3834 inserted
= XFASTINT (insval
);
3837 /* Call after-change hooks for the inserted text, aside from the case
3838 of normal visiting (not with REPLACE), which is done in a new buffer
3839 "before" the buffer is changed. */
3840 if (inserted
> 0 && total
> 0
3841 && (NILP (visit
) || !NILP (replace
)))
3842 signal_after_change (PT
, 0, inserted
);
3846 p
= Vafter_insert_file_functions
;
3847 if (!NILP (coding
.post_read_conversion
))
3848 p
= Fcons (coding
.post_read_conversion
, p
);
3852 insval
= call1 (Fcar (p
), make_number (inserted
));
3855 CHECK_NUMBER (insval
, 0);
3856 inserted
= XFASTINT (insval
);
3864 val
= Fcons (orig_filename
,
3865 Fcons (make_number (inserted
),
3868 RETURN_UNGCPRO (unbind_to (count
, val
));
3871 static Lisp_Object
build_annotations ();
3872 extern Lisp_Object
Ffile_locked_p ();
3874 /* If build_annotations switched buffers, switch back to BUF.
3875 Kill the temporary buffer that was selected in the meantime.
3877 Since this kill only the last temporary buffer, some buffers remain
3878 not killed if build_annotations switched buffers more than once.
3882 build_annotations_unwind (buf
)
3887 if (XBUFFER (buf
) == current_buffer
)
3889 tembuf
= Fcurrent_buffer ();
3891 Fkill_buffer (tembuf
);
3895 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 6,
3896 "r\nFWrite region to file: ",
3897 "Write current region into specified file.\n\
3898 When called from a program, takes three arguments:\n\
3899 START, END and FILENAME. START and END are buffer positions.\n\
3900 Optional fourth argument APPEND if non-nil means\n\
3901 append to existing file contents (if any).\n\
3902 Optional fifth argument VISIT if t means\n\
3903 set the last-save-file-modtime of buffer to this file's modtime\n\
3904 and mark buffer not modified.\n\
3905 If VISIT is a string, it is a second file name;\n\
3906 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
3907 VISIT is also the file name to lock and unlock for clash detection.\n\
3908 If VISIT is neither t nor nil nor a string,\n\
3909 that means do not print the \"Wrote file\" message.\n\
3910 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
3911 use for locking and unlocking, overriding FILENAME and VISIT.\n\
3912 Kludgy feature: if START is a string, then that string is written\n\
3913 to the file, instead of any buffer contents, and END is ignored.")
3914 (start
, end
, filename
, append
, visit
, lockname
)
3915 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
3923 int count
= specpdl_ptr
- specpdl
;
3926 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3928 Lisp_Object handler
;
3929 Lisp_Object visit_file
;
3930 Lisp_Object annotations
;
3931 Lisp_Object encoded_filename
;
3932 int visiting
, quietly
;
3933 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3934 struct buffer
*given_buffer
;
3936 int buffer_file_type
= O_BINARY
;
3938 struct coding_system coding
;
3940 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3941 error ("Cannot do file visiting in an indirect buffer");
3943 if (!NILP (start
) && !STRINGP (start
))
3944 validate_region (&start
, &end
);
3946 GCPRO4 (start
, filename
, visit
, lockname
);
3948 /* Decide the coding-system to encode the data with. */
3954 else if (!NILP (Vcoding_system_for_write
))
3955 val
= Vcoding_system_for_write
;
3956 else if (NILP (current_buffer
->enable_multibyte_characters
))
3958 /* If the variable `buffer-file-coding-system' is set locally,
3959 it means that the file was read with some kind of code
3960 conversion or the varialbe is explicitely set by users. We
3961 had better write it out with the same coding system even if
3962 `enable-multibyte-characters' is nil.
3964 If is is not set locally, we anyway have to convert EOL
3965 format if the default value of `buffer-file-coding-system'
3966 tells that it is not Unix-like (LF only) format. */
3967 val
= current_buffer
->buffer_file_coding_system
;
3968 if (NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
3970 struct coding_system coding_temp
;
3972 setup_coding_system (Fcheck_coding_system (val
), &coding_temp
);
3973 if (coding_temp
.eol_type
== CODING_EOL_CRLF
3974 || coding_temp
.eol_type
== CODING_EOL_CR
)
3976 setup_coding_system (Qemacs_mule
, &coding
);
3977 coding
.eol_type
= coding_temp
.eol_type
;
3978 goto done_setup_coding
;
3985 Lisp_Object args
[7], coding_systems
;
3987 args
[0] = Qwrite_region
, args
[1] = start
, args
[2] = end
,
3988 args
[3] = filename
, args
[4] = append
, args
[5] = visit
,
3990 coding_systems
= Ffind_operation_coding_system (7, args
);
3991 val
= (CONSP (coding_systems
) && !NILP (XCONS (coding_systems
)->cdr
)
3992 ? XCONS (coding_systems
)->cdr
3993 : current_buffer
->buffer_file_coding_system
);
3995 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3998 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
3999 coding
.selective
= 1;
4002 filename
= Fexpand_file_name (filename
, Qnil
);
4003 if (STRINGP (visit
))
4004 visit_file
= Fexpand_file_name (visit
, Qnil
);
4006 visit_file
= filename
;
4009 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4010 quietly
= !NILP (visit
);
4014 if (NILP (lockname
))
4015 lockname
= visit_file
;
4017 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4019 /* If the file name has special constructs in it,
4020 call the corresponding file handler. */
4021 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4022 /* If FILENAME has no handler, see if VISIT has one. */
4023 if (NILP (handler
) && STRINGP (visit
))
4024 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4026 if (!NILP (handler
))
4029 val
= call6 (handler
, Qwrite_region
, start
, end
,
4030 filename
, append
, visit
);
4034 SAVE_MODIFF
= MODIFF
;
4035 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4036 current_buffer
->filename
= visit_file
;
4042 /* Special kludge to simplify auto-saving. */
4045 XSETFASTINT (start
, BEG
);
4046 XSETFASTINT (end
, Z
);
4049 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4050 count1
= specpdl_ptr
- specpdl
;
4052 given_buffer
= current_buffer
;
4053 annotations
= build_annotations (start
, end
, coding
.pre_write_conversion
);
4054 if (current_buffer
!= given_buffer
)
4056 XSETFASTINT (start
, BEGV
);
4057 XSETFASTINT (end
, ZV
);
4060 #ifdef CLASH_DETECTION
4063 #if 0 /* This causes trouble for GNUS. */
4064 /* If we've locked this file for some other buffer,
4065 query before proceeding. */
4066 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4067 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4070 lock_file (lockname
);
4072 #endif /* CLASH_DETECTION */
4074 encoded_filename
= ENCODE_FILE (filename
);
4076 fn
= XSTRING (encoded_filename
)->data
;
4080 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
4081 #else /* not DOS_NT */
4082 desc
= open (fn
, O_WRONLY
);
4083 #endif /* not DOS_NT */
4085 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4087 if (auto_saving
) /* Overwrite any previous version of autosave file */
4089 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4090 desc
= open (fn
, O_RDWR
);
4092 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4093 ? XSTRING (current_buffer
->filename
)->data
: 0,
4096 else /* Write to temporary name and rename if no errors */
4098 Lisp_Object temp_name
;
4099 temp_name
= Ffile_name_directory (filename
);
4101 if (!NILP (temp_name
))
4103 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4104 build_string ("$$SAVE$$")));
4105 fname
= XSTRING (filename
)->data
;
4106 fn
= XSTRING (temp_name
)->data
;
4107 desc
= creat_copy_attrs (fname
, fn
);
4110 /* If we can't open the temporary file, try creating a new
4111 version of the original file. VMS "creat" creates a
4112 new version rather than truncating an existing file. */
4115 desc
= creat (fn
, 0666);
4116 #if 0 /* This can clobber an existing file and fail to replace it,
4117 if the user runs out of space. */
4120 /* We can't make a new version;
4121 try to truncate and rewrite existing version if any. */
4123 desc
= open (fn
, O_RDWR
);
4129 desc
= creat (fn
, 0666);
4134 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
4135 S_IREAD
| S_IWRITE
);
4136 #else /* not DOS_NT */
4137 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
4138 #endif /* not DOS_NT */
4139 #endif /* not VMS */
4145 #ifdef CLASH_DETECTION
4147 if (!auto_saving
) unlock_file (lockname
);
4149 #endif /* CLASH_DETECTION */
4150 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4153 record_unwind_protect (close_file_unwind
, make_number (desc
));
4156 if (lseek (desc
, 0, 2) < 0)
4158 #ifdef CLASH_DETECTION
4159 if (!auto_saving
) unlock_file (lockname
);
4160 #endif /* CLASH_DETECTION */
4161 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4166 * Kludge Warning: The VMS C RTL likes to insert carriage returns
4167 * if we do writes that don't end with a carriage return. Furthermore
4168 * it cannot handle writes of more then 16K. The modified
4169 * version of "sys_write" in SYSDEP.C (see comment there) copes with
4170 * this EXCEPT for the last record (iff it doesn't end with a carriage
4171 * return). This implies that if your buffer doesn't end with a carriage
4172 * return, you get one free... tough. However it also means that if
4173 * we make two calls to sys_write (a la the following code) you can
4174 * get one at the gap as well. The easiest way to fix this (honest)
4175 * is to move the gap to the next newline (or the end of the buffer).
4180 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4181 move_gap (find_next_newline (GPT
, 1));
4183 /* Whether VMS or not, we must move the gap to the next of newline
4184 when we must put designation sequences at beginning of line. */
4185 if (INTEGERP (start
)
4186 && coding
.type
== coding_type_iso2022
4187 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
4188 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4189 move_gap (find_next_newline (GPT
, 1));
4195 if (STRINGP (start
))
4197 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
4198 XSTRING (start
)->size
, 0, &annotations
, &coding
);
4201 else if (XINT (start
) != XINT (end
))
4204 if (XINT (start
) < GPT
)
4206 register int end1
= XINT (end
);
4208 failure
= 0 > a_write (desc
, POS_ADDR (tem
),
4209 min (GPT
, end1
) - tem
, tem
, &annotations
,
4211 nwritten
+= min (GPT
, end1
) - tem
;
4215 if (XINT (end
) > GPT
&& !failure
)
4218 tem
= max (tem
, GPT
);
4219 failure
= 0 > a_write (desc
, POS_ADDR (tem
), XINT (end
) - tem
,
4220 tem
, &annotations
, &coding
);
4221 nwritten
+= XINT (end
) - tem
;
4227 /* If file was empty, still need to write the annotations */
4228 coding
.last_block
= 1;
4229 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
, &coding
);
4233 if (CODING_REQUIRE_FLUSHING (&coding
) && !coding
.last_block
)
4235 /* We have to flush out a data. */
4236 coding
.last_block
= 1;
4237 failure
= 0 > e_write (desc
, "", 0, &coding
);
4244 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4245 Disk full in NFS may be reported here. */
4246 /* mib says that closing the file will try to write as fast as NFS can do
4247 it, and that means the fsync here is not crucial for autosave files. */
4248 if (!auto_saving
&& fsync (desc
) < 0)
4250 /* If fsync fails with EINTR, don't treat that as serious. */
4252 failure
= 1, save_errno
= errno
;
4256 /* Spurious "file has changed on disk" warnings have been
4257 observed on Suns as well.
4258 It seems that `close' can change the modtime, under nfs.
4260 (This has supposedly been fixed in Sunos 4,
4261 but who knows about all the other machines with NFS?) */
4264 /* On VMS and APOLLO, must do the stat after the close
4265 since closing changes the modtime. */
4268 /* Recall that #if defined does not work on VMS. */
4275 /* NFS can report a write failure now. */
4276 if (close (desc
) < 0)
4277 failure
= 1, save_errno
= errno
;
4280 /* If we wrote to a temporary name and had no errors, rename to real name. */
4284 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
4292 /* Discard the unwind protect for close_file_unwind. */
4293 specpdl_ptr
= specpdl
+ count1
;
4294 /* Restore the original current buffer. */
4295 visit_file
= unbind_to (count
, visit_file
);
4297 #ifdef CLASH_DETECTION
4299 unlock_file (lockname
);
4300 #endif /* CLASH_DETECTION */
4302 /* Do this before reporting IO error
4303 to avoid a "file has changed on disk" warning on
4304 next attempt to save. */
4306 current_buffer
->modtime
= st
.st_mtime
;
4309 error ("IO error writing %s: %s", XSTRING (filename
)->data
,
4310 strerror (save_errno
));
4314 SAVE_MODIFF
= MODIFF
;
4315 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4316 current_buffer
->filename
= visit_file
;
4317 update_mode_lines
++;
4323 message ("Wrote %s", XSTRING (visit_file
)->data
);
4328 Lisp_Object
merge ();
4330 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4331 "Return t if (car A) is numerically less than (car B).")
4335 return Flss (Fcar (a
), Fcar (b
));
4338 /* Build the complete list of annotations appropriate for writing out
4339 the text between START and END, by calling all the functions in
4340 write-region-annotate-functions and merging the lists they return.
4341 If one of these functions switches to a different buffer, we assume
4342 that buffer contains altered text. Therefore, the caller must
4343 make sure to restore the current buffer in all cases,
4344 as save-excursion would do. */
4347 build_annotations (start
, end
, pre_write_conversion
)
4348 Lisp_Object start
, end
, pre_write_conversion
;
4350 Lisp_Object annotations
;
4352 struct gcpro gcpro1
, gcpro2
;
4353 Lisp_Object original_buffer
;
4355 XSETBUFFER (original_buffer
, current_buffer
);
4358 p
= Vwrite_region_annotate_functions
;
4359 GCPRO2 (annotations
, p
);
4362 struct buffer
*given_buffer
= current_buffer
;
4363 Vwrite_region_annotations_so_far
= annotations
;
4364 res
= call2 (Fcar (p
), start
, end
);
4365 /* If the function makes a different buffer current,
4366 assume that means this buffer contains altered text to be output.
4367 Reset START and END from the buffer bounds
4368 and discard all previous annotations because they should have
4369 been dealt with by this function. */
4370 if (current_buffer
!= given_buffer
)
4372 XSETFASTINT (start
, BEGV
);
4373 XSETFASTINT (end
, ZV
);
4376 Flength (res
); /* Check basic validity of return value */
4377 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4381 /* Now do the same for annotation functions implied by the file-format */
4382 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
4383 p
= Vauto_save_file_format
;
4385 p
= current_buffer
->file_format
;
4388 struct buffer
*given_buffer
= current_buffer
;
4389 Vwrite_region_annotations_so_far
= annotations
;
4390 res
= call4 (Qformat_annotate_function
, Fcar (p
), start
, end
,
4392 if (current_buffer
!= given_buffer
)
4394 XSETFASTINT (start
, BEGV
);
4395 XSETFASTINT (end
, ZV
);
4399 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4403 /* At last, do the same for the function PRE_WRITE_CONVERSION
4404 implied by the current coding-system. */
4405 if (!NILP (pre_write_conversion
))
4407 struct buffer
*given_buffer
= current_buffer
;
4408 Vwrite_region_annotations_so_far
= annotations
;
4409 res
= call2 (pre_write_conversion
, start
, end
);
4411 annotations
= (current_buffer
!= given_buffer
4413 : merge (annotations
, res
, Qcar_less_than_car
));
4420 /* Write to descriptor DESC the LEN characters starting at ADDR,
4421 assuming they start at position POS in the buffer.
4422 Intersperse with them the annotations from *ANNOT
4423 (those which fall within the range of positions POS to POS + LEN),
4424 each at its appropriate position.
4426 Modify *ANNOT by discarding elements as we output them.
4427 The return value is negative in case of system call failure. */
4430 a_write (desc
, addr
, len
, pos
, annot
, coding
)
4432 register char *addr
;
4436 struct coding_system
*coding
;
4440 int lastpos
= pos
+ len
;
4442 while (NILP (*annot
) || CONSP (*annot
))
4444 tem
= Fcar_safe (Fcar (*annot
));
4445 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
4446 nextpos
= XFASTINT (tem
);
4448 return e_write (desc
, addr
, lastpos
- pos
, coding
);
4451 if (0 > e_write (desc
, addr
, nextpos
- pos
, coding
))
4453 addr
+= nextpos
- pos
;
4456 tem
= Fcdr (Fcar (*annot
));
4459 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
,
4463 *annot
= Fcdr (*annot
);
4467 #ifndef WRITE_BUF_SIZE
4468 #define WRITE_BUF_SIZE (16 * 1024)
4472 e_write (desc
, addr
, len
, coding
)
4474 register char *addr
;
4476 struct coding_system
*coding
;
4478 char buf
[WRITE_BUF_SIZE
];
4479 int produced
, consumed
;
4481 /* We used to have a code for handling selective display here. But,
4482 now it is handled within encode_coding. */
4485 produced
= encode_coding (coding
, addr
, buf
, len
, WRITE_BUF_SIZE
,
4487 len
-= consumed
, addr
+= consumed
;
4490 produced
-= write (desc
, buf
, produced
);
4491 if (produced
) return -1;
4499 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
4500 Sverify_visited_file_modtime
, 1, 1, 0,
4501 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
4502 This means that the file has not been changed since it was visited or saved.")
4508 Lisp_Object handler
;
4509 Lisp_Object filename
;
4511 CHECK_BUFFER (buf
, 0);
4514 if (!STRINGP (b
->filename
)) return Qt
;
4515 if (b
->modtime
== 0) return Qt
;
4517 /* If the file name has special constructs in it,
4518 call the corresponding file handler. */
4519 handler
= Ffind_file_name_handler (b
->filename
,
4520 Qverify_visited_file_modtime
);
4521 if (!NILP (handler
))
4522 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
4524 filename
= ENCODE_FILE (b
->filename
);
4526 if (stat (XSTRING (filename
)->data
, &st
) < 0)
4528 /* If the file doesn't exist now and didn't exist before,
4529 we say that it isn't modified, provided the error is a tame one. */
4530 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
4535 if (st
.st_mtime
== b
->modtime
4536 /* If both are positive, accept them if they are off by one second. */
4537 || (st
.st_mtime
> 0 && b
->modtime
> 0
4538 && (st
.st_mtime
== b
->modtime
+ 1
4539 || st
.st_mtime
== b
->modtime
- 1)))
4544 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
4545 Sclear_visited_file_modtime
, 0, 0, 0,
4546 "Clear out records of last mod time of visited file.\n\
4547 Next attempt to save will certainly not complain of a discrepancy.")
4550 current_buffer
->modtime
= 0;
4554 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
4555 Svisited_file_modtime
, 0, 0, 0,
4556 "Return the current buffer's recorded visited file modification time.\n\
4557 The value is a list of the form (HIGH . LOW), like the time values\n\
4558 that `file-attributes' returns.")
4561 return long_to_cons ((unsigned long) current_buffer
->modtime
);
4564 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
4565 Sset_visited_file_modtime
, 0, 1, 0,
4566 "Update buffer's recorded modification time from the visited file's time.\n\
4567 Useful if the buffer was not read from the file normally\n\
4568 or if the file itself has been changed for some known benign reason.\n\
4569 An argument specifies the modification time value to use\n\
4570 \(instead of that of the visited file), in the form of a list\n\
4571 \(HIGH . LOW) or (HIGH LOW).")
4573 Lisp_Object time_list
;
4575 if (!NILP (time_list
))
4576 current_buffer
->modtime
= cons_to_long (time_list
);
4579 register Lisp_Object filename
;
4581 Lisp_Object handler
;
4583 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
4585 /* If the file name has special constructs in it,
4586 call the corresponding file handler. */
4587 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
4588 if (!NILP (handler
))
4589 /* The handler can find the file name the same way we did. */
4590 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
4592 filename
= ENCODE_FILE (filename
);
4594 if (stat (XSTRING (filename
)->data
, &st
) >= 0)
4595 current_buffer
->modtime
= st
.st_mtime
;
4605 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
4606 Fsleep_for (make_number (1), Qnil
);
4607 message ("Autosaving...error!for %s", XSTRING (current_buffer
->name
)->data
);
4608 Fsleep_for (make_number (1), Qnil
);
4609 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
4610 Fsleep_for (make_number (1), Qnil
);
4620 /* Get visited file's mode to become the auto save file's mode. */
4621 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
4622 /* But make sure we can overwrite it later! */
4623 auto_save_mode_bits
= st
.st_mode
| 0600;
4625 auto_save_mode_bits
= 0666;
4628 Fwrite_region (Qnil
, Qnil
,
4629 current_buffer
->auto_save_file_name
,
4630 Qnil
, Qlambda
, Qnil
);
4634 do_auto_save_unwind (stream
) /* used as unwind-protect function */
4639 fclose ((FILE *) (XFASTINT (XCONS (stream
)->car
) << 16
4640 | XFASTINT (XCONS (stream
)->cdr
)));
4645 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
4648 minibuffer_auto_raise
= XINT (value
);
4652 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
4653 "Auto-save all buffers that need it.\n\
4654 This is all buffers that have auto-saving enabled\n\
4655 and are changed since last auto-saved.\n\
4656 Auto-saving writes the buffer into a file\n\
4657 so that your editing is not lost if the system crashes.\n\
4658 This file is not the file you visited; that changes only when you save.\n\
4659 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
4660 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
4661 A non-nil CURRENT-ONLY argument means save only current buffer.")
4662 (no_message
, current_only
)
4663 Lisp_Object no_message
, current_only
;
4665 struct buffer
*old
= current_buffer
, *b
;
4666 Lisp_Object tail
, buf
;
4668 char *omessage
= echo_area_glyphs
;
4669 int omessage_length
= echo_area_glyphs_length
;
4670 int do_handled_files
;
4673 Lisp_Object lispstream
;
4674 int count
= specpdl_ptr
- specpdl
;
4676 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
4678 /* Ordinarily don't quit within this function,
4679 but don't make it impossible to quit (in case we get hung in I/O). */
4683 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
4684 point to non-strings reached from Vbuffer_alist. */
4689 if (!NILP (Vrun_hooks
))
4690 call1 (Vrun_hooks
, intern ("auto-save-hook"));
4692 if (STRINGP (Vauto_save_list_file_name
))
4694 Lisp_Object listfile
;
4695 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
4696 stream
= fopen (XSTRING (listfile
)->data
, "w");
4699 /* Arrange to close that file whether or not we get an error.
4700 Also reset auto_saving to 0. */
4701 lispstream
= Fcons (Qnil
, Qnil
);
4702 XSETFASTINT (XCONS (lispstream
)->car
, (EMACS_UINT
)stream
>> 16);
4703 XSETFASTINT (XCONS (lispstream
)->cdr
, (EMACS_UINT
)stream
& 0xffff);
4714 record_unwind_protect (do_auto_save_unwind
, lispstream
);
4715 record_unwind_protect (do_auto_save_unwind_1
,
4716 make_number (minibuffer_auto_raise
));
4717 minibuffer_auto_raise
= 0;
4720 /* First, save all files which don't have handlers. If Emacs is
4721 crashing, the handlers may tweak what is causing Emacs to crash
4722 in the first place, and it would be a shame if Emacs failed to
4723 autosave perfectly ordinary files because it couldn't handle some
4725 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
4726 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
4728 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
4731 /* Record all the buffers that have auto save mode
4732 in the special file that lists them. For each of these buffers,
4733 Record visited name (if any) and auto save name. */
4734 if (STRINGP (b
->auto_save_file_name
)
4735 && stream
!= NULL
&& do_handled_files
== 0)
4737 if (!NILP (b
->filename
))
4739 fwrite (XSTRING (b
->filename
)->data
, 1,
4740 XSTRING (b
->filename
)->size
, stream
);
4742 putc ('\n', stream
);
4743 fwrite (XSTRING (b
->auto_save_file_name
)->data
, 1,
4744 XSTRING (b
->auto_save_file_name
)->size
, stream
);
4745 putc ('\n', stream
);
4748 if (!NILP (current_only
)
4749 && b
!= current_buffer
)
4752 /* Don't auto-save indirect buffers.
4753 The base buffer takes care of it. */
4757 /* Check for auto save enabled
4758 and file changed since last auto save
4759 and file changed since last real save. */
4760 if (STRINGP (b
->auto_save_file_name
)
4761 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
4762 && b
->auto_save_modified
< BUF_MODIFF (b
)
4763 /* -1 means we've turned off autosaving for a while--see below. */
4764 && XINT (b
->save_length
) >= 0
4765 && (do_handled_files
4766 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
4769 EMACS_TIME before_time
, after_time
;
4771 EMACS_GET_TIME (before_time
);
4773 /* If we had a failure, don't try again for 20 minutes. */
4774 if (b
->auto_save_failure_time
>= 0
4775 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
4778 if ((XFASTINT (b
->save_length
) * 10
4779 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
4780 /* A short file is likely to change a large fraction;
4781 spare the user annoying messages. */
4782 && XFASTINT (b
->save_length
) > 5000
4783 /* These messages are frequent and annoying for `*mail*'. */
4784 && !EQ (b
->filename
, Qnil
)
4785 && NILP (no_message
))
4787 /* It has shrunk too much; turn off auto-saving here. */
4788 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
4789 message ("Buffer %s has shrunk a lot; auto save turned off there",
4790 XSTRING (b
->name
)->data
);
4791 minibuffer_auto_raise
= 0;
4792 /* Turn off auto-saving until there's a real save,
4793 and prevent any more warnings. */
4794 XSETINT (b
->save_length
, -1);
4795 Fsleep_for (make_number (1), Qnil
);
4798 set_buffer_internal (b
);
4799 if (!auto_saved
&& NILP (no_message
))
4800 message1 ("Auto-saving...");
4801 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
4803 b
->auto_save_modified
= BUF_MODIFF (b
);
4804 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4805 set_buffer_internal (old
);
4807 EMACS_GET_TIME (after_time
);
4809 /* If auto-save took more than 60 seconds,
4810 assume it was an NFS failure that got a timeout. */
4811 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
4812 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
4816 /* Prevent another auto save till enough input events come in. */
4817 record_auto_save ();
4819 if (auto_saved
&& NILP (no_message
))
4823 sit_for (1, 0, 0, 0, 0);
4824 message2 (omessage
, omessage_length
);
4827 message1 ("Auto-saving...done");
4832 unbind_to (count
, Qnil
);
4836 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
4837 Sset_buffer_auto_saved
, 0, 0, 0,
4838 "Mark current buffer as auto-saved with its current text.\n\
4839 No auto-save file will be written until the buffer changes again.")
4842 current_buffer
->auto_save_modified
= MODIFF
;
4843 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4844 current_buffer
->auto_save_failure_time
= -1;
4848 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
4849 Sclear_buffer_auto_save_failure
, 0, 0, 0,
4850 "Clear any record of a recent auto-save failure in the current buffer.")
4853 current_buffer
->auto_save_failure_time
= -1;
4857 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
4859 "Return t if buffer has been auto-saved since last read in or saved.")
4862 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
4865 /* Reading and completing file names */
4866 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
4868 /* In the string VAL, change each $ to $$ and return the result. */
4871 double_dollars (val
)
4874 register unsigned char *old
, *new;
4878 osize
= XSTRING (val
)->size
;
4879 /* Quote "$" as "$$" to get it past substitute-in-file-name */
4880 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
4881 if (*old
++ == '$') count
++;
4884 old
= XSTRING (val
)->data
;
4885 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
4886 new = XSTRING (val
)->data
;
4887 for (n
= osize
; n
> 0; n
--)
4900 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
4902 "Internal subroutine for read-file-name. Do not call this.")
4903 (string
, dir
, action
)
4904 Lisp_Object string
, dir
, action
;
4905 /* action is nil for complete, t for return list of completions,
4906 lambda for verify final value */
4908 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
4910 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4912 CHECK_STRING (string
, 0);
4919 /* No need to protect ACTION--we only compare it with t and nil. */
4920 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
4922 if (XSTRING (string
)->size
== 0)
4924 if (EQ (action
, Qlambda
))
4932 orig_string
= string
;
4933 string
= Fsubstitute_in_file_name (string
);
4934 changed
= NILP (Fstring_equal (string
, orig_string
));
4935 name
= Ffile_name_nondirectory (string
);
4936 val
= Ffile_name_directory (string
);
4938 realdir
= Fexpand_file_name (val
, realdir
);
4943 specdir
= Ffile_name_directory (string
);
4944 val
= Ffile_name_completion (name
, realdir
);
4949 return double_dollars (string
);
4953 if (!NILP (specdir
))
4954 val
= concat2 (specdir
, val
);
4956 return double_dollars (val
);
4959 #endif /* not VMS */
4963 if (EQ (action
, Qt
))
4964 return Ffile_name_all_completions (name
, realdir
);
4965 /* Only other case actually used is ACTION = lambda */
4967 /* Supposedly this helps commands such as `cd' that read directory names,
4968 but can someone explain how it helps them? -- RMS */
4969 if (XSTRING (name
)->size
== 0)
4972 return Ffile_exists_p (string
);
4975 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4976 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
4977 Value is not expanded---you must call `expand-file-name' yourself.\n\
4978 Default name to DEFAULT-FILENAME if user enters a null string.\n\
4979 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
4980 except that if INITIAL is specified, that combined with DIR is used.)\n\
4981 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
4982 Non-nil and non-t means also require confirmation after completion.\n\
4983 Fifth arg INITIAL specifies text to start with.\n\
4984 DIR defaults to current buffer's directory default.")
4985 (prompt
, dir
, default_filename
, mustmatch
, initial
)
4986 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
4988 Lisp_Object val
, insdef
, insdef1
, tem
;
4989 struct gcpro gcpro1
, gcpro2
;
4990 register char *homedir
;
4994 dir
= current_buffer
->directory
;
4995 if (NILP (default_filename
))
4997 if (! NILP (initial
))
4998 default_filename
= Fexpand_file_name (initial
, dir
);
5000 default_filename
= current_buffer
->filename
;
5003 /* If dir starts with user's homedir, change that to ~. */
5004 homedir
= (char *) egetenv ("HOME");
5006 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
5007 CORRECT_DIR_SEPS (homedir
);
5011 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
5012 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
5014 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
5015 XSTRING (dir
)->size
- strlen (homedir
) + 1);
5016 XSTRING (dir
)->data
[0] = '~';
5019 if (insert_default_directory
&& STRINGP (dir
))
5022 if (!NILP (initial
))
5024 Lisp_Object args
[2], pos
;
5028 insdef
= Fconcat (2, args
);
5029 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
5030 insdef1
= Fcons (double_dollars (insdef
), pos
);
5033 insdef1
= double_dollars (insdef
);
5035 else if (STRINGP (initial
))
5038 insdef1
= Fcons (double_dollars (insdef
), make_number (0));
5041 insdef
= Qnil
, insdef1
= Qnil
;
5044 count
= specpdl_ptr
- specpdl
;
5045 specbind (intern ("completion-ignore-case"), Qt
);
5048 GCPRO2 (insdef
, default_filename
);
5049 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
5050 dir
, mustmatch
, insdef1
,
5051 Qfile_name_history
, default_filename
, Qnil
);
5052 /* If Fcompleting_read returned the default string itself
5053 (rather than a new string with the same contents),
5054 it has to mean that the user typed RET with the minibuffer empty.
5055 In that case, we really want to return ""
5056 so that commands such as set-visited-file-name can distinguish. */
5057 if (EQ (val
, default_filename
))
5058 val
= build_string ("");
5061 unbind_to (count
, Qnil
);
5066 error ("No file name specified");
5067 tem
= Fstring_equal (val
, insdef
);
5068 if (!NILP (tem
) && !NILP (default_filename
))
5069 return default_filename
;
5070 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
5072 if (!NILP (default_filename
))
5073 return default_filename
;
5075 error ("No default file name");
5077 return Fsubstitute_in_file_name (val
);
5080 #if 0 /* Old version */
5081 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
5082 /* Don't confuse make-docfile by having two doc strings for this function.
5083 make-docfile does not pay attention to #if, for good reason! */
5085 (prompt
, dir
, defalt
, mustmatch
, initial
)
5086 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
5088 Lisp_Object val
, insdef
, tem
;
5089 struct gcpro gcpro1
, gcpro2
;
5090 register char *homedir
;
5094 dir
= current_buffer
->directory
;
5096 defalt
= current_buffer
->filename
;
5098 /* If dir starts with user's homedir, change that to ~. */
5099 homedir
= (char *) egetenv ("HOME");
5102 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
5103 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
5105 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
5106 XSTRING (dir
)->size
- strlen (homedir
) + 1);
5107 XSTRING (dir
)->data
[0] = '~';
5110 if (!NILP (initial
))
5112 else if (insert_default_directory
)
5115 insdef
= build_string ("");
5118 count
= specpdl_ptr
- specpdl
;
5119 specbind (intern ("completion-ignore-case"), Qt
);
5122 GCPRO2 (insdef
, defalt
);
5123 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
5125 insert_default_directory
? insdef
: Qnil
,
5126 Qfile_name_history
, Qnil
, Qnil
);
5129 unbind_to (count
, Qnil
);
5134 error ("No file name specified");
5135 tem
= Fstring_equal (val
, insdef
);
5136 if (!NILP (tem
) && !NILP (defalt
))
5138 return Fsubstitute_in_file_name (val
);
5140 #endif /* Old version */
5144 Qexpand_file_name
= intern ("expand-file-name");
5145 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
5146 Qdirectory_file_name
= intern ("directory-file-name");
5147 Qfile_name_directory
= intern ("file-name-directory");
5148 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
5149 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
5150 Qfile_name_as_directory
= intern ("file-name-as-directory");
5151 Qcopy_file
= intern ("copy-file");
5152 Qmake_directory_internal
= intern ("make-directory-internal");
5153 Qdelete_directory
= intern ("delete-directory");
5154 Qdelete_file
= intern ("delete-file");
5155 Qrename_file
= intern ("rename-file");
5156 Qadd_name_to_file
= intern ("add-name-to-file");
5157 Qmake_symbolic_link
= intern ("make-symbolic-link");
5158 Qfile_exists_p
= intern ("file-exists-p");
5159 Qfile_executable_p
= intern ("file-executable-p");
5160 Qfile_readable_p
= intern ("file-readable-p");
5161 Qfile_writable_p
= intern ("file-writable-p");
5162 Qfile_symlink_p
= intern ("file-symlink-p");
5163 Qaccess_file
= intern ("access-file");
5164 Qfile_directory_p
= intern ("file-directory-p");
5165 Qfile_regular_p
= intern ("file-regular-p");
5166 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
5167 Qfile_modes
= intern ("file-modes");
5168 Qset_file_modes
= intern ("set-file-modes");
5169 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
5170 Qinsert_file_contents
= intern ("insert-file-contents");
5171 Qwrite_region
= intern ("write-region");
5172 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
5173 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
5175 staticpro (&Qexpand_file_name
);
5176 staticpro (&Qsubstitute_in_file_name
);
5177 staticpro (&Qdirectory_file_name
);
5178 staticpro (&Qfile_name_directory
);
5179 staticpro (&Qfile_name_nondirectory
);
5180 staticpro (&Qunhandled_file_name_directory
);
5181 staticpro (&Qfile_name_as_directory
);
5182 staticpro (&Qcopy_file
);
5183 staticpro (&Qmake_directory_internal
);
5184 staticpro (&Qdelete_directory
);
5185 staticpro (&Qdelete_file
);
5186 staticpro (&Qrename_file
);
5187 staticpro (&Qadd_name_to_file
);
5188 staticpro (&Qmake_symbolic_link
);
5189 staticpro (&Qfile_exists_p
);
5190 staticpro (&Qfile_executable_p
);
5191 staticpro (&Qfile_readable_p
);
5192 staticpro (&Qfile_writable_p
);
5193 staticpro (&Qaccess_file
);
5194 staticpro (&Qfile_symlink_p
);
5195 staticpro (&Qfile_directory_p
);
5196 staticpro (&Qfile_regular_p
);
5197 staticpro (&Qfile_accessible_directory_p
);
5198 staticpro (&Qfile_modes
);
5199 staticpro (&Qset_file_modes
);
5200 staticpro (&Qfile_newer_than_file_p
);
5201 staticpro (&Qinsert_file_contents
);
5202 staticpro (&Qwrite_region
);
5203 staticpro (&Qverify_visited_file_modtime
);
5204 staticpro (&Qset_visited_file_modtime
);
5206 Qfile_name_history
= intern ("file-name-history");
5207 Fset (Qfile_name_history
, Qnil
);
5208 staticpro (&Qfile_name_history
);
5210 Qfile_error
= intern ("file-error");
5211 staticpro (&Qfile_error
);
5212 Qfile_already_exists
= intern ("file-already-exists");
5213 staticpro (&Qfile_already_exists
);
5214 Qfile_date_error
= intern ("file-date-error");
5215 staticpro (&Qfile_date_error
);
5218 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
5219 staticpro (&Qfind_buffer_file_type
);
5222 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
5223 "*Coding system for encoding file names.");
5224 Vfile_name_coding_system
= Qnil
;
5226 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
5227 "*Format in which to write auto-save files.\n\
5228 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
5229 If it is t, which is the default, auto-save files are written in the\n\
5230 same format as a regular save would use.");
5231 Vauto_save_file_format
= Qt
;
5233 Qformat_decode
= intern ("format-decode");
5234 staticpro (&Qformat_decode
);
5235 Qformat_annotate_function
= intern ("format-annotate-function");
5236 staticpro (&Qformat_annotate_function
);
5238 Qcar_less_than_car
= intern ("car-less-than-car");
5239 staticpro (&Qcar_less_than_car
);
5241 Fput (Qfile_error
, Qerror_conditions
,
5242 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
5243 Fput (Qfile_error
, Qerror_message
,
5244 build_string ("File error"));
5246 Fput (Qfile_already_exists
, Qerror_conditions
,
5247 Fcons (Qfile_already_exists
,
5248 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5249 Fput (Qfile_already_exists
, Qerror_message
,
5250 build_string ("File already exists"));
5252 Fput (Qfile_date_error
, Qerror_conditions
,
5253 Fcons (Qfile_date_error
,
5254 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5255 Fput (Qfile_date_error
, Qerror_message
,
5256 build_string ("Cannot set file date"));
5258 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
5259 "*Non-nil means when reading a filename start with default dir in minibuffer.");
5260 insert_default_directory
= 1;
5262 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
5263 "*Non-nil means write new files with record format `stmlf'.\n\
5264 nil means use format `var'. This variable is meaningful only on VMS.");
5265 vms_stmlf_recfm
= 0;
5267 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
5268 "Directory separator character for built-in functions that return file names.\n\
5269 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
5270 This variable affects the built-in functions only on Windows,\n\
5271 on other platforms, it is initialized so that Lisp code can find out\n\
5272 what the normal separator is.");
5273 XSETFASTINT (Vdirectory_sep_char
, '/');
5275 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5276 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
5277 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
5280 The first argument given to HANDLER is the name of the I/O primitive\n\
5281 to be handled; the remaining arguments are the arguments that were\n\
5282 passed to that primitive. For example, if you do\n\
5283 (file-exists-p FILENAME)\n\
5284 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
5285 (funcall HANDLER 'file-exists-p FILENAME)\n\
5286 The function `find-file-name-handler' checks this list for a handler\n\
5287 for its argument.");
5288 Vfile_name_handler_alist
= Qnil
;
5290 DEFVAR_LISP ("set-auto-coding-function",
5291 &Vset_auto_coding_function
,
5292 "If non-nil, a function to call to decide a coding system of file.\n\
5293 One argument is passed to this function: the string of concatination\n\
5294 or the heading 1K-byte and the tailing 3K-byte of a file to be read.\n\
5295 This function should return a coding system to decode the file contents\n\
5296 specified in the heading lines with the format:\n\
5297 -*- ... coding: CODING-SYSTEM; ... -*-\n\
5298 or local variable spec of the tailing lines with `coding:' tag.");
5299 Vset_auto_coding_function
= Qnil
;
5301 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5302 "A list of functions to be called at the end of `insert-file-contents'.\n\
5303 Each is passed one argument, the number of bytes inserted. It should return\n\
5304 the new byte count, and leave point the same. If `insert-file-contents' is\n\
5305 intercepted by a handler from `file-name-handler-alist', that handler is\n\
5306 responsible for calling the after-insert-file-functions if appropriate.");
5307 Vafter_insert_file_functions
= Qnil
;
5309 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5310 "A list of functions to be called at the start of `write-region'.\n\
5311 Each is passed two arguments, START and END as for `write-region'.\n\
5312 These are usually two numbers but not always; see the documentation\n\
5313 for `write-region'. The function should return a list of pairs\n\
5314 of the form (POSITION . STRING), consisting of strings to be effectively\n\
5315 inserted at the specified positions of the file being written (1 means to\n\
5316 insert before the first byte written). The POSITIONs must be sorted into\n\
5317 increasing order. If there are several functions in the list, the several\n\
5318 lists are merged destructively.");
5319 Vwrite_region_annotate_functions
= Qnil
;
5321 DEFVAR_LISP ("write-region-annotations-so-far",
5322 &Vwrite_region_annotations_so_far
,
5323 "When an annotation function is called, this holds the previous annotations.\n\
5324 These are the annotations made by other annotation functions\n\
5325 that were already called. See also `write-region-annotate-functions'.");
5326 Vwrite_region_annotations_so_far
= Qnil
;
5328 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5329 "A list of file name handlers that temporarily should not be used.\n\
5330 This applies only to the operation `inhibit-file-name-operation'.");
5331 Vinhibit_file_name_handlers
= Qnil
;
5333 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5334 "The operation for which `inhibit-file-name-handlers' is applicable.");
5335 Vinhibit_file_name_operation
= Qnil
;
5337 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5338 "File name in which we write a list of all auto save file names.\n\
5339 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
5340 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
5342 Vauto_save_list_file_name
= Qnil
;
5344 defsubr (&Sfind_file_name_handler
);
5345 defsubr (&Sfile_name_directory
);
5346 defsubr (&Sfile_name_nondirectory
);
5347 defsubr (&Sunhandled_file_name_directory
);
5348 defsubr (&Sfile_name_as_directory
);
5349 defsubr (&Sdirectory_file_name
);
5350 defsubr (&Smake_temp_name
);
5351 defsubr (&Sexpand_file_name
);
5352 defsubr (&Ssubstitute_in_file_name
);
5353 defsubr (&Scopy_file
);
5354 defsubr (&Smake_directory_internal
);
5355 defsubr (&Sdelete_directory
);
5356 defsubr (&Sdelete_file
);
5357 defsubr (&Srename_file
);
5358 defsubr (&Sadd_name_to_file
);
5360 defsubr (&Smake_symbolic_link
);
5361 #endif /* S_IFLNK */
5363 defsubr (&Sdefine_logical_name
);
5366 defsubr (&Ssysnetunam
);
5367 #endif /* HPUX_NET */
5368 defsubr (&Sfile_name_absolute_p
);
5369 defsubr (&Sfile_exists_p
);
5370 defsubr (&Sfile_executable_p
);
5371 defsubr (&Sfile_readable_p
);
5372 defsubr (&Sfile_writable_p
);
5373 defsubr (&Saccess_file
);
5374 defsubr (&Sfile_symlink_p
);
5375 defsubr (&Sfile_directory_p
);
5376 defsubr (&Sfile_accessible_directory_p
);
5377 defsubr (&Sfile_regular_p
);
5378 defsubr (&Sfile_modes
);
5379 defsubr (&Sset_file_modes
);
5380 defsubr (&Sset_default_file_modes
);
5381 defsubr (&Sdefault_file_modes
);
5382 defsubr (&Sfile_newer_than_file_p
);
5383 defsubr (&Sinsert_file_contents
);
5384 defsubr (&Swrite_region
);
5385 defsubr (&Scar_less_than_car
);
5386 defsubr (&Sverify_visited_file_modtime
);
5387 defsubr (&Sclear_visited_file_modtime
);
5388 defsubr (&Svisited_file_modtime
);
5389 defsubr (&Sset_visited_file_modtime
);
5390 defsubr (&Sdo_auto_save
);
5391 defsubr (&Sset_buffer_auto_saved
);
5392 defsubr (&Sclear_buffer_auto_save_failure
);
5393 defsubr (&Srecent_auto_save_p
);
5395 defsubr (&Sread_file_name_internal
);
5396 defsubr (&Sread_file_name
);
5399 defsubr (&Sunix_sync
);