1 /* File IO for GNU Emacs.
2 Copyright (C) 1985,86,87,88,93,94,95,96,97,1998 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 /* Nonzero during writing of auto-save files */
158 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
159 a new file with the same mode as the original */
160 int auto_save_mode_bits
;
162 /* Coding system for file names, or nil if none. */
163 Lisp_Object Vfile_name_coding_system
;
165 /* Coding system for file names used only when
166 Vfile_name_coding_system is nil. */
167 Lisp_Object Vdefault_file_name_coding_system
;
169 /* Alist of elements (REGEXP . HANDLER) for file names
170 whose I/O is done with a special handler. */
171 Lisp_Object Vfile_name_handler_alist
;
173 /* Format for auto-save files */
174 Lisp_Object Vauto_save_file_format
;
176 /* Lisp functions for translating file formats */
177 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
179 /* Function to be called to decide a coding system of a reading file. */
180 Lisp_Object Vset_auto_coding_function
;
182 /* Functions to be called to process text properties in inserted file. */
183 Lisp_Object Vafter_insert_file_functions
;
185 /* Functions to be called to create text property annotations for file. */
186 Lisp_Object Vwrite_region_annotate_functions
;
188 /* During build_annotations, each time an annotation function is called,
189 this holds the annotations made by the previous functions. */
190 Lisp_Object Vwrite_region_annotations_so_far
;
192 /* File name in which we write a list of all our auto save files. */
193 Lisp_Object Vauto_save_list_file_name
;
195 /* Nonzero means, when reading a filename in the minibuffer,
196 start out by inserting the default directory into the minibuffer. */
197 int insert_default_directory
;
199 /* On VMS, nonzero means write new files with record format stmlf.
200 Zero means use var format. */
203 /* On NT, specifies the directory separator character, used (eg.) when
204 expanding file names. This can be bound to / or \. */
205 Lisp_Object Vdirectory_sep_char
;
207 extern Lisp_Object Vuser_login_name
;
209 extern int minibuf_level
;
211 extern int minibuffer_auto_raise
;
213 /* These variables describe handlers that have "already" had a chance
214 to handle the current operation.
216 Vinhibit_file_name_handlers is a list of file name handlers.
217 Vinhibit_file_name_operation is the operation being handled.
218 If we try to handle that operation, we ignore those handlers. */
220 static Lisp_Object Vinhibit_file_name_handlers
;
221 static Lisp_Object Vinhibit_file_name_operation
;
223 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
225 Lisp_Object Qfile_name_history
;
227 Lisp_Object Qcar_less_than_car
;
229 static int a_write
P_ ((int, char *, int, int,
230 Lisp_Object
*, struct coding_system
*));
231 static int e_write
P_ ((int, char *, int, struct coding_system
*));
234 report_file_error (string
, data
)
238 Lisp_Object errstring
;
240 errstring
= build_string (strerror (errno
));
242 /* System error messages are capitalized. Downcase the initial
243 unless it is followed by a slash. */
244 if (XSTRING (errstring
)->data
[1] != '/')
245 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
248 Fsignal (Qfile_error
,
249 Fcons (build_string (string
), Fcons (errstring
, data
)));
253 close_file_unwind (fd
)
256 close (XFASTINT (fd
));
260 /* Restore point, having saved it as a marker. */
263 restore_point_unwind (location
)
264 Lisp_Object location
;
266 Fgoto_char (location
);
267 Fset_marker (location
, Qnil
, Qnil
);
271 Lisp_Object Qexpand_file_name
;
272 Lisp_Object Qsubstitute_in_file_name
;
273 Lisp_Object Qdirectory_file_name
;
274 Lisp_Object Qfile_name_directory
;
275 Lisp_Object Qfile_name_nondirectory
;
276 Lisp_Object Qunhandled_file_name_directory
;
277 Lisp_Object Qfile_name_as_directory
;
278 Lisp_Object Qcopy_file
;
279 Lisp_Object Qmake_directory_internal
;
280 Lisp_Object Qdelete_directory
;
281 Lisp_Object Qdelete_file
;
282 Lisp_Object Qrename_file
;
283 Lisp_Object Qadd_name_to_file
;
284 Lisp_Object Qmake_symbolic_link
;
285 Lisp_Object Qfile_exists_p
;
286 Lisp_Object Qfile_executable_p
;
287 Lisp_Object Qfile_readable_p
;
288 Lisp_Object Qfile_writable_p
;
289 Lisp_Object Qfile_symlink_p
;
290 Lisp_Object Qaccess_file
;
291 Lisp_Object Qfile_directory_p
;
292 Lisp_Object Qfile_regular_p
;
293 Lisp_Object Qfile_accessible_directory_p
;
294 Lisp_Object Qfile_modes
;
295 Lisp_Object Qset_file_modes
;
296 Lisp_Object Qfile_newer_than_file_p
;
297 Lisp_Object Qinsert_file_contents
;
298 Lisp_Object Qwrite_region
;
299 Lisp_Object Qverify_visited_file_modtime
;
300 Lisp_Object Qset_visited_file_modtime
;
302 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
303 "Return FILENAME's handler function for OPERATION, if it has one.\n\
304 Otherwise, return nil.\n\
305 A file name is handled if one of the regular expressions in\n\
306 `file-name-handler-alist' matches it.\n\n\
307 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
308 any handlers that are members of `inhibit-file-name-handlers',\n\
309 but we still do run any other handlers. This lets handlers\n\
310 use the standard functions without calling themselves recursively.")
311 (filename
, operation
)
312 Lisp_Object filename
, operation
;
314 /* This function must not munge the match data. */
315 Lisp_Object chain
, inhibited_handlers
;
317 CHECK_STRING (filename
, 0);
319 if (EQ (operation
, Vinhibit_file_name_operation
))
320 inhibited_handlers
= Vinhibit_file_name_handlers
;
322 inhibited_handlers
= Qnil
;
324 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
325 chain
= XCONS (chain
)->cdr
)
328 elt
= XCONS (chain
)->car
;
332 string
= XCONS (elt
)->car
;
333 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
335 Lisp_Object handler
, tem
;
337 handler
= XCONS (elt
)->cdr
;
338 tem
= Fmemq (handler
, inhibited_handlers
);
349 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
351 "Return the directory component in file name FILENAME.\n\
352 Return nil if FILENAME does not include a directory.\n\
353 Otherwise return a directory spec.\n\
354 Given a Unix syntax file name, returns a string ending in slash;\n\
355 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
357 Lisp_Object filename
;
359 register unsigned char *beg
;
360 register unsigned char *p
;
363 CHECK_STRING (filename
, 0);
365 /* If the file name has special constructs in it,
366 call the corresponding file handler. */
367 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
369 return call2 (handler
, Qfile_name_directory
, filename
);
371 #ifdef FILE_SYSTEM_CASE
372 filename
= FILE_SYSTEM_CASE (filename
);
374 beg
= XSTRING (filename
)->data
;
376 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
378 p
= beg
+ STRING_BYTES (XSTRING (filename
));
380 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
382 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
385 /* only recognise drive specifier at beginning */
386 && !(p
[-1] == ':' && p
== beg
+ 2)
393 /* Expansion of "c:" to drive and default directory. */
394 if (p
== beg
+ 2 && beg
[1] == ':')
396 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
397 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
398 if (getdefdir (toupper (*beg
) - 'A' + 1, res
))
400 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
403 p
= beg
+ strlen (beg
);
406 CORRECT_DIR_SEPS (beg
);
409 if (STRING_MULTIBYTE (filename
))
410 return make_string (beg
, p
- beg
);
411 return make_unibyte_string (beg
, p
- beg
);
414 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
,
415 Sfile_name_nondirectory
, 1, 1, 0,
416 "Return file name FILENAME sans its directory.\n\
417 For example, in a Unix-syntax file name,\n\
418 this is everything after the last slash,\n\
419 or the entire name if it contains no slash.")
421 Lisp_Object filename
;
423 register unsigned char *beg
, *p
, *end
;
426 CHECK_STRING (filename
, 0);
428 /* If the file name has special constructs in it,
429 call the corresponding file handler. */
430 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
432 return call2 (handler
, Qfile_name_nondirectory
, filename
);
434 beg
= XSTRING (filename
)->data
;
435 end
= p
= beg
+ STRING_BYTES (XSTRING (filename
));
437 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
439 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
442 /* only recognise drive specifier at beginning */
443 && !(p
[-1] == ':' && p
== beg
+ 2)
448 if (STRING_MULTIBYTE (filename
))
449 return make_string (p
, end
- p
);
450 return make_unibyte_string (p
, end
- p
);
453 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
,
454 Sunhandled_file_name_directory
, 1, 1, 0,
455 "Return a directly usable directory name somehow associated with FILENAME.\n\
456 A `directly usable' directory name is one that may be used without the\n\
457 intervention of any file handler.\n\
458 If FILENAME is a directly usable file itself, return\n\
459 \(file-name-directory FILENAME).\n\
460 The `call-process' and `start-process' functions use this function to\n\
461 get a current directory to run processes in.")
463 Lisp_Object filename
;
467 /* If the file name has special constructs in it,
468 call the corresponding file handler. */
469 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
471 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
473 return Ffile_name_directory (filename
);
478 file_name_as_directory (out
, in
)
481 int size
= strlen (in
) - 1;
494 /* Is it already a directory string? */
495 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
497 /* Is it a VMS directory file name? If so, hack VMS syntax. */
498 else if (! index (in
, '/')
499 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
500 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
501 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
502 || ! strncmp (&in
[size
- 5], ".dir", 4))
503 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
504 && in
[size
] == '1')))
506 register char *p
, *dot
;
510 dir:x.dir --> dir:[x]
511 dir:[x]y.dir --> dir:[x.y] */
513 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
516 strncpy (out
, in
, p
- in
);
535 dot
= index (p
, '.');
538 /* blindly remove any extension */
539 size
= strlen (out
) + (dot
- p
);
540 strncat (out
, p
, dot
- p
);
551 /* For Unix syntax, Append a slash if necessary */
552 if (!IS_DIRECTORY_SEP (out
[size
]))
554 out
[size
+ 1] = DIRECTORY_SEP
;
555 out
[size
+ 2] = '\0';
558 CORRECT_DIR_SEPS (out
);
564 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
565 Sfile_name_as_directory
, 1, 1, 0,
566 "Return a string representing file FILENAME interpreted as a directory.\n\
567 This operation exists because a directory is also a file, but its name as\n\
568 a directory is different from its name as a file.\n\
569 The result can be used as the value of `default-directory'\n\
570 or passed as second argument to `expand-file-name'.\n\
571 For a Unix-syntax file name, just appends a slash.\n\
572 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
579 CHECK_STRING (file
, 0);
583 /* If the file name has special constructs in it,
584 call the corresponding file handler. */
585 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
587 return call2 (handler
, Qfile_name_as_directory
, file
);
589 buf
= (char *) alloca (STRING_BYTES (XSTRING (file
)) + 10);
590 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
594 * Convert from directory name to filename.
596 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
597 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
598 * On UNIX, it's simple: just make sure there isn't a terminating /
600 * Value is nonzero if the string output is different from the input.
604 directory_file_name (src
, dst
)
612 struct FAB fab
= cc$rms_fab
;
613 struct NAM nam
= cc$rms_nam
;
614 char esa
[NAM$C_MAXRSS
];
619 if (! index (src
, '/')
620 && (src
[slen
- 1] == ']'
621 || src
[slen
- 1] == ':'
622 || src
[slen
- 1] == '>'))
624 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
626 fab
.fab$b_fns
= slen
;
627 fab
.fab$l_nam
= &nam
;
628 fab
.fab$l_fop
= FAB$M_NAM
;
631 nam
.nam$b_ess
= sizeof esa
;
632 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
634 /* We call SYS$PARSE to handle such things as [--] for us. */
635 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
637 slen
= nam
.nam$b_esl
;
638 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
643 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
645 /* what about when we have logical_name:???? */
646 if (src
[slen
- 1] == ':')
647 { /* Xlate logical name and see what we get */
648 ptr
= strcpy (dst
, src
); /* upper case for getenv */
651 if ('a' <= *ptr
&& *ptr
<= 'z')
655 dst
[slen
- 1] = 0; /* remove colon */
656 if (!(src
= egetenv (dst
)))
658 /* should we jump to the beginning of this procedure?
659 Good points: allows us to use logical names that xlate
661 Bad points: can be a problem if we just translated to a device
663 For now, I'll punt and always expect VMS names, and hope for
666 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
667 { /* no recursion here! */
673 { /* not a directory spec */
678 bracket
= src
[slen
- 1];
680 /* If bracket is ']' or '>', bracket - 2 is the corresponding
682 ptr
= index (src
, bracket
- 2);
684 { /* no opening bracket */
688 if (!(rptr
= rindex (src
, '.')))
691 strncpy (dst
, src
, slen
);
695 dst
[slen
++] = bracket
;
700 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
701 then translate the device and recurse. */
702 if (dst
[slen
- 1] == ':'
703 && dst
[slen
- 2] != ':' /* skip decnet nodes */
704 && strcmp (src
+ slen
, "[000000]") == 0)
706 dst
[slen
- 1] = '\0';
707 if ((ptr
= egetenv (dst
))
708 && (rlen
= strlen (ptr
) - 1) > 0
709 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
710 && ptr
[rlen
- 1] == '.')
712 char * buf
= (char *) alloca (strlen (ptr
) + 1);
716 return directory_file_name (buf
, dst
);
721 strcat (dst
, "[000000]");
725 rlen
= strlen (rptr
) - 1;
726 strncat (dst
, rptr
, rlen
);
727 dst
[slen
+ rlen
] = '\0';
728 strcat (dst
, ".DIR.1");
732 /* Process as Unix format: just remove any final slash.
733 But leave "/" unchanged; do not change it to "". */
736 /* Handle // as root for apollo's. */
737 if ((slen
> 2 && dst
[slen
- 1] == '/')
738 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
742 && IS_DIRECTORY_SEP (dst
[slen
- 1])
744 && !IS_ANY_SEP (dst
[slen
- 2])
750 CORRECT_DIR_SEPS (dst
);
755 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
757 "Returns the file name of the directory named DIRECTORY.\n\
758 This is the name of the file that holds the data for the directory DIRECTORY.\n\
759 This operation exists because a directory is also a file, but its name as\n\
760 a directory is different from its name as a file.\n\
761 In Unix-syntax, this function just removes the final slash.\n\
762 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
763 it returns a file name such as \"[X]Y.DIR.1\".")
765 Lisp_Object directory
;
770 CHECK_STRING (directory
, 0);
772 if (NILP (directory
))
775 /* If the file name has special constructs in it,
776 call the corresponding file handler. */
777 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
779 return call2 (handler
, Qdirectory_file_name
, directory
);
782 /* 20 extra chars is insufficient for VMS, since we might perform a
783 logical name translation. an equivalence string can be up to 255
784 chars long, so grab that much extra space... - sss */
785 buf
= (char *) alloca (STRING_BYTES (XSTRING (directory
)) + 20 + 255);
787 buf
= (char *) alloca (STRING_BYTES (XSTRING (directory
)) + 20);
789 directory_file_name (XSTRING (directory
)->data
, buf
);
790 return build_string (buf
);
793 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
794 "Generate temporary file name (string) starting with PREFIX (a string).\n\
795 The Emacs process number forms part of the result,\n\
796 so there is no danger of generating a name being used by another process.\n\
797 In addition, this function makes an attempt to choose a name\n\
798 which has no existing file.")
805 /* Don't use too many characters of the restricted 8+3 DOS
807 val
= concat2 (prefix
, build_string ("a.XXX"));
809 val
= concat2 (prefix
, build_string ("XXXXXX"));
811 temp
= mktemp (XSTRING (val
)->data
);
813 error ("No temporary file names based on %s are available",
814 XSTRING (prefix
)->data
);
816 CORRECT_DIR_SEPS (XSTRING (val
)->data
);
821 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
822 "Convert filename NAME to absolute, and canonicalize it.\n\
823 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative\n\
824 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,\n\
825 the current buffer's value of default-directory is used.\n\
826 File name components that are `.' are removed, and \n\
827 so are file name components followed by `..', along with the `..' itself;\n\
828 note that these simplifications are done without checking the resulting\n\
829 file names in the file system.\n\
830 An initial `~/' expands to your home directory.\n\
831 An initial `~USER/' expands to USER's home directory.\n\
832 See also the function `substitute-in-file-name'.")
833 (name
, default_directory
)
834 Lisp_Object name
, default_directory
;
838 register unsigned char *newdir
, *p
, *o
;
840 unsigned char *target
;
843 unsigned char * colon
= 0;
844 unsigned char * close
= 0;
845 unsigned char * slash
= 0;
846 unsigned char * brack
= 0;
847 int lbrack
= 0, rbrack
= 0;
852 int collapse_newdir
= 1;
857 CHECK_STRING (name
, 0);
859 /* If the file name has special constructs in it,
860 call the corresponding file handler. */
861 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
863 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
865 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
866 if (NILP (default_directory
))
867 default_directory
= current_buffer
->directory
;
868 if (! STRINGP (default_directory
))
869 default_directory
= build_string ("/");
871 if (!NILP (default_directory
))
873 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
875 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
878 o
= XSTRING (default_directory
)->data
;
880 /* Make sure DEFAULT_DIRECTORY is properly expanded.
881 It would be better to do this down below where we actually use
882 default_directory. Unfortunately, calling Fexpand_file_name recursively
883 could invoke GC, and the strings might be relocated. This would
884 be annoying because we have pointers into strings lying around
885 that would need adjusting, and people would add new pointers to
886 the code and forget to adjust them, resulting in intermittent bugs.
887 Putting this call here avoids all that crud.
889 The EQ test avoids infinite recursion. */
890 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
891 /* Save time in some common cases - as long as default_directory
892 is not relative, it can be canonicalized with name below (if it
893 is needed at all) without requiring it to be expanded now. */
895 /* Detect MSDOS file names with drive specifiers. */
896 && ! (IS_DRIVE (o
[0]) && (IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2])))
898 /* Detect Windows file names in UNC format. */
899 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
901 #else /* not DOS_NT */
902 /* Detect Unix absolute file names (/... alone is not absolute on
904 && ! (IS_DIRECTORY_SEP (o
[0]))
905 #endif /* not DOS_NT */
911 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
916 /* Filenames on VMS are always upper case. */
917 name
= Fupcase (name
);
919 #ifdef FILE_SYSTEM_CASE
920 name
= FILE_SYSTEM_CASE (name
);
923 nm
= XSTRING (name
)->data
;
926 /* We will force directory separators to be either all \ or /, so make
927 a local copy to modify, even if there ends up being no change. */
928 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
930 /* Find and remove drive specifier if present; this makes nm absolute
931 even if the rest of the name appears to be relative. */
933 unsigned char *colon
= rindex (nm
, ':');
936 /* Only recognize colon as part of drive specifier if there is a
937 single alphabetic character preceeding the colon (and if the
938 character before the drive letter, if present, is a directory
939 separator); this is to support the remote system syntax used by
940 ange-ftp, and the "po:username" syntax for POP mailboxes. */
944 else if (IS_DRIVE (colon
[-1])
945 && (colon
== nm
+ 1 || IS_DIRECTORY_SEP (colon
[-2])))
952 while (--colon
>= nm
)
959 /* If we see "c://somedir", we want to strip the first slash after the
960 colon when stripping the drive letter. Otherwise, this expands to
962 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
964 #endif /* WINDOWSNT */
968 /* Discard any previous drive specifier if nm is now in UNC format. */
969 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
975 /* If nm is absolute, look for /./ or /../ sequences; if none are
976 found, we can probably return right away. We will avoid allocating
977 a new string if name is already fully expanded. */
979 IS_DIRECTORY_SEP (nm
[0])
984 && (drive
|| IS_DIRECTORY_SEP (nm
[1]))
991 /* If it turns out that the filename we want to return is just a
992 suffix of FILENAME, we don't need to go through and edit
993 things; we just need to construct a new string using data
994 starting at the middle of FILENAME. If we set lose to a
995 non-zero value, that means we've discovered that we can't do
1002 /* Since we know the name is absolute, we can assume that each
1003 element starts with a "/". */
1005 /* "." and ".." are hairy. */
1006 if (IS_DIRECTORY_SEP (p
[0])
1008 && (IS_DIRECTORY_SEP (p
[2])
1010 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
1017 /* if dev:[dir]/, move nm to / */
1018 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1019 nm
= (brack
? brack
+ 1 : colon
+ 1);
1020 lbrack
= rbrack
= 0;
1028 /* VMS pre V4.4,convert '-'s in filenames. */
1029 if (lbrack
== rbrack
)
1031 if (dots
< 2) /* this is to allow negative version numbers */
1036 if (lbrack
> rbrack
&&
1037 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1038 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1044 /* count open brackets, reset close bracket pointer */
1045 if (p
[0] == '[' || p
[0] == '<')
1046 lbrack
++, brack
= 0;
1047 /* count close brackets, set close bracket pointer */
1048 if (p
[0] == ']' || p
[0] == '>')
1049 rbrack
++, brack
= p
;
1050 /* detect ][ or >< */
1051 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1053 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1054 nm
= p
+ 1, lose
= 1;
1055 if (p
[0] == ':' && (colon
|| slash
))
1056 /* if dev1:[dir]dev2:, move nm to dev2: */
1062 /* if /name/dev:, move nm to dev: */
1065 /* if node::dev:, move colon following dev */
1066 else if (colon
&& colon
[-1] == ':')
1068 /* if dev1:dev2:, move nm to dev2: */
1069 else if (colon
&& colon
[-1] != ':')
1074 if (p
[0] == ':' && !colon
)
1080 if (lbrack
== rbrack
)
1083 else if (p
[0] == '.')
1091 if (index (nm
, '/'))
1092 return build_string (sys_translate_unix (nm
));
1095 /* Make sure directories are all separated with / or \ as
1096 desired, but avoid allocation of a new string when not
1098 CORRECT_DIR_SEPS (nm
);
1100 if (IS_DIRECTORY_SEP (nm
[1]))
1102 if (strcmp (nm
, XSTRING (name
)->data
) != 0)
1103 name
= build_string (nm
);
1107 /* drive must be set, so this is okay */
1108 if (strcmp (nm
- 2, XSTRING (name
)->data
) != 0)
1110 name
= make_string (nm
- 2, p
- nm
+ 2);
1111 XSTRING (name
)->data
[0] = DRIVE_LETTER (drive
);
1112 XSTRING (name
)->data
[1] = ':';
1115 #else /* not DOS_NT */
1116 if (nm
== XSTRING (name
)->data
)
1118 return build_string (nm
);
1119 #endif /* not DOS_NT */
1123 /* At this point, nm might or might not be an absolute file name. We
1124 need to expand ~ or ~user if present, otherwise prefix nm with
1125 default_directory if nm is not absolute, and finally collapse /./
1126 and /foo/../ sequences.
1128 We set newdir to be the appropriate prefix if one is needed:
1129 - the relevant user directory if nm starts with ~ or ~user
1130 - the specified drive's working dir (DOS/NT only) if nm does not
1132 - the value of default_directory.
1134 Note that these prefixes are not guaranteed to be absolute (except
1135 for the working dir of a drive). Therefore, to ensure we always
1136 return an absolute name, if the final prefix is not absolute we
1137 append it to the current working directory. */
1141 if (nm
[0] == '~') /* prefix ~ */
1143 if (IS_DIRECTORY_SEP (nm
[1])
1147 || nm
[1] == 0) /* ~ by itself */
1149 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1150 newdir
= (unsigned char *) "";
1153 collapse_newdir
= 0;
1156 nm
++; /* Don't leave the slash in nm. */
1159 else /* ~user/filename */
1161 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1166 o
= (unsigned char *) alloca (p
- nm
+ 1);
1167 bcopy ((char *) nm
, o
, p
- nm
);
1170 pw
= (struct passwd
*) getpwnam (o
+ 1);
1173 newdir
= (unsigned char *) pw
-> pw_dir
;
1175 nm
= p
+ 1; /* skip the terminator */
1179 collapse_newdir
= 0;
1184 /* If we don't find a user of that name, leave the name
1185 unchanged; don't move nm forward to p. */
1190 /* On DOS and Windows, nm is absolute if a drive name was specified;
1191 use the drive's current directory as the prefix if needed. */
1192 if (!newdir
&& drive
)
1194 /* Get default directory if needed to make nm absolute. */
1195 if (!IS_DIRECTORY_SEP (nm
[0]))
1197 newdir
= alloca (MAXPATHLEN
+ 1);
1198 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1203 /* Either nm starts with /, or drive isn't mounted. */
1204 newdir
= alloca (4);
1205 newdir
[0] = DRIVE_LETTER (drive
);
1213 /* Finally, if no prefix has been specified and nm is not absolute,
1214 then it must be expanded relative to default_directory. */
1218 /* /... alone is not absolute on DOS and Windows. */
1219 && !IS_DIRECTORY_SEP (nm
[0])
1222 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1229 newdir
= XSTRING (default_directory
)->data
;
1235 /* First ensure newdir is an absolute name. */
1237 /* Detect MSDOS file names with drive specifiers. */
1238 ! (IS_DRIVE (newdir
[0])
1239 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1241 /* Detect Windows file names in UNC format. */
1242 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1246 /* Effectively, let newdir be (expand-file-name newdir cwd).
1247 Because of the admonition against calling expand-file-name
1248 when we have pointers into lisp strings, we accomplish this
1249 indirectly by prepending newdir to nm if necessary, and using
1250 cwd (or the wd of newdir's drive) as the new newdir. */
1252 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1257 if (!IS_DIRECTORY_SEP (nm
[0]))
1259 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1260 file_name_as_directory (tmp
, newdir
);
1264 newdir
= alloca (MAXPATHLEN
+ 1);
1267 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1274 /* Strip off drive name from prefix, if present. */
1275 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1281 /* Keep only a prefix from newdir if nm starts with slash
1282 (//server/share for UNC, nothing otherwise). */
1283 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1286 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1288 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1290 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1292 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1304 /* Get rid of any slash at the end of newdir, unless newdir is
1305 just // (an incomplete UNC name). */
1306 length
= strlen (newdir
);
1307 if (length
> 0 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1309 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1313 unsigned char *temp
= (unsigned char *) alloca (length
);
1314 bcopy (newdir
, temp
, length
- 1);
1315 temp
[length
- 1] = 0;
1323 /* Now concatenate the directory and name to new space in the stack frame */
1324 tlen
+= strlen (nm
) + 1;
1326 /* Add reserved space for drive name. (The Microsoft x86 compiler
1327 produces incorrect code if the following two lines are combined.) */
1328 target
= (unsigned char *) alloca (tlen
+ 2);
1330 #else /* not DOS_NT */
1331 target
= (unsigned char *) alloca (tlen
);
1332 #endif /* not DOS_NT */
1338 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1339 strcpy (target
, newdir
);
1342 file_name_as_directory (target
, newdir
);
1345 strcat (target
, nm
);
1347 if (index (target
, '/'))
1348 strcpy (target
, sys_translate_unix (target
));
1351 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1353 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1361 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1367 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1368 /* brackets are offset from each other by 2 */
1371 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1372 /* convert [foo][bar] to [bar] */
1373 while (o
[-1] != '[' && o
[-1] != '<')
1375 else if (*p
== '-' && *o
!= '.')
1378 else if (p
[0] == '-' && o
[-1] == '.' &&
1379 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1380 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1384 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1385 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1387 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1389 /* else [foo.-] ==> [-] */
1395 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1396 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1402 if (!IS_DIRECTORY_SEP (*p
))
1406 else if (IS_DIRECTORY_SEP (p
[0])
1408 && (IS_DIRECTORY_SEP (p
[2])
1411 /* If "/." is the entire filename, keep the "/". Otherwise,
1412 just delete the whole "/.". */
1413 if (o
== target
&& p
[2] == '\0')
1417 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1418 /* `/../' is the "superroot" on certain file systems. */
1420 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1422 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1424 /* Keep initial / only if this is the whole name. */
1425 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1433 #endif /* not VMS */
1437 /* At last, set drive name. */
1439 /* Except for network file name. */
1440 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1441 #endif /* WINDOWSNT */
1443 if (!drive
) abort ();
1445 target
[0] = DRIVE_LETTER (drive
);
1448 CORRECT_DIR_SEPS (target
);
1451 return make_string (target
, o
- target
);
1455 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1456 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1457 "Convert FILENAME to absolute, and canonicalize it.\n\
1458 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1459 (does not start with slash); if DEFAULT is nil or missing,\n\
1460 the current buffer's value of default-directory is used.\n\
1461 Filenames containing `.' or `..' as components are simplified;\n\
1462 initial `~/' expands to your home directory.\n\
1463 See also the function `substitute-in-file-name'.")
1465 Lisp_Object name
, defalt
;
1469 register unsigned char *newdir
, *p
, *o
;
1471 unsigned char *target
;
1475 unsigned char * colon
= 0;
1476 unsigned char * close
= 0;
1477 unsigned char * slash
= 0;
1478 unsigned char * brack
= 0;
1479 int lbrack
= 0, rbrack
= 0;
1483 CHECK_STRING (name
, 0);
1486 /* Filenames on VMS are always upper case. */
1487 name
= Fupcase (name
);
1490 nm
= XSTRING (name
)->data
;
1492 /* If nm is absolute, flush ...// and detect /./ and /../.
1493 If no /./ or /../ we can return right away. */
1505 if (p
[0] == '/' && p
[1] == '/'
1507 /* // at start of filename is meaningful on Apollo system. */
1512 if (p
[0] == '/' && p
[1] == '~')
1513 nm
= p
+ 1, lose
= 1;
1514 if (p
[0] == '/' && p
[1] == '.'
1515 && (p
[2] == '/' || p
[2] == 0
1516 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1522 /* if dev:[dir]/, move nm to / */
1523 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1524 nm
= (brack
? brack
+ 1 : colon
+ 1);
1525 lbrack
= rbrack
= 0;
1533 /* VMS pre V4.4,convert '-'s in filenames. */
1534 if (lbrack
== rbrack
)
1536 if (dots
< 2) /* this is to allow negative version numbers */
1541 if (lbrack
> rbrack
&&
1542 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1543 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1549 /* count open brackets, reset close bracket pointer */
1550 if (p
[0] == '[' || p
[0] == '<')
1551 lbrack
++, brack
= 0;
1552 /* count close brackets, set close bracket pointer */
1553 if (p
[0] == ']' || p
[0] == '>')
1554 rbrack
++, brack
= p
;
1555 /* detect ][ or >< */
1556 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1558 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1559 nm
= p
+ 1, lose
= 1;
1560 if (p
[0] == ':' && (colon
|| slash
))
1561 /* if dev1:[dir]dev2:, move nm to dev2: */
1567 /* If /name/dev:, move nm to dev: */
1570 /* If node::dev:, move colon following dev */
1571 else if (colon
&& colon
[-1] == ':')
1573 /* If dev1:dev2:, move nm to dev2: */
1574 else if (colon
&& colon
[-1] != ':')
1579 if (p
[0] == ':' && !colon
)
1585 if (lbrack
== rbrack
)
1588 else if (p
[0] == '.')
1596 if (index (nm
, '/'))
1597 return build_string (sys_translate_unix (nm
));
1599 if (nm
== XSTRING (name
)->data
)
1601 return build_string (nm
);
1605 /* Now determine directory to start with and put it in NEWDIR */
1609 if (nm
[0] == '~') /* prefix ~ */
1614 || nm
[1] == 0)/* ~/filename */
1616 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1617 newdir
= (unsigned char *) "";
1620 nm
++; /* Don't leave the slash in nm. */
1623 else /* ~user/filename */
1625 /* Get past ~ to user */
1626 unsigned char *user
= nm
+ 1;
1627 /* Find end of name. */
1628 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1629 int len
= ptr
? ptr
- user
: strlen (user
);
1631 unsigned char *ptr1
= index (user
, ':');
1632 if (ptr1
!= 0 && ptr1
- user
< len
)
1635 /* Copy the user name into temp storage. */
1636 o
= (unsigned char *) alloca (len
+ 1);
1637 bcopy ((char *) user
, o
, len
);
1640 /* Look up the user name. */
1641 pw
= (struct passwd
*) getpwnam (o
+ 1);
1643 error ("\"%s\" isn't a registered user", o
+ 1);
1645 newdir
= (unsigned char *) pw
->pw_dir
;
1647 /* Discard the user name from NM. */
1654 #endif /* not VMS */
1658 defalt
= current_buffer
->directory
;
1659 CHECK_STRING (defalt
, 1);
1660 newdir
= XSTRING (defalt
)->data
;
1663 /* Now concatenate the directory and name to new space in the stack frame */
1665 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1666 target
= (unsigned char *) alloca (tlen
);
1672 if (nm
[0] == 0 || nm
[0] == '/')
1673 strcpy (target
, newdir
);
1676 file_name_as_directory (target
, newdir
);
1679 strcat (target
, nm
);
1681 if (index (target
, '/'))
1682 strcpy (target
, sys_translate_unix (target
));
1685 /* Now canonicalize by removing /. and /foo/.. if they appear */
1693 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1699 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1700 /* brackets are offset from each other by 2 */
1703 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1704 /* convert [foo][bar] to [bar] */
1705 while (o
[-1] != '[' && o
[-1] != '<')
1707 else if (*p
== '-' && *o
!= '.')
1710 else if (p
[0] == '-' && o
[-1] == '.' &&
1711 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1712 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1716 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1717 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1719 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1721 /* else [foo.-] ==> [-] */
1727 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1728 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1738 else if (!strncmp (p
, "//", 2)
1740 /* // at start of filename is meaningful in Apollo system. */
1748 else if (p
[0] == '/' && p
[1] == '.' &&
1749 (p
[2] == '/' || p
[2] == 0))
1751 else if (!strncmp (p
, "/..", 3)
1752 /* `/../' is the "superroot" on certain file systems. */
1754 && (p
[3] == '/' || p
[3] == 0))
1756 while (o
!= target
&& *--o
!= '/')
1759 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1763 if (o
== target
&& *o
== '/')
1771 #endif /* not VMS */
1774 return make_string (target
, o
- target
);
1778 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1779 Ssubstitute_in_file_name
, 1, 1, 0,
1780 "Substitute environment variables referred to in FILENAME.\n\
1781 `$FOO' where FOO is an environment variable name means to substitute\n\
1782 the value of that variable. The variable name should be terminated\n\
1783 with a character not a letter, digit or underscore; otherwise, enclose\n\
1784 the entire variable name in braces.\n\
1785 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1786 On VMS, `$' substitution is not done; this function does little and only\n\
1787 duplicates what `expand-file-name' does.")
1789 Lisp_Object filename
;
1793 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1794 unsigned char *target
;
1796 int substituted
= 0;
1798 Lisp_Object handler
;
1800 CHECK_STRING (filename
, 0);
1802 /* If the file name has special constructs in it,
1803 call the corresponding file handler. */
1804 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1805 if (!NILP (handler
))
1806 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1808 nm
= XSTRING (filename
)->data
;
1810 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1811 CORRECT_DIR_SEPS (nm
);
1812 substituted
= (strcmp (nm
, XSTRING (filename
)->data
) != 0);
1814 endp
= nm
+ STRING_BYTES (XSTRING (filename
));
1816 /* If /~ or // appears, discard everything through first slash. */
1818 for (p
= nm
; p
!= endp
; p
++)
1821 #if defined (APOLLO) || defined (WINDOWSNT)
1822 /* // at start of file name is meaningful in Apollo and
1823 WindowsNT systems. */
1824 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1825 #else /* not (APOLLO || WINDOWSNT) */
1826 || IS_DIRECTORY_SEP (p
[0])
1827 #endif /* not (APOLLO || WINDOWSNT) */
1832 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1834 || IS_DIRECTORY_SEP (p
[-1])))
1840 /* see comment in expand-file-name about drive specifiers */
1841 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1842 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1851 return build_string (nm
);
1854 /* See if any variables are substituted into the string
1855 and find the total length of their values in `total' */
1857 for (p
= nm
; p
!= endp
;)
1867 /* "$$" means a single "$" */
1876 while (p
!= endp
&& *p
!= '}') p
++;
1877 if (*p
!= '}') goto missingclose
;
1883 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1887 /* Copy out the variable name */
1888 target
= (unsigned char *) alloca (s
- o
+ 1);
1889 strncpy (target
, o
, s
- o
);
1892 strupr (target
); /* $home == $HOME etc. */
1895 /* Get variable value */
1896 o
= (unsigned char *) egetenv (target
);
1897 if (!o
) goto badvar
;
1898 total
+= strlen (o
);
1905 /* If substitution required, recopy the string and do it */
1906 /* Make space in stack frame for the new copy */
1907 xnm
= (unsigned char *) alloca (STRING_BYTES (XSTRING (filename
)) + total
+ 1);
1910 /* Copy the rest of the name through, replacing $ constructs with values */
1927 while (p
!= endp
&& *p
!= '}') p
++;
1928 if (*p
!= '}') goto missingclose
;
1934 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1938 /* Copy out the variable name */
1939 target
= (unsigned char *) alloca (s
- o
+ 1);
1940 strncpy (target
, o
, s
- o
);
1943 strupr (target
); /* $home == $HOME etc. */
1946 /* Get variable value */
1947 o
= (unsigned char *) egetenv (target
);
1951 if (STRING_MULTIBYTE (filename
))
1953 /* If the original string is multibyte,
1954 convert what we substitute into multibyte. */
1955 unsigned char workbuf
[4], *str
;
1961 c
= unibyte_char_to_multibyte (c
);
1962 if (! SINGLE_BYTE_CHAR_P (c
))
1964 len
= CHAR_STRING (c
, workbuf
, str
);
1965 bcopy (str
, x
, len
);
1981 /* If /~ or // appears, discard everything through first slash. */
1983 for (p
= xnm
; p
!= x
; p
++)
1985 #if defined (APOLLO) || defined (WINDOWSNT)
1986 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
1987 #else /* not (APOLLO || WINDOWSNT) */
1988 || IS_DIRECTORY_SEP (p
[0])
1989 #endif /* not (APOLLO || WINDOWSNT) */
1991 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
1994 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1995 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1999 if (STRING_MULTIBYTE (filename
))
2000 return make_string (xnm
, x
- xnm
);
2001 return make_unibyte_string (xnm
, x
- xnm
);
2004 error ("Bad format environment-variable substitution");
2006 error ("Missing \"}\" in environment-variable substitution");
2008 error ("Substituting nonexistent environment variable \"%s\"", target
);
2011 #endif /* not VMS */
2014 /* A slightly faster and more convenient way to get
2015 (directory-file-name (expand-file-name FOO)). */
2018 expand_and_dir_to_file (filename
, defdir
)
2019 Lisp_Object filename
, defdir
;
2021 register Lisp_Object absname
;
2023 absname
= Fexpand_file_name (filename
, defdir
);
2026 register int c
= XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
)) - 1];
2027 if (c
== ':' || c
== ']' || c
== '>')
2028 absname
= Fdirectory_file_name (absname
);
2031 /* Remove final slash, if any (unless this is the root dir).
2032 stat behaves differently depending! */
2033 if (XSTRING (absname
)->size
> 1
2034 && IS_DIRECTORY_SEP (XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
)) - 1])
2035 && !IS_DEVICE_SEP (XSTRING (absname
)->data
[STRING_BYTES (XSTRING (absname
))-2]))
2036 /* We cannot take shortcuts; they might be wrong for magic file names. */
2037 absname
= Fdirectory_file_name (absname
);
2042 /* Signal an error if the file ABSNAME already exists.
2043 If INTERACTIVE is nonzero, ask the user whether to proceed,
2044 and bypass the error if the user says to go ahead.
2045 QUERYSTRING is a name for the action that is being considered
2048 *STATPTR is used to store the stat information if the file exists.
2049 If the file does not exist, STATPTR->st_mode is set to 0.
2050 If STATPTR is null, we don't store into it.
2052 If QUICK is nonzero, we ask for y or n, not yes or no. */
2055 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
, quick
)
2056 Lisp_Object absname
;
2057 unsigned char *querystring
;
2059 struct stat
*statptr
;
2062 register Lisp_Object tem
;
2063 struct stat statbuf
;
2064 struct gcpro gcpro1
;
2066 /* stat is a good way to tell whether the file exists,
2067 regardless of what access permissions it has. */
2068 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
2071 Fsignal (Qfile_already_exists
,
2072 Fcons (build_string ("File already exists"),
2073 Fcons (absname
, Qnil
)));
2075 tem
= format1 ("File %s already exists; %s anyway? ",
2076 XSTRING (absname
)->data
, querystring
);
2078 tem
= Fy_or_n_p (tem
);
2080 tem
= do_yes_or_no_p (tem
);
2083 Fsignal (Qfile_already_exists
,
2084 Fcons (build_string ("File already exists"),
2085 Fcons (absname
, Qnil
)));
2092 statptr
->st_mode
= 0;
2097 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2098 "fCopy file: \nFCopy %s to file: \np\nP",
2099 "Copy FILE to NEWNAME. Both args must be strings.\n\
2100 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
2101 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
2102 A number as third arg means request confirmation if NEWNAME already exists.\n\
2103 This is what happens in interactive use with M-x.\n\
2104 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
2105 last-modified time as the old one. (This works on only some systems.)\n\
2106 A prefix arg makes KEEP-TIME non-nil.")
2107 (file
, newname
, ok_if_already_exists
, keep_date
)
2108 Lisp_Object file
, newname
, ok_if_already_exists
, keep_date
;
2111 char buf
[16 * 1024];
2112 struct stat st
, out_st
;
2113 Lisp_Object handler
;
2114 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2115 int count
= specpdl_ptr
- specpdl
;
2116 int input_file_statable_p
;
2117 Lisp_Object encoded_file
, encoded_newname
;
2119 encoded_file
= encoded_newname
= Qnil
;
2120 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2121 CHECK_STRING (file
, 0);
2122 CHECK_STRING (newname
, 1);
2124 file
= Fexpand_file_name (file
, Qnil
);
2125 newname
= Fexpand_file_name (newname
, Qnil
);
2127 /* If the input file name has special constructs in it,
2128 call the corresponding file handler. */
2129 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2130 /* Likewise for output file name. */
2132 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2133 if (!NILP (handler
))
2134 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2135 ok_if_already_exists
, keep_date
));
2137 encoded_file
= ENCODE_FILE (file
);
2138 encoded_newname
= ENCODE_FILE (newname
);
2140 if (NILP (ok_if_already_exists
)
2141 || INTEGERP (ok_if_already_exists
))
2142 barf_or_query_if_file_exists (encoded_newname
, "copy to it",
2143 INTEGERP (ok_if_already_exists
), &out_st
, 0);
2144 else if (stat (XSTRING (encoded_newname
)->data
, &out_st
) < 0)
2147 ifd
= open (XSTRING (encoded_file
)->data
, O_RDONLY
);
2149 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2151 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2153 /* We can only copy regular files and symbolic links. Other files are not
2155 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2157 #if !defined (MSDOS) || __DJGPP__ > 1
2158 if (out_st
.st_mode
!= 0
2159 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2162 report_file_error ("Input and output files are the same",
2163 Fcons (file
, Fcons (newname
, Qnil
)));
2167 #if defined (S_ISREG) && defined (S_ISLNK)
2168 if (input_file_statable_p
)
2170 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2172 #if defined (EISDIR)
2173 /* Get a better looking error message. */
2176 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2179 #endif /* S_ISREG && S_ISLNK */
2182 /* Create the copy file with the same record format as the input file */
2183 ofd
= sys_creat (XSTRING (encoded_newname
)->data
, 0666, ifd
);
2186 /* System's default file type was set to binary by _fmode in emacs.c. */
2187 ofd
= creat (XSTRING (encoded_newname
)->data
, S_IREAD
| S_IWRITE
);
2188 #else /* not MSDOS */
2189 ofd
= creat (XSTRING (encoded_newname
)->data
, 0666);
2190 #endif /* not MSDOS */
2193 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2195 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2199 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
2200 if (write (ofd
, buf
, n
) != n
)
2201 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2204 /* Closing the output clobbers the file times on some systems. */
2205 if (close (ofd
) < 0)
2206 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2208 if (input_file_statable_p
)
2210 if (!NILP (keep_date
))
2212 EMACS_TIME atime
, mtime
;
2213 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2214 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2215 if (set_file_times (XSTRING (encoded_newname
)->data
,
2217 Fsignal (Qfile_date_error
,
2218 Fcons (build_string ("Cannot set file date"),
2219 Fcons (newname
, Qnil
)));
2222 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2224 #if defined (__DJGPP__) && __DJGPP__ > 1
2225 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2226 and if it can't, it tells so. Otherwise, under MSDOS we usually
2227 get only the READ bit, which will make the copied file read-only,
2228 so it's better not to chmod at all. */
2229 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2230 chmod (XSTRING (encoded_newname
)->data
, st
.st_mode
& 07777);
2231 #endif /* DJGPP version 2 or newer */
2237 /* Discard the unwind protects. */
2238 specpdl_ptr
= specpdl
+ count
;
2244 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2245 Smake_directory_internal
, 1, 1, 0,
2246 "Create a new directory named DIRECTORY.")
2248 Lisp_Object directory
;
2251 Lisp_Object handler
;
2252 Lisp_Object encoded_dir
;
2254 CHECK_STRING (directory
, 0);
2255 directory
= Fexpand_file_name (directory
, Qnil
);
2257 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2258 if (!NILP (handler
))
2259 return call2 (handler
, Qmake_directory_internal
, directory
);
2261 encoded_dir
= ENCODE_FILE (directory
);
2263 dir
= XSTRING (encoded_dir
)->data
;
2266 if (mkdir (dir
) != 0)
2268 if (mkdir (dir
, 0777) != 0)
2270 report_file_error ("Creating directory", Flist (1, &directory
));
2275 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2276 "Delete the directory named DIRECTORY.")
2278 Lisp_Object directory
;
2281 Lisp_Object handler
;
2282 Lisp_Object encoded_dir
;
2284 CHECK_STRING (directory
, 0);
2285 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2287 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2288 if (!NILP (handler
))
2289 return call2 (handler
, Qdelete_directory
, directory
);
2291 encoded_dir
= ENCODE_FILE (directory
);
2293 dir
= XSTRING (encoded_dir
)->data
;
2295 if (rmdir (dir
) != 0)
2296 report_file_error ("Removing directory", Flist (1, &directory
));
2301 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2302 "Delete file named FILENAME.\n\
2303 If file has multiple names, it continues to exist with the other names.")
2305 Lisp_Object filename
;
2307 Lisp_Object handler
;
2308 Lisp_Object encoded_file
;
2310 CHECK_STRING (filename
, 0);
2311 filename
= Fexpand_file_name (filename
, Qnil
);
2313 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2314 if (!NILP (handler
))
2315 return call2 (handler
, Qdelete_file
, filename
);
2317 encoded_file
= ENCODE_FILE (filename
);
2319 if (0 > unlink (XSTRING (encoded_file
)->data
))
2320 report_file_error ("Removing old name", Flist (1, &filename
));
2325 internal_delete_file_1 (ignore
)
2331 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2334 internal_delete_file (filename
)
2335 Lisp_Object filename
;
2337 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2338 Qt
, internal_delete_file_1
));
2341 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2342 "fRename file: \nFRename %s to file: \np",
2343 "Rename FILE as NEWNAME. Both args strings.\n\
2344 If file has names other than FILE, it continues to have those names.\n\
2345 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2346 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2347 A number as third arg means request confirmation if NEWNAME already exists.\n\
2348 This is what happens in interactive use with M-x.")
2349 (file
, newname
, ok_if_already_exists
)
2350 Lisp_Object file
, newname
, ok_if_already_exists
;
2353 Lisp_Object args
[2];
2355 Lisp_Object handler
;
2356 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2357 Lisp_Object encoded_file
, encoded_newname
;
2359 encoded_file
= encoded_newname
= Qnil
;
2360 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2361 CHECK_STRING (file
, 0);
2362 CHECK_STRING (newname
, 1);
2363 file
= Fexpand_file_name (file
, Qnil
);
2364 newname
= Fexpand_file_name (newname
, Qnil
);
2366 /* If the file name has special constructs in it,
2367 call the corresponding file handler. */
2368 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2370 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2371 if (!NILP (handler
))
2372 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2373 file
, newname
, ok_if_already_exists
));
2375 encoded_file
= ENCODE_FILE (file
);
2376 encoded_newname
= ENCODE_FILE (newname
);
2378 if (NILP (ok_if_already_exists
)
2379 || INTEGERP (ok_if_already_exists
))
2380 barf_or_query_if_file_exists (encoded_newname
, "rename to it",
2381 INTEGERP (ok_if_already_exists
), 0, 0);
2383 if (0 > rename (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2385 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
)
2386 || 0 > unlink (XSTRING (encoded_file
)->data
))
2391 Fcopy_file (file
, newname
,
2392 /* We have already prompted if it was an integer,
2393 so don't have copy-file prompt again. */
2394 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2395 Fdelete_file (file
);
2402 report_file_error ("Renaming", Flist (2, args
));
2405 report_file_error ("Renaming", Flist (2, &file
));
2412 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2413 "fAdd name to file: \nFName to add to %s: \np",
2414 "Give FILE additional name NEWNAME. Both args strings.\n\
2415 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2416 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2417 A number as third arg means request confirmation if NEWNAME already exists.\n\
2418 This is what happens in interactive use with M-x.")
2419 (file
, newname
, ok_if_already_exists
)
2420 Lisp_Object file
, newname
, ok_if_already_exists
;
2423 Lisp_Object args
[2];
2425 Lisp_Object handler
;
2426 Lisp_Object encoded_file
, encoded_newname
;
2427 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2429 GCPRO4 (file
, newname
, encoded_file
, encoded_newname
);
2430 encoded_file
= encoded_newname
= Qnil
;
2431 CHECK_STRING (file
, 0);
2432 CHECK_STRING (newname
, 1);
2433 file
= Fexpand_file_name (file
, Qnil
);
2434 newname
= Fexpand_file_name (newname
, Qnil
);
2436 /* If the file name has special constructs in it,
2437 call the corresponding file handler. */
2438 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2439 if (!NILP (handler
))
2440 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2441 newname
, ok_if_already_exists
));
2443 /* If the new name has special constructs in it,
2444 call the corresponding file handler. */
2445 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2446 if (!NILP (handler
))
2447 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2448 newname
, ok_if_already_exists
));
2450 encoded_file
= ENCODE_FILE (file
);
2451 encoded_newname
= ENCODE_FILE (newname
);
2453 if (NILP (ok_if_already_exists
)
2454 || INTEGERP (ok_if_already_exists
))
2455 barf_or_query_if_file_exists (encoded_newname
, "make it a new name",
2456 INTEGERP (ok_if_already_exists
), 0, 0);
2458 unlink (XSTRING (newname
)->data
);
2459 if (0 > link (XSTRING (encoded_file
)->data
, XSTRING (encoded_newname
)->data
))
2464 report_file_error ("Adding new name", Flist (2, args
));
2466 report_file_error ("Adding new name", Flist (2, &file
));
2475 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2476 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2477 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2478 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2479 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2480 A number as third arg means request confirmation if LINKNAME already exists.\n\
2481 This happens for interactive use with M-x.")
2482 (filename
, linkname
, ok_if_already_exists
)
2483 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2486 Lisp_Object args
[2];
2488 Lisp_Object handler
;
2489 Lisp_Object encoded_filename
, encoded_linkname
;
2490 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
2492 GCPRO4 (filename
, linkname
, encoded_filename
, encoded_linkname
);
2493 encoded_filename
= encoded_linkname
= Qnil
;
2494 CHECK_STRING (filename
, 0);
2495 CHECK_STRING (linkname
, 1);
2496 /* If the link target has a ~, we must expand it to get
2497 a truly valid file name. Otherwise, do not expand;
2498 we want to permit links to relative file names. */
2499 if (XSTRING (filename
)->data
[0] == '~')
2500 filename
= Fexpand_file_name (filename
, Qnil
);
2501 linkname
= Fexpand_file_name (linkname
, Qnil
);
2503 /* If the file name has special constructs in it,
2504 call the corresponding file handler. */
2505 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2506 if (!NILP (handler
))
2507 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2508 linkname
, ok_if_already_exists
));
2510 /* If the new link name has special constructs in it,
2511 call the corresponding file handler. */
2512 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2513 if (!NILP (handler
))
2514 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2515 linkname
, ok_if_already_exists
));
2517 encoded_filename
= ENCODE_FILE (filename
);
2518 encoded_linkname
= ENCODE_FILE (linkname
);
2520 if (NILP (ok_if_already_exists
)
2521 || INTEGERP (ok_if_already_exists
))
2522 barf_or_query_if_file_exists (encoded_linkname
, "make it a link",
2523 INTEGERP (ok_if_already_exists
), 0, 0);
2524 if (0 > symlink (XSTRING (encoded_filename
)->data
,
2525 XSTRING (encoded_linkname
)->data
))
2527 /* If we didn't complain already, silently delete existing file. */
2528 if (errno
== EEXIST
)
2530 unlink (XSTRING (encoded_linkname
)->data
);
2531 if (0 <= symlink (XSTRING (encoded_filename
)->data
,
2532 XSTRING (encoded_linkname
)->data
))
2542 report_file_error ("Making symbolic link", Flist (2, args
));
2544 report_file_error ("Making symbolic link", Flist (2, &filename
));
2550 #endif /* S_IFLNK */
2554 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2555 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2556 "Define the job-wide logical name NAME to have the value STRING.\n\
2557 If STRING is nil or a null string, the logical name NAME is deleted.")
2562 CHECK_STRING (name
, 0);
2564 delete_logical_name (XSTRING (name
)->data
);
2567 CHECK_STRING (string
, 1);
2569 if (XSTRING (string
)->size
== 0)
2570 delete_logical_name (XSTRING (name
)->data
);
2572 define_logical_name (XSTRING (name
)->data
, XSTRING (string
)->data
);
2581 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2582 "Open a network connection to PATH using LOGIN as the login string.")
2584 Lisp_Object path
, login
;
2588 CHECK_STRING (path
, 0);
2589 CHECK_STRING (login
, 0);
2591 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2593 if (netresult
== -1)
2598 #endif /* HPUX_NET */
2600 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2602 "Return t if file FILENAME specifies an absolute file name.\n\
2603 On Unix, this is a name starting with a `/' or a `~'.")
2605 Lisp_Object filename
;
2609 CHECK_STRING (filename
, 0);
2610 ptr
= XSTRING (filename
)->data
;
2611 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2613 /* ??? This criterion is probably wrong for '<'. */
2614 || index (ptr
, ':') || index (ptr
, '<')
2615 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2619 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2627 /* Return nonzero if file FILENAME exists and can be executed. */
2630 check_executable (filename
)
2634 int len
= strlen (filename
);
2637 if (stat (filename
, &st
) < 0)
2639 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2640 return ((st
.st_mode
& S_IEXEC
) != 0);
2642 return (S_ISREG (st
.st_mode
)
2644 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2645 || stricmp (suffix
, ".exe") == 0
2646 || stricmp (suffix
, ".bat") == 0)
2647 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2648 #endif /* not WINDOWSNT */
2649 #else /* not DOS_NT */
2650 #ifdef HAVE_EUIDACCESS
2651 return (euidaccess (filename
, 1) >= 0);
2653 /* Access isn't quite right because it uses the real uid
2654 and we really want to test with the effective uid.
2655 But Unix doesn't give us a right way to do it. */
2656 return (access (filename
, 1) >= 0);
2658 #endif /* not DOS_NT */
2661 /* Return nonzero if file FILENAME exists and can be written. */
2664 check_writable (filename
)
2669 if (stat (filename
, &st
) < 0)
2671 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2672 #else /* not MSDOS */
2673 #ifdef HAVE_EUIDACCESS
2674 return (euidaccess (filename
, 2) >= 0);
2676 /* Access isn't quite right because it uses the real uid
2677 and we really want to test with the effective uid.
2678 But Unix doesn't give us a right way to do it.
2679 Opening with O_WRONLY could work for an ordinary file,
2680 but would lose for directories. */
2681 return (access (filename
, 2) >= 0);
2683 #endif /* not MSDOS */
2686 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2687 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2688 See also `file-readable-p' and `file-attributes'.")
2690 Lisp_Object filename
;
2692 Lisp_Object absname
;
2693 Lisp_Object handler
;
2694 struct stat statbuf
;
2696 CHECK_STRING (filename
, 0);
2697 absname
= Fexpand_file_name (filename
, Qnil
);
2699 /* If the file name has special constructs in it,
2700 call the corresponding file handler. */
2701 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2702 if (!NILP (handler
))
2703 return call2 (handler
, Qfile_exists_p
, absname
);
2705 absname
= ENCODE_FILE (absname
);
2707 return (stat (XSTRING (absname
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2710 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2711 "Return t if FILENAME can be executed by you.\n\
2712 For a directory, this means you can access files in that directory.")
2714 Lisp_Object filename
;
2717 Lisp_Object absname
;
2718 Lisp_Object handler
;
2720 CHECK_STRING (filename
, 0);
2721 absname
= Fexpand_file_name (filename
, Qnil
);
2723 /* If the file name has special constructs in it,
2724 call the corresponding file handler. */
2725 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2726 if (!NILP (handler
))
2727 return call2 (handler
, Qfile_executable_p
, absname
);
2729 absname
= ENCODE_FILE (absname
);
2731 return (check_executable (XSTRING (absname
)->data
) ? Qt
: Qnil
);
2734 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2735 "Return t if file FILENAME exists and you can read it.\n\
2736 See also `file-exists-p' and `file-attributes'.")
2738 Lisp_Object filename
;
2740 Lisp_Object absname
;
2741 Lisp_Object handler
;
2744 struct stat statbuf
;
2746 CHECK_STRING (filename
, 0);
2747 absname
= Fexpand_file_name (filename
, Qnil
);
2749 /* If the file name has special constructs in it,
2750 call the corresponding file handler. */
2751 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2752 if (!NILP (handler
))
2753 return call2 (handler
, Qfile_readable_p
, absname
);
2755 absname
= ENCODE_FILE (absname
);
2758 /* Under MS-DOS and Windows, open does not work for directories. */
2759 if (access (XSTRING (absname
)->data
, 0) == 0)
2762 #else /* not DOS_NT */
2764 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2765 /* Opening a fifo without O_NONBLOCK can wait.
2766 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2767 except in the case of a fifo, on a system which handles it. */
2768 desc
= stat (XSTRING (absname
)->data
, &statbuf
);
2771 if (S_ISFIFO (statbuf
.st_mode
))
2772 flags
|= O_NONBLOCK
;
2774 desc
= open (XSTRING (absname
)->data
, flags
);
2779 #endif /* not DOS_NT */
2782 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2784 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2785 "Return t if file FILENAME can be written or created by you.")
2787 Lisp_Object filename
;
2789 Lisp_Object absname
, dir
, encoded
;
2790 Lisp_Object handler
;
2791 struct stat statbuf
;
2793 CHECK_STRING (filename
, 0);
2794 absname
= Fexpand_file_name (filename
, Qnil
);
2796 /* If the file name has special constructs in it,
2797 call the corresponding file handler. */
2798 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2799 if (!NILP (handler
))
2800 return call2 (handler
, Qfile_writable_p
, absname
);
2802 encoded
= ENCODE_FILE (absname
);
2803 if (stat (XSTRING (encoded
)->data
, &statbuf
) >= 0)
2804 return (check_writable (XSTRING (encoded
)->data
)
2807 dir
= Ffile_name_directory (absname
);
2810 dir
= Fdirectory_file_name (dir
);
2814 dir
= Fdirectory_file_name (dir
);
2817 dir
= ENCODE_FILE (dir
);
2818 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2822 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2823 "Access file FILENAME, and get an error if that does not work.\n\
2824 The second argument STRING is used in the error message.\n\
2825 If there is no error, we return nil.")
2827 Lisp_Object filename
, string
;
2829 Lisp_Object handler
, encoded_filename
;
2832 CHECK_STRING (filename
, 0);
2834 /* If the file name has special constructs in it,
2835 call the corresponding file handler. */
2836 handler
= Ffind_file_name_handler (filename
, Qaccess_file
);
2837 if (!NILP (handler
))
2838 return call3 (handler
, Qaccess_file
, filename
, string
);
2840 encoded_filename
= ENCODE_FILE (filename
);
2842 fd
= open (XSTRING (encoded_filename
)->data
, O_RDONLY
);
2844 report_file_error (XSTRING (string
)->data
, Fcons (filename
, Qnil
));
2850 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2851 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2852 The value is the name of the file to which it is linked.\n\
2853 Otherwise returns nil.")
2855 Lisp_Object filename
;
2862 Lisp_Object handler
;
2864 CHECK_STRING (filename
, 0);
2865 filename
= Fexpand_file_name (filename
, Qnil
);
2867 /* If the file name has special constructs in it,
2868 call the corresponding file handler. */
2869 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2870 if (!NILP (handler
))
2871 return call2 (handler
, Qfile_symlink_p
, filename
);
2873 filename
= ENCODE_FILE (filename
);
2878 buf
= (char *) xmalloc (bufsize
);
2879 bzero (buf
, bufsize
);
2880 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2881 if (valsize
< bufsize
) break;
2882 /* Buffer was not long enough */
2891 val
= make_string (buf
, valsize
);
2893 val
= DECODE_FILE (val
);
2895 #else /* not S_IFLNK */
2897 #endif /* not S_IFLNK */
2900 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2901 "Return t if FILENAME names an existing directory.")
2903 Lisp_Object filename
;
2905 register Lisp_Object absname
;
2907 Lisp_Object handler
;
2909 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2911 /* If the file name has special constructs in it,
2912 call the corresponding file handler. */
2913 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2914 if (!NILP (handler
))
2915 return call2 (handler
, Qfile_directory_p
, absname
);
2917 absname
= ENCODE_FILE (absname
);
2919 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2921 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2924 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2925 "Return t if file FILENAME is the name of a directory as a file,\n\
2926 and files in that directory can be opened by you. In order to use a\n\
2927 directory as a buffer's current directory, this predicate must return true.\n\
2928 A directory name spec may be given instead; then the value is t\n\
2929 if the directory so specified exists and really is a readable and\n\
2930 searchable directory.")
2932 Lisp_Object filename
;
2934 Lisp_Object handler
;
2936 struct gcpro gcpro1
;
2938 /* If the file name has special constructs in it,
2939 call the corresponding file handler. */
2940 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2941 if (!NILP (handler
))
2942 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2944 /* It's an unlikely combination, but yes we really do need to gcpro:
2945 Suppose that file-accessible-directory-p has no handler, but
2946 file-directory-p does have a handler; this handler causes a GC which
2947 relocates the string in `filename'; and finally file-directory-p
2948 returns non-nil. Then we would end up passing a garbaged string
2949 to file-executable-p. */
2951 tem
= (NILP (Ffile_directory_p (filename
))
2952 || NILP (Ffile_executable_p (filename
)));
2954 return tem
? Qnil
: Qt
;
2957 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2958 "Return t if file FILENAME is the name of a regular file.\n\
2959 This is the sort of file that holds an ordinary stream of data bytes.")
2961 Lisp_Object filename
;
2963 register Lisp_Object absname
;
2965 Lisp_Object handler
;
2967 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2969 /* If the file name has special constructs in it,
2970 call the corresponding file handler. */
2971 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
2972 if (!NILP (handler
))
2973 return call2 (handler
, Qfile_regular_p
, absname
);
2975 absname
= ENCODE_FILE (absname
);
2977 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2979 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2982 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2983 "Return mode bits of file named FILENAME, as an integer.")
2985 Lisp_Object filename
;
2987 Lisp_Object absname
;
2989 Lisp_Object handler
;
2991 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2993 /* If the file name has special constructs in it,
2994 call the corresponding file handler. */
2995 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
2996 if (!NILP (handler
))
2997 return call2 (handler
, Qfile_modes
, absname
);
2999 absname
= ENCODE_FILE (absname
);
3001 if (stat (XSTRING (absname
)->data
, &st
) < 0)
3003 #if defined (MSDOS) && __DJGPP__ < 2
3004 if (check_executable (XSTRING (absname
)->data
))
3005 st
.st_mode
|= S_IEXEC
;
3006 #endif /* MSDOS && __DJGPP__ < 2 */
3008 return make_number (st
.st_mode
& 07777);
3011 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
3012 "Set mode bits of file named FILENAME to MODE (an integer).\n\
3013 Only the 12 low bits of MODE are used.")
3015 Lisp_Object filename
, mode
;
3017 Lisp_Object absname
, encoded_absname
;
3018 Lisp_Object handler
;
3020 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
3021 CHECK_NUMBER (mode
, 1);
3023 /* If the file name has special constructs in it,
3024 call the corresponding file handler. */
3025 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
3026 if (!NILP (handler
))
3027 return call3 (handler
, Qset_file_modes
, absname
, mode
);
3029 encoded_absname
= ENCODE_FILE (absname
);
3031 if (chmod (XSTRING (encoded_absname
)->data
, XINT (mode
)) < 0)
3032 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
3037 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
3038 "Set the file permission bits for newly created files.\n\
3039 The argument MODE should be an integer; only the low 9 bits are used.\n\
3040 This setting is inherited by subprocesses.")
3044 CHECK_NUMBER (mode
, 0);
3046 umask ((~ XINT (mode
)) & 0777);
3051 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
3052 "Return the default file protection for created files.\n\
3053 The value is an integer.")
3059 realmask
= umask (0);
3062 XSETINT (value
, (~ realmask
) & 0777);
3068 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
3069 "Tell Unix to finish all pending disk updates.")
3078 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
3079 "Return t if file FILE1 is newer than file FILE2.\n\
3080 If FILE1 does not exist, the answer is nil;\n\
3081 otherwise, if FILE2 does not exist, the answer is t.")
3083 Lisp_Object file1
, file2
;
3085 Lisp_Object absname1
, absname2
;
3088 Lisp_Object handler
;
3089 struct gcpro gcpro1
, gcpro2
;
3091 CHECK_STRING (file1
, 0);
3092 CHECK_STRING (file2
, 0);
3095 GCPRO2 (absname1
, file2
);
3096 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
3097 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
3100 /* If the file name has special constructs in it,
3101 call the corresponding file handler. */
3102 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
3104 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
3105 if (!NILP (handler
))
3106 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
3108 GCPRO2 (absname1
, absname2
);
3109 absname1
= ENCODE_FILE (absname1
);
3110 absname2
= ENCODE_FILE (absname2
);
3113 if (stat (XSTRING (absname1
)->data
, &st
) < 0)
3116 mtime1
= st
.st_mtime
;
3118 if (stat (XSTRING (absname2
)->data
, &st
) < 0)
3121 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3125 Lisp_Object Qfind_buffer_file_type
;
3128 #ifndef READ_BUF_SIZE
3129 #define READ_BUF_SIZE (64 << 10)
3132 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3134 "Insert contents of file FILENAME after point.\n\
3135 Returns list of absolute file name and number of bytes inserted.\n\
3136 If second argument VISIT is non-nil, the buffer's visited filename\n\
3137 and last save file modtime are set, and it is marked unmodified.\n\
3138 If visiting and the file does not exist, visiting is completed\n\
3139 before the error is signaled.\n\
3140 The optional third and fourth arguments BEG and END\n\
3141 specify what portion of the file to insert.\n\
3142 These arguments count bytes in the file, not characters in the buffer.\n\
3143 If VISIT is non-nil, BEG and END must be nil.\n\
3145 If optional fifth argument REPLACE is non-nil,\n\
3146 it means replace the current buffer contents (in the accessible portion)\n\
3147 with the file contents. This is better than simply deleting and inserting\n\
3148 the whole thing because (1) it preserves some marker positions\n\
3149 and (2) it puts less data in the undo list.\n\
3150 When REPLACE is non-nil, the value is the number of characters actually read,\n\
3151 which is often less than the number of characters to be read.\n\
3152 This does code conversion according to the value of\n\
3153 `coding-system-for-read' or `file-coding-system-alist',\n\
3154 and sets the variable `last-coding-system-used' to the coding system\n\
3156 (filename
, visit
, beg
, end
, replace
)
3157 Lisp_Object filename
, visit
, beg
, end
, replace
;
3162 register int how_much
;
3163 register int unprocessed
;
3164 int count
= specpdl_ptr
- specpdl
;
3165 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3166 Lisp_Object handler
, val
, insval
, orig_filename
;
3169 int not_regular
= 0;
3170 char read_buf
[READ_BUF_SIZE
];
3171 struct coding_system coding
;
3172 unsigned char buffer
[1 << 14];
3173 int replace_handled
= 0;
3174 int set_coding_system
= 0;
3176 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3177 error ("Cannot do file visiting in an indirect buffer");
3179 if (!NILP (current_buffer
->read_only
))
3180 Fbarf_if_buffer_read_only ();
3184 orig_filename
= Qnil
;
3186 GCPRO4 (filename
, val
, p
, orig_filename
);
3188 CHECK_STRING (filename
, 0);
3189 filename
= Fexpand_file_name (filename
, Qnil
);
3191 /* If the file name has special constructs in it,
3192 call the corresponding file handler. */
3193 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3194 if (!NILP (handler
))
3196 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3197 visit
, beg
, end
, replace
);
3201 orig_filename
= filename
;
3202 filename
= ENCODE_FILE (filename
);
3207 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3209 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
3210 || fstat (fd
, &st
) < 0)
3211 #endif /* not APOLLO */
3213 if (fd
>= 0) close (fd
);
3216 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3219 if (!NILP (Vcoding_system_for_read
))
3220 current_buffer
->buffer_file_coding_system
= Vcoding_system_for_read
;
3225 /* This code will need to be changed in order to work on named
3226 pipes, and it's probably just not worth it. So we should at
3227 least signal an error. */
3228 if (!S_ISREG (st
.st_mode
))
3235 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3236 Fsignal (Qfile_error
,
3237 Fcons (build_string ("not a regular file"),
3238 Fcons (orig_filename
, Qnil
)));
3243 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
3246 /* Replacement should preserve point as it preserves markers. */
3247 if (!NILP (replace
))
3248 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3250 record_unwind_protect (close_file_unwind
, make_number (fd
));
3252 /* Supposedly happens on VMS. */
3253 if (! not_regular
&& st
.st_size
< 0)
3254 error ("File size is negative");
3256 if (!NILP (beg
) || !NILP (end
))
3258 error ("Attempt to visit less than an entire file");
3261 CHECK_NUMBER (beg
, 0);
3263 XSETFASTINT (beg
, 0);
3266 CHECK_NUMBER (end
, 0);
3271 XSETINT (end
, st
.st_size
);
3272 if (XINT (end
) != st
.st_size
)
3273 error ("Maximum buffer size exceeded");
3277 /* Decide the coding-system of the file. */
3279 Lisp_Object val
= Qnil
;
3281 if (!NILP (Vcoding_system_for_read
))
3282 val
= Vcoding_system_for_read
;
3285 if (! NILP (Vset_auto_coding_function
))
3287 /* Find a coding system specified in the heading two lines
3288 or in the tailing several lines of the file. We assume
3289 that the 1K-byte and 3K-byte for heading and tailing
3290 respectively are sufficient fot this purpose. */
3291 int how_many
, nread
;
3293 if (st
.st_size
<= (1024 * 4))
3294 nread
= read (fd
, read_buf
, 1024 * 4);
3297 nread
= read (fd
, read_buf
, 1024);
3300 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3301 report_file_error ("Setting file position",
3302 Fcons (orig_filename
, Qnil
));
3303 nread
+= read (fd
, read_buf
+ nread
, 1024 * 3);
3308 error ("IO error reading %s: %s",
3309 XSTRING (orig_filename
)->data
, strerror (errno
));
3313 /* Always make this a unibyte string
3314 because we have not yet decoded it. */
3315 tem
= make_unibyte_string (read_buf
, nread
);
3316 val
= call1 (Vset_auto_coding_function
, tem
);
3317 /* Rewind the file for the actual read done later. */
3318 if (lseek (fd
, 0, 0) < 0)
3319 report_file_error ("Setting file position",
3320 Fcons (orig_filename
, Qnil
));
3325 Lisp_Object args
[6], coding_systems
;
3327 args
[0] = Qinsert_file_contents
, args
[1] = orig_filename
,
3328 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3329 coding_systems
= Ffind_operation_coding_system (6, args
);
3330 if (CONSP (coding_systems
)) val
= XCONS (coding_systems
)->car
;
3334 if (NILP (Vcoding_system_for_read
)
3335 && NILP (current_buffer
->enable_multibyte_characters
))
3337 /* We must suppress all text conversion except for end-of-line
3339 struct coding_system coding_temp
;
3341 setup_coding_system (Fcheck_coding_system (val
), &coding_temp
);
3342 setup_coding_system (Qraw_text
, &coding
);
3343 coding
.eol_type
= coding_temp
.eol_type
;
3346 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3349 /* If requested, replace the accessible part of the buffer
3350 with the file contents. Avoid replacing text at the
3351 beginning or end of the buffer that matches the file contents;
3352 that preserves markers pointing to the unchanged parts.
3354 Here we implement this feature in an optimized way
3355 for the case where code conversion is NOT needed.
3356 The following if-statement handles the case of conversion
3357 in a less optimal way.
3359 If the code conversion is "automatic" then we try using this
3360 method and hope for the best.
3361 But if we discover the need for conversion, we give up on this method
3362 and let the following if-statement handle the replace job. */
3364 && ! CODING_REQUIRE_DECODING (&coding
))
3366 /* same_at_start and same_at_end count bytes,
3367 because file access counts bytes
3368 and BEG and END count bytes. */
3369 int same_at_start
= BEGV_BYTE
;
3370 int same_at_end
= ZV_BYTE
;
3372 /* There is still a possibility we will find the need to do code
3373 conversion. If that happens, we set this variable to 1 to
3374 give up on handling REPLACE in the optimized way. */
3375 int giveup_match_end
= 0;
3377 if (XINT (beg
) != 0)
3379 if (lseek (fd
, XINT (beg
), 0) < 0)
3380 report_file_error ("Setting file position",
3381 Fcons (orig_filename
, Qnil
));
3386 /* Count how many chars at the start of the file
3387 match the text at the beginning of the buffer. */
3392 nread
= read (fd
, buffer
, sizeof buffer
);
3394 error ("IO error reading %s: %s",
3395 XSTRING (orig_filename
)->data
, strerror (errno
));
3396 else if (nread
== 0)
3399 if (coding
.type
== coding_type_undecided
)
3400 detect_coding (&coding
, buffer
, nread
);
3401 if (CODING_REQUIRE_DECODING (&coding
))
3402 /* We found that the file should be decoded somehow.
3403 Let's give up here. */
3405 giveup_match_end
= 1;
3409 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3410 detect_eol (&coding
, buffer
, nread
);
3411 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3412 && coding
.eol_type
!= CODING_EOL_LF
)
3413 /* We found that the format of eol should be decoded.
3414 Let's give up here. */
3416 giveup_match_end
= 1;
3421 while (bufpos
< nread
&& same_at_start
< ZV_BYTE
3422 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3423 same_at_start
++, bufpos
++;
3424 /* If we found a discrepancy, stop the scan.
3425 Otherwise loop around and scan the next bufferful. */
3426 if (bufpos
!= nread
)
3430 /* If the file matches the buffer completely,
3431 there's no need to replace anything. */
3432 if (same_at_start
- BEGV_BYTE
== XINT (end
))
3436 /* Truncate the buffer to the size of the file. */
3437 del_range_1 (same_at_start
, same_at_end
, 0);
3442 /* Count how many chars at the end of the file
3443 match the text at the end of the buffer. But, if we have
3444 already found that decoding is necessary, don't waste time. */
3445 while (!giveup_match_end
)
3447 int total_read
, nread
, bufpos
, curpos
, trial
;
3449 /* At what file position are we now scanning? */
3450 curpos
= XINT (end
) - (ZV_BYTE
- same_at_end
);
3451 /* If the entire file matches the buffer tail, stop the scan. */
3454 /* How much can we scan in the next step? */
3455 trial
= min (curpos
, sizeof buffer
);
3456 if (lseek (fd
, curpos
- trial
, 0) < 0)
3457 report_file_error ("Setting file position",
3458 Fcons (orig_filename
, Qnil
));
3461 while (total_read
< trial
)
3463 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
3465 error ("IO error reading %s: %s",
3466 XSTRING (orig_filename
)->data
, strerror (errno
));
3467 total_read
+= nread
;
3469 /* Scan this bufferful from the end, comparing with
3470 the Emacs buffer. */
3471 bufpos
= total_read
;
3472 /* Compare with same_at_start to avoid counting some buffer text
3473 as matching both at the file's beginning and at the end. */
3474 while (bufpos
> 0 && same_at_end
> same_at_start
3475 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3476 same_at_end
--, bufpos
--;
3478 /* If we found a discrepancy, stop the scan.
3479 Otherwise loop around and scan the preceding bufferful. */
3482 /* If this discrepancy is because of code conversion,
3483 we cannot use this method; giveup and try the other. */
3484 if (same_at_end
> same_at_start
3485 && FETCH_BYTE (same_at_end
- 1) >= 0200
3486 && ! NILP (current_buffer
->enable_multibyte_characters
)
3487 && (CODING_MAY_REQUIRE_DECODING (&coding
)))
3488 giveup_match_end
= 1;
3494 if (! giveup_match_end
)
3498 /* We win! We can handle REPLACE the optimized way. */
3500 /* Extends the end of non-matching text area to multibyte
3501 character boundary. */
3502 if (! NILP (current_buffer
->enable_multibyte_characters
))
3503 while (same_at_end
< ZV_BYTE
3504 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end
)))
3507 /* Don't try to reuse the same piece of text twice. */
3508 overlap
= (same_at_start
- BEGV_BYTE
3509 - (same_at_end
+ st
.st_size
- ZV
));
3511 same_at_end
+= overlap
;
3513 /* Arrange to read only the nonmatching middle part of the file. */
3514 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV_BYTE
));
3515 XSETFASTINT (end
, XINT (end
) - (ZV_BYTE
- same_at_end
));
3517 del_range_byte (same_at_start
, same_at_end
, 0);
3518 /* Insert from the file at the proper position. */
3519 temp
= BYTE_TO_CHAR (same_at_start
);
3520 SET_PT_BOTH (temp
, same_at_start
);
3522 /* If display currently starts at beginning of line,
3523 keep it that way. */
3524 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3525 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3527 replace_handled
= 1;
3531 /* If requested, replace the accessible part of the buffer
3532 with the file contents. Avoid replacing text at the
3533 beginning or end of the buffer that matches the file contents;
3534 that preserves markers pointing to the unchanged parts.
3536 Here we implement this feature for the case where code conversion
3537 is needed, in a simple way that needs a lot of memory.
3538 The preceding if-statement handles the case of no conversion
3539 in a more optimized way. */
3540 if (!NILP (replace
) && ! replace_handled
)
3542 int same_at_start
= BEGV_BYTE
;
3543 int same_at_end
= ZV_BYTE
;
3546 /* Make sure that the gap is large enough. */
3547 int bufsize
= 2 * st
.st_size
;
3548 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
3551 /* First read the whole file, performing code conversion into
3552 CONVERSION_BUFFER. */
3554 if (lseek (fd
, XINT (beg
), 0) < 0)
3556 free (conversion_buffer
);
3557 report_file_error ("Setting file position",
3558 Fcons (orig_filename
, Qnil
));
3561 total
= st
.st_size
; /* Total bytes in the file. */
3562 how_much
= 0; /* Bytes read from file so far. */
3563 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3564 unprocessed
= 0; /* Bytes not processed in previous loop. */
3566 while (how_much
< total
)
3568 /* try is reserved in some compilers (Microsoft C) */
3569 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3570 char *destination
= read_buf
+ unprocessed
;
3573 /* Allow quitting out of the actual I/O. */
3576 this = read (fd
, destination
, trytry
);
3579 if (this < 0 || this + unprocessed
== 0)
3587 if (CODING_MAY_REQUIRE_DECODING (&coding
))
3589 int require
, result
;
3591 this += unprocessed
;
3593 /* If we are using more space than estimated,
3594 make CONVERSION_BUFFER bigger. */
3595 require
= decoding_buffer_size (&coding
, this);
3596 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
3598 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
3599 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
3602 /* Convert this batch with results in CONVERSION_BUFFER. */
3603 if (how_much
>= total
) /* This is the last block. */
3604 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
3605 result
= decode_coding (&coding
, read_buf
,
3606 conversion_buffer
+ inserted
,
3607 this, bufsize
- inserted
);
3609 /* Save for next iteration whatever we didn't convert. */
3610 unprocessed
= this - coding
.consumed
;
3611 bcopy (read_buf
+ coding
.consumed
, read_buf
, unprocessed
);
3612 this = coding
.produced
;
3618 /* At this point, INSERTED is how many characters (i.e. bytes)
3619 are present in CONVERSION_BUFFER.
3620 HOW_MUCH should equal TOTAL,
3621 or should be <= 0 if we couldn't read the file. */
3625 free (conversion_buffer
);
3628 error ("IO error reading %s: %s",
3629 XSTRING (orig_filename
)->data
, strerror (errno
));
3630 else if (how_much
== -2)
3631 error ("maximum buffer size exceeded");
3634 /* Compare the beginning of the converted file
3635 with the buffer text. */
3638 while (bufpos
< inserted
&& same_at_start
< same_at_end
3639 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
3640 same_at_start
++, bufpos
++;
3642 /* If the file matches the buffer completely,
3643 there's no need to replace anything. */
3645 if (bufpos
== inserted
)
3647 free (conversion_buffer
);
3650 /* Truncate the buffer to the size of the file. */
3651 del_range_1 (same_at_start
, same_at_end
, 0);
3655 /* Scan this bufferful from the end, comparing with
3656 the Emacs buffer. */
3659 /* Compare with same_at_start to avoid counting some buffer text
3660 as matching both at the file's beginning and at the end. */
3661 while (bufpos
> 0 && same_at_end
> same_at_start
3662 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
3663 same_at_end
--, bufpos
--;
3665 /* Don't try to reuse the same piece of text twice. */
3666 overlap
= same_at_start
- BEGV_BYTE
- (same_at_end
+ inserted
- ZV_BYTE
);
3668 same_at_end
+= overlap
;
3670 /* If display currently starts at beginning of line,
3671 keep it that way. */
3672 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3673 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3675 /* Replace the chars that we need to replace,
3676 and update INSERTED to equal the number of bytes
3677 we are taking from the file. */
3678 inserted
-= (Z_BYTE
- same_at_end
) + (same_at_start
- BEG_BYTE
);
3679 del_range_byte (same_at_start
, same_at_end
, 0);
3680 SET_PT_BOTH (GPT
, GPT_BYTE
);
3682 insert_1 (conversion_buffer
+ same_at_start
- BEG_BYTE
, inserted
,
3685 free (conversion_buffer
);
3694 register Lisp_Object temp
;
3696 total
= XINT (end
) - XINT (beg
);
3698 /* Make sure point-max won't overflow after this insertion. */
3699 XSETINT (temp
, total
);
3700 if (total
!= XINT (temp
))
3701 error ("Maximum buffer size exceeded");
3704 /* For a special file, all we can do is guess. */
3705 total
= READ_BUF_SIZE
;
3707 if (NILP (visit
) && total
> 0)
3708 prepare_to_modify_buffer (PT
, PT
, NULL
);
3711 if (GAP_SIZE
< total
)
3712 make_gap (total
- GAP_SIZE
);
3714 if (XINT (beg
) != 0 || !NILP (replace
))
3716 if (lseek (fd
, XINT (beg
), 0) < 0)
3717 report_file_error ("Setting file position",
3718 Fcons (orig_filename
, Qnil
));
3721 /* In the following loop, HOW_MUCH contains the total bytes read so
3722 far for a regular file, and not changed for a special file. But,
3723 before exiting the loop, it is set to a negative value if I/O
3726 /* Total bytes inserted. */
3728 /* Here, we don't do code conversion in the loop. It is done by
3729 code_convert_region after all data are read into the buffer. */
3730 while (how_much
< total
)
3732 /* try is reserved in some compilers (Microsoft C) */
3733 int trytry
= min (total
- how_much
, READ_BUF_SIZE
);
3736 /* For a special file, GAP_SIZE should be checked every time. */
3737 if (not_regular
&& GAP_SIZE
< trytry
)
3738 make_gap (total
- GAP_SIZE
);
3740 /* Allow quitting out of the actual I/O. */
3743 this = read (fd
, BYTE_POS_ADDR (PT_BYTE
+ inserted
- 1) + 1, trytry
);
3760 /* For a regular file, where TOTAL is the real size,
3761 count HOW_MUCH to compare with it.
3762 For a special file, where TOTAL is just a buffer size,
3763 so don't bother counting in HOW_MUCH.
3764 (INSERTED is where we count the number of characters inserted.) */
3771 /* Put an anchor to ensure multi-byte form ends at gap. */
3776 /* Discard the unwind protect for closing the file. */
3780 error ("IO error reading %s: %s",
3781 XSTRING (orig_filename
)->data
, strerror (errno
));
3785 if (CODING_MAY_REQUIRE_DECODING (&coding
))
3787 /* Here, we don't have to consider byte combining (see the
3788 comment below) because code_convert_region takes care of
3790 code_convert_region (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
3792 inserted
= (NILP (current_buffer
->enable_multibyte_characters
)
3793 ? coding
.produced
: coding
.produced_char
);
3795 else if (!NILP (current_buffer
->enable_multibyte_characters
))
3797 int inserted_byte
= inserted
;
3799 /* There's a possibility that we must combine bytes at the
3800 head (resp. the tail) of the just inserted text with the
3801 bytes before (resp. after) the gap to form a single
3803 inserted
= multibyte_chars_in_text (GPT_ADDR
- inserted
, inserted
);
3804 adjust_after_insert (PT
, PT_BYTE
,
3805 PT
+ inserted_byte
, PT_BYTE
+ inserted_byte
,
3809 adjust_after_insert (PT
, PT_BYTE
, PT
+ inserted
, PT_BYTE
+ inserted
,
3813 /* Use the conversion type to determine buffer-file-type
3814 (find-buffer-file-type is now used to help determine the
3816 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3817 && coding
.eol_type
!= CODING_EOL_LF
)
3818 current_buffer
->buffer_file_type
= Qnil
;
3820 current_buffer
->buffer_file_type
= Qt
;
3824 set_coding_system
= 1;
3831 if (!EQ (current_buffer
->undo_list
, Qt
))
3832 current_buffer
->undo_list
= Qnil
;
3834 stat (XSTRING (filename
)->data
, &st
);
3839 current_buffer
->modtime
= st
.st_mtime
;
3840 current_buffer
->filename
= orig_filename
;
3843 SAVE_MODIFF
= MODIFF
;
3844 current_buffer
->auto_save_modified
= MODIFF
;
3845 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3846 #ifdef CLASH_DETECTION
3849 if (!NILP (current_buffer
->file_truename
))
3850 unlock_file (current_buffer
->file_truename
);
3851 unlock_file (filename
);
3853 #endif /* CLASH_DETECTION */
3855 Fsignal (Qfile_error
,
3856 Fcons (build_string ("not a regular file"),
3857 Fcons (orig_filename
, Qnil
)));
3859 /* If visiting nonexistent file, return nil. */
3860 if (current_buffer
->modtime
== -1)
3861 report_file_error ("Opening input file", Fcons (orig_filename
, Qnil
));
3864 /* Decode file format */
3867 insval
= call3 (Qformat_decode
,
3868 Qnil
, make_number (inserted
), visit
);
3869 CHECK_NUMBER (insval
, 0);
3870 inserted
= XFASTINT (insval
);
3873 /* Call after-change hooks for the inserted text, aside from the case
3874 of normal visiting (not with REPLACE), which is done in a new buffer
3875 "before" the buffer is changed. */
3876 if (inserted
> 0 && total
> 0
3877 && (NILP (visit
) || !NILP (replace
)))
3878 signal_after_change (PT
, 0, inserted
);
3880 if (set_coding_system
)
3881 Vlast_coding_system_used
= coding
.symbol
;
3885 p
= Vafter_insert_file_functions
;
3888 insval
= call1 (Fcar (p
), make_number (inserted
));
3891 CHECK_NUMBER (insval
, 0);
3892 inserted
= XFASTINT (insval
);
3899 /* ??? Retval needs to be dealt with in all cases consistently. */
3901 val
= Fcons (orig_filename
,
3902 Fcons (make_number (inserted
),
3905 RETURN_UNGCPRO (unbind_to (count
, val
));
3908 static Lisp_Object build_annotations
P_ ((Lisp_Object
, Lisp_Object
,
3911 /* If build_annotations switched buffers, switch back to BUF.
3912 Kill the temporary buffer that was selected in the meantime.
3914 Since this kill only the last temporary buffer, some buffers remain
3915 not killed if build_annotations switched buffers more than once.
3919 build_annotations_unwind (buf
)
3924 if (XBUFFER (buf
) == current_buffer
)
3926 tembuf
= Fcurrent_buffer ();
3928 Fkill_buffer (tembuf
);
3932 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 7,
3933 "r\nFWrite region to file: \ni\ni\ni\np",
3934 "Write current region into specified file.\n\
3935 When called from a program, takes three arguments:\n\
3936 START, END and FILENAME. START and END are buffer positions.\n\
3937 Optional fourth argument APPEND if non-nil means\n\
3938 append to existing file contents (if any).\n\
3939 Optional fifth argument VISIT if t means\n\
3940 set the last-save-file-modtime of buffer to this file's modtime\n\
3941 and mark buffer not modified.\n\
3942 If VISIT is a string, it is a second file name;\n\
3943 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
3944 VISIT is also the file name to lock and unlock for clash detection.\n\
3945 If VISIT is neither t nor nil nor a string,\n\
3946 that means do not print the \"Wrote file\" message.\n\
3947 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
3948 use for locking and unlocking, overriding FILENAME and VISIT.\n\
3949 The optional seventh arg CONFIRM, if non-nil, says ask for confirmation\n\
3950 before overwriting an existing file.\n\
3951 Kludgy feature: if START is a string, then that string is written\n\
3952 to the file, instead of any buffer contents, and END is ignored.")
3953 (start
, end
, filename
, append
, visit
, lockname
, confirm
)
3954 Lisp_Object start
, end
, filename
, append
, visit
, lockname
, confirm
;
3962 int count
= specpdl_ptr
- specpdl
;
3965 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3967 Lisp_Object handler
;
3968 Lisp_Object visit_file
;
3969 Lisp_Object annotations
;
3970 Lisp_Object encoded_filename
;
3971 int visiting
, quietly
;
3972 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3973 struct buffer
*given_buffer
;
3975 int buffer_file_type
= O_BINARY
;
3977 struct coding_system coding
;
3979 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3980 error ("Cannot do file visiting in an indirect buffer");
3982 if (!NILP (start
) && !STRINGP (start
))
3983 validate_region (&start
, &end
);
3985 GCPRO4 (start
, filename
, visit
, lockname
);
3987 /* Decide the coding-system to encode the data with. */
3993 else if (!NILP (Vcoding_system_for_write
))
3994 val
= Vcoding_system_for_write
;
3995 else if (NILP (current_buffer
->enable_multibyte_characters
))
3997 /* If the variable `buffer-file-coding-system' is set locally,
3998 it means that the file was read with some kind of code
3999 conversion or the varialbe is explicitely set by users. We
4000 had better write it out with the same coding system even if
4001 `enable-multibyte-characters' is nil.
4003 If it is not set locally, we anyway have to convert EOL
4004 format if the default value of `buffer-file-coding-system'
4005 tells that it is not Unix-like (LF only) format. */
4006 val
= current_buffer
->buffer_file_coding_system
;
4007 if (NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
4009 struct coding_system coding_temp
;
4011 setup_coding_system (Fcheck_coding_system (val
), &coding_temp
);
4012 if (coding_temp
.eol_type
== CODING_EOL_CRLF
4013 || coding_temp
.eol_type
== CODING_EOL_CR
)
4015 setup_coding_system (Qraw_text
, &coding
);
4016 coding
.eol_type
= coding_temp
.eol_type
;
4017 goto done_setup_coding
;
4024 Lisp_Object args
[7], coding_systems
;
4026 args
[0] = Qwrite_region
; args
[1] = start
; args
[2] = end
;
4027 args
[3] = filename
; args
[4] = append
; args
[5] = visit
;
4029 coding_systems
= Ffind_operation_coding_system (7, args
);
4030 val
= (CONSP (coding_systems
) && !NILP (XCONS (coding_systems
)->cdr
)
4031 ? XCONS (coding_systems
)->cdr
4032 : current_buffer
->buffer_file_coding_system
);
4033 /* Confirm that VAL can surely encode the current region. */
4034 if (!NILP (Ffboundp (Vselect_safe_coding_system_function
)))
4035 val
= call3 (Vselect_safe_coding_system_function
, start
, end
, val
);
4037 setup_coding_system (Fcheck_coding_system (val
), &coding
);
4040 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
4041 coding
.mode
|= CODING_MODE_SELECTIVE_DISPLAY
;
4044 Vlast_coding_system_used
= coding
.symbol
;
4046 filename
= Fexpand_file_name (filename
, Qnil
);
4048 if (! NILP (confirm
))
4049 barf_or_query_if_file_exists (filename
, "overwrite", 1, 0, 1);
4051 if (STRINGP (visit
))
4052 visit_file
= Fexpand_file_name (visit
, Qnil
);
4054 visit_file
= filename
;
4057 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
4058 quietly
= !NILP (visit
);
4062 if (NILP (lockname
))
4063 lockname
= visit_file
;
4065 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
4067 /* If the file name has special constructs in it,
4068 call the corresponding file handler. */
4069 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
4070 /* If FILENAME has no handler, see if VISIT has one. */
4071 if (NILP (handler
) && STRINGP (visit
))
4072 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
4074 if (!NILP (handler
))
4077 val
= call6 (handler
, Qwrite_region
, start
, end
,
4078 filename
, append
, visit
);
4082 SAVE_MODIFF
= MODIFF
;
4083 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4084 current_buffer
->filename
= visit_file
;
4090 /* Special kludge to simplify auto-saving. */
4093 XSETFASTINT (start
, BEG
);
4094 XSETFASTINT (end
, Z
);
4097 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
4098 count1
= specpdl_ptr
- specpdl
;
4100 given_buffer
= current_buffer
;
4101 annotations
= build_annotations (start
, end
, coding
.pre_write_conversion
);
4102 if (current_buffer
!= given_buffer
)
4104 XSETFASTINT (start
, BEGV
);
4105 XSETFASTINT (end
, ZV
);
4108 #ifdef CLASH_DETECTION
4111 #if 0 /* This causes trouble for GNUS. */
4112 /* If we've locked this file for some other buffer,
4113 query before proceeding. */
4114 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
4115 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
4118 lock_file (lockname
);
4120 #endif /* CLASH_DETECTION */
4122 encoded_filename
= ENCODE_FILE (filename
);
4124 fn
= XSTRING (encoded_filename
)->data
;
4128 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
4129 #else /* not DOS_NT */
4130 desc
= open (fn
, O_WRONLY
);
4131 #endif /* not DOS_NT */
4133 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
))
4135 if (auto_saving
) /* Overwrite any previous version of autosave file */
4137 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4138 desc
= open (fn
, O_RDWR
);
4140 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4141 ? XSTRING (current_buffer
->filename
)->data
: 0,
4144 else /* Write to temporary name and rename if no errors */
4146 Lisp_Object temp_name
;
4147 temp_name
= Ffile_name_directory (filename
);
4149 if (!NILP (temp_name
))
4151 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4152 build_string ("$$SAVE$$")));
4153 fname
= XSTRING (filename
)->data
;
4154 fn
= XSTRING (temp_name
)->data
;
4155 desc
= creat_copy_attrs (fname
, fn
);
4158 /* If we can't open the temporary file, try creating a new
4159 version of the original file. VMS "creat" creates a
4160 new version rather than truncating an existing file. */
4163 desc
= creat (fn
, 0666);
4164 #if 0 /* This can clobber an existing file and fail to replace it,
4165 if the user runs out of space. */
4168 /* We can't make a new version;
4169 try to truncate and rewrite existing version if any. */
4171 desc
= open (fn
, O_RDWR
);
4177 desc
= creat (fn
, 0666);
4182 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
4183 S_IREAD
| S_IWRITE
);
4184 #else /* not DOS_NT */
4185 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
4186 #endif /* not DOS_NT */
4187 #endif /* not VMS */
4193 #ifdef CLASH_DETECTION
4195 if (!auto_saving
) unlock_file (lockname
);
4197 #endif /* CLASH_DETECTION */
4198 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4201 record_unwind_protect (close_file_unwind
, make_number (desc
));
4204 if (lseek (desc
, 0, 2) < 0)
4206 #ifdef CLASH_DETECTION
4207 if (!auto_saving
) unlock_file (lockname
);
4208 #endif /* CLASH_DETECTION */
4209 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4214 * Kludge Warning: The VMS C RTL likes to insert carriage returns
4215 * if we do writes that don't end with a carriage return. Furthermore
4216 * it cannot handle writes of more then 16K. The modified
4217 * version of "sys_write" in SYSDEP.C (see comment there) copes with
4218 * this EXCEPT for the last record (iff it doesn't end with a carriage
4219 * return). This implies that if your buffer doesn't end with a carriage
4220 * return, you get one free... tough. However it also means that if
4221 * we make two calls to sys_write (a la the following code) you can
4222 * get one at the gap as well. The easiest way to fix this (honest)
4223 * is to move the gap to the next newline (or the end of the buffer).
4228 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4229 move_gap (find_next_newline (GPT
, 1));
4231 /* Whether VMS or not, we must move the gap to the next of newline
4232 when we must put designation sequences at beginning of line. */
4233 if (INTEGERP (start
)
4234 && coding
.type
== coding_type_iso2022
4235 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
4236 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4238 int opoint
= PT
, opoint_byte
= PT_BYTE
;
4239 scan_newline (PT
, PT_BYTE
, ZV
, ZV_BYTE
, 1, 0);
4240 move_gap_both (PT
, PT_BYTE
);
4241 SET_PT_BOTH (opoint
, opoint_byte
);
4248 if (STRINGP (start
))
4250 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
4251 STRING_BYTES (XSTRING (start
)), 0, &annotations
,
4255 else if (XINT (start
) != XINT (end
))
4257 register int end1
= CHAR_TO_BYTE (XINT (end
));
4259 tem
= CHAR_TO_BYTE (XINT (start
));
4261 if (XINT (start
) < GPT
)
4263 failure
= 0 > a_write (desc
, BYTE_POS_ADDR (tem
),
4264 min (GPT_BYTE
, end1
) - tem
, tem
, &annotations
,
4269 if (XINT (end
) > GPT
&& !failure
)
4271 tem
= max (tem
, GPT_BYTE
);
4272 failure
= 0 > a_write (desc
, BYTE_POS_ADDR (tem
), end1
- tem
,
4273 tem
, &annotations
, &coding
);
4279 /* If file was empty, still need to write the annotations */
4280 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4281 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
, &coding
);
4285 if (CODING_REQUIRE_FLUSHING (&coding
)
4286 && !(coding
.mode
& CODING_MODE_LAST_BLOCK
)
4289 /* We have to flush out a data. */
4290 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
4291 failure
= 0 > e_write (desc
, "", 0, &coding
);
4298 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4299 Disk full in NFS may be reported here. */
4300 /* mib says that closing the file will try to write as fast as NFS can do
4301 it, and that means the fsync here is not crucial for autosave files. */
4302 if (!auto_saving
&& fsync (desc
) < 0)
4304 /* If fsync fails with EINTR, don't treat that as serious. */
4306 failure
= 1, save_errno
= errno
;
4310 /* Spurious "file has changed on disk" warnings have been
4311 observed on Suns as well.
4312 It seems that `close' can change the modtime, under nfs.
4314 (This has supposedly been fixed in Sunos 4,
4315 but who knows about all the other machines with NFS?) */
4318 /* On VMS and APOLLO, must do the stat after the close
4319 since closing changes the modtime. */
4322 /* Recall that #if defined does not work on VMS. */
4329 /* NFS can report a write failure now. */
4330 if (close (desc
) < 0)
4331 failure
= 1, save_errno
= errno
;
4334 /* If we wrote to a temporary name and had no errors, rename to real name. */
4338 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
4346 /* Discard the unwind protect for close_file_unwind. */
4347 specpdl_ptr
= specpdl
+ count1
;
4348 /* Restore the original current buffer. */
4349 visit_file
= unbind_to (count
, visit_file
);
4351 #ifdef CLASH_DETECTION
4353 unlock_file (lockname
);
4354 #endif /* CLASH_DETECTION */
4356 /* Do this before reporting IO error
4357 to avoid a "file has changed on disk" warning on
4358 next attempt to save. */
4360 current_buffer
->modtime
= st
.st_mtime
;
4363 error ("IO error writing %s: %s", XSTRING (filename
)->data
,
4364 strerror (save_errno
));
4368 SAVE_MODIFF
= MODIFF
;
4369 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4370 current_buffer
->filename
= visit_file
;
4371 update_mode_lines
++;
4377 message_with_string ("Wrote %s", visit_file
, 1);
4382 Lisp_Object
merge ();
4384 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4385 "Return t if (car A) is numerically less than (car B).")
4389 return Flss (Fcar (a
), Fcar (b
));
4392 /* Build the complete list of annotations appropriate for writing out
4393 the text between START and END, by calling all the functions in
4394 write-region-annotate-functions and merging the lists they return.
4395 If one of these functions switches to a different buffer, we assume
4396 that buffer contains altered text. Therefore, the caller must
4397 make sure to restore the current buffer in all cases,
4398 as save-excursion would do. */
4401 build_annotations (start
, end
, pre_write_conversion
)
4402 Lisp_Object start
, end
, pre_write_conversion
;
4404 Lisp_Object annotations
;
4406 struct gcpro gcpro1
, gcpro2
;
4407 Lisp_Object original_buffer
;
4409 XSETBUFFER (original_buffer
, current_buffer
);
4412 p
= Vwrite_region_annotate_functions
;
4413 GCPRO2 (annotations
, p
);
4416 struct buffer
*given_buffer
= current_buffer
;
4417 Vwrite_region_annotations_so_far
= annotations
;
4418 res
= call2 (Fcar (p
), start
, end
);
4419 /* If the function makes a different buffer current,
4420 assume that means this buffer contains altered text to be output.
4421 Reset START and END from the buffer bounds
4422 and discard all previous annotations because they should have
4423 been dealt with by this function. */
4424 if (current_buffer
!= given_buffer
)
4426 XSETFASTINT (start
, BEGV
);
4427 XSETFASTINT (end
, ZV
);
4430 Flength (res
); /* Check basic validity of return value */
4431 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4435 /* Now do the same for annotation functions implied by the file-format */
4436 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
4437 p
= Vauto_save_file_format
;
4439 p
= current_buffer
->file_format
;
4442 struct buffer
*given_buffer
= current_buffer
;
4443 Vwrite_region_annotations_so_far
= annotations
;
4444 res
= call4 (Qformat_annotate_function
, Fcar (p
), start
, end
,
4446 if (current_buffer
!= given_buffer
)
4448 XSETFASTINT (start
, BEGV
);
4449 XSETFASTINT (end
, ZV
);
4453 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4457 /* At last, do the same for the function PRE_WRITE_CONVERSION
4458 implied by the current coding-system. */
4459 if (!NILP (pre_write_conversion
))
4461 struct buffer
*given_buffer
= current_buffer
;
4462 Vwrite_region_annotations_so_far
= annotations
;
4463 res
= call2 (pre_write_conversion
, start
, end
);
4465 annotations
= (current_buffer
!= given_buffer
4467 : merge (annotations
, res
, Qcar_less_than_car
));
4474 /* Write to descriptor DESC the NBYTES bytes starting at ADDR,
4475 assuming they start at byte position BYTEPOS in the buffer.
4476 Intersperse with them the annotations from *ANNOT
4477 which fall within the range of byte positions BYTEPOS to BYTEPOS + NBYTES,
4478 each at its appropriate position.
4480 We modify *ANNOT by discarding elements as we use them up.
4482 The return value is negative in case of system call failure. */
4485 a_write (desc
, addr
, nbytes
, bytepos
, annot
, coding
)
4487 register char *addr
;
4488 register int nbytes
;
4491 struct coding_system
*coding
;
4495 int lastpos
= bytepos
+ nbytes
;
4497 while (NILP (*annot
) || CONSP (*annot
))
4499 tem
= Fcar_safe (Fcar (*annot
));
4500 nextpos
= bytepos
- 1;
4502 nextpos
= CHAR_TO_BYTE (XFASTINT (tem
));
4504 /* If there are no more annotations in this range,
4505 output the rest of the range all at once. */
4506 if (! (nextpos
>= bytepos
&& nextpos
<= lastpos
))
4507 return e_write (desc
, addr
, lastpos
- bytepos
, coding
);
4509 /* Output buffer text up to the next annotation's position. */
4510 if (nextpos
> bytepos
)
4512 if (0 > e_write (desc
, addr
, nextpos
- bytepos
, coding
))
4514 addr
+= nextpos
- bytepos
;
4517 /* Output the annotation. */
4518 tem
= Fcdr (Fcar (*annot
));
4521 if (0 > e_write (desc
, XSTRING (tem
)->data
, STRING_BYTES (XSTRING (tem
)),
4525 *annot
= Fcdr (*annot
);
4530 #ifndef WRITE_BUF_SIZE
4531 #define WRITE_BUF_SIZE (16 * 1024)
4534 /* Write NBYTES bytes starting at ADDR into descriptor DESC,
4535 encoding them with coding system CODING. */
4538 e_write (desc
, addr
, nbytes
, coding
)
4540 register char *addr
;
4541 register int nbytes
;
4542 struct coding_system
*coding
;
4544 char buf
[WRITE_BUF_SIZE
];
4546 /* We used to have a code for handling selective display here. But,
4547 now it is handled within encode_coding. */
4550 encode_coding (coding
, addr
, buf
, nbytes
, WRITE_BUF_SIZE
);
4551 nbytes
-= coding
->consumed
, addr
+= coding
->consumed
;
4552 if (coding
->produced
> 0)
4554 coding
->produced
-= write (desc
, buf
, coding
->produced
);
4555 if (coding
->produced
) return -1;
4563 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
4564 Sverify_visited_file_modtime
, 1, 1, 0,
4565 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
4566 This means that the file has not been changed since it was visited or saved.")
4572 Lisp_Object handler
;
4573 Lisp_Object filename
;
4575 CHECK_BUFFER (buf
, 0);
4578 if (!STRINGP (b
->filename
)) return Qt
;
4579 if (b
->modtime
== 0) return Qt
;
4581 /* If the file name has special constructs in it,
4582 call the corresponding file handler. */
4583 handler
= Ffind_file_name_handler (b
->filename
,
4584 Qverify_visited_file_modtime
);
4585 if (!NILP (handler
))
4586 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
4588 filename
= ENCODE_FILE (b
->filename
);
4590 if (stat (XSTRING (filename
)->data
, &st
) < 0)
4592 /* If the file doesn't exist now and didn't exist before,
4593 we say that it isn't modified, provided the error is a tame one. */
4594 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
4599 if (st
.st_mtime
== b
->modtime
4600 /* If both are positive, accept them if they are off by one second. */
4601 || (st
.st_mtime
> 0 && b
->modtime
> 0
4602 && (st
.st_mtime
== b
->modtime
+ 1
4603 || st
.st_mtime
== b
->modtime
- 1)))
4608 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
4609 Sclear_visited_file_modtime
, 0, 0, 0,
4610 "Clear out records of last mod time of visited file.\n\
4611 Next attempt to save will certainly not complain of a discrepancy.")
4614 current_buffer
->modtime
= 0;
4618 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
4619 Svisited_file_modtime
, 0, 0, 0,
4620 "Return the current buffer's recorded visited file modification time.\n\
4621 The value is a list of the form (HIGH . LOW), like the time values\n\
4622 that `file-attributes' returns.")
4625 return long_to_cons ((unsigned long) current_buffer
->modtime
);
4628 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
4629 Sset_visited_file_modtime
, 0, 1, 0,
4630 "Update buffer's recorded modification time from the visited file's time.\n\
4631 Useful if the buffer was not read from the file normally\n\
4632 or if the file itself has been changed for some known benign reason.\n\
4633 An argument specifies the modification time value to use\n\
4634 \(instead of that of the visited file), in the form of a list\n\
4635 \(HIGH . LOW) or (HIGH LOW).")
4637 Lisp_Object time_list
;
4639 if (!NILP (time_list
))
4640 current_buffer
->modtime
= cons_to_long (time_list
);
4643 register Lisp_Object filename
;
4645 Lisp_Object handler
;
4647 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
4649 /* If the file name has special constructs in it,
4650 call the corresponding file handler. */
4651 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
4652 if (!NILP (handler
))
4653 /* The handler can find the file name the same way we did. */
4654 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
4656 filename
= ENCODE_FILE (filename
);
4658 if (stat (XSTRING (filename
)->data
, &st
) >= 0)
4659 current_buffer
->modtime
= st
.st_mtime
;
4669 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 1);
4670 Fsleep_for (make_number (1), Qnil
);
4671 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
4672 Fsleep_for (make_number (1), Qnil
);
4673 message_with_string ("Autosaving...error for %s", current_buffer
->name
, 0);
4674 Fsleep_for (make_number (1), Qnil
);
4684 /* Get visited file's mode to become the auto save file's mode. */
4685 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
4686 /* But make sure we can overwrite it later! */
4687 auto_save_mode_bits
= st
.st_mode
| 0600;
4689 auto_save_mode_bits
= 0666;
4692 Fwrite_region (Qnil
, Qnil
,
4693 current_buffer
->auto_save_file_name
,
4694 Qnil
, Qlambda
, Qnil
, Qnil
);
4698 do_auto_save_unwind (stream
) /* used as unwind-protect function */
4703 fclose ((FILE *) (XFASTINT (XCONS (stream
)->car
) << 16
4704 | XFASTINT (XCONS (stream
)->cdr
)));
4709 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
4712 minibuffer_auto_raise
= XINT (value
);
4716 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
4717 "Auto-save all buffers that need it.\n\
4718 This is all buffers that have auto-saving enabled\n\
4719 and are changed since last auto-saved.\n\
4720 Auto-saving writes the buffer into a file\n\
4721 so that your editing is not lost if the system crashes.\n\
4722 This file is not the file you visited; that changes only when you save.\n\
4723 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
4724 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
4725 A non-nil CURRENT-ONLY argument means save only current buffer.")
4726 (no_message
, current_only
)
4727 Lisp_Object no_message
, current_only
;
4729 struct buffer
*old
= current_buffer
, *b
;
4730 Lisp_Object tail
, buf
;
4732 char *omessage
= echo_area_glyphs
;
4733 int omessage_length
= echo_area_glyphs_length
;
4734 int oldmultibyte
= message_enable_multibyte
;
4735 int do_handled_files
;
4738 Lisp_Object lispstream
;
4739 int count
= specpdl_ptr
- specpdl
;
4741 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
4743 /* Ordinarily don't quit within this function,
4744 but don't make it impossible to quit (in case we get hung in I/O). */
4748 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
4749 point to non-strings reached from Vbuffer_alist. */
4754 if (!NILP (Vrun_hooks
))
4755 call1 (Vrun_hooks
, intern ("auto-save-hook"));
4757 if (STRINGP (Vauto_save_list_file_name
))
4759 Lisp_Object listfile
;
4760 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
4761 stream
= fopen (XSTRING (listfile
)->data
, "w");
4764 /* Arrange to close that file whether or not we get an error.
4765 Also reset auto_saving to 0. */
4766 lispstream
= Fcons (Qnil
, Qnil
);
4767 XSETFASTINT (XCONS (lispstream
)->car
, (EMACS_UINT
)stream
>> 16);
4768 XSETFASTINT (XCONS (lispstream
)->cdr
, (EMACS_UINT
)stream
& 0xffff);
4779 record_unwind_protect (do_auto_save_unwind
, lispstream
);
4780 record_unwind_protect (do_auto_save_unwind_1
,
4781 make_number (minibuffer_auto_raise
));
4782 minibuffer_auto_raise
= 0;
4785 /* First, save all files which don't have handlers. If Emacs is
4786 crashing, the handlers may tweak what is causing Emacs to crash
4787 in the first place, and it would be a shame if Emacs failed to
4788 autosave perfectly ordinary files because it couldn't handle some
4790 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
4791 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
4793 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
4796 /* Record all the buffers that have auto save mode
4797 in the special file that lists them. For each of these buffers,
4798 Record visited name (if any) and auto save name. */
4799 if (STRINGP (b
->auto_save_file_name
)
4800 && stream
!= NULL
&& do_handled_files
== 0)
4802 if (!NILP (b
->filename
))
4804 fwrite (XSTRING (b
->filename
)->data
, 1,
4805 STRING_BYTES (XSTRING (b
->filename
)), stream
);
4807 putc ('\n', stream
);
4808 fwrite (XSTRING (b
->auto_save_file_name
)->data
, 1,
4809 STRING_BYTES (XSTRING (b
->auto_save_file_name
)), stream
);
4810 putc ('\n', stream
);
4813 if (!NILP (current_only
)
4814 && b
!= current_buffer
)
4817 /* Don't auto-save indirect buffers.
4818 The base buffer takes care of it. */
4822 /* Check for auto save enabled
4823 and file changed since last auto save
4824 and file changed since last real save. */
4825 if (STRINGP (b
->auto_save_file_name
)
4826 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
4827 && b
->auto_save_modified
< BUF_MODIFF (b
)
4828 /* -1 means we've turned off autosaving for a while--see below. */
4829 && XINT (b
->save_length
) >= 0
4830 && (do_handled_files
4831 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
4834 EMACS_TIME before_time
, after_time
;
4836 EMACS_GET_TIME (before_time
);
4838 /* If we had a failure, don't try again for 20 minutes. */
4839 if (b
->auto_save_failure_time
>= 0
4840 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
4843 if ((XFASTINT (b
->save_length
) * 10
4844 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
4845 /* A short file is likely to change a large fraction;
4846 spare the user annoying messages. */
4847 && XFASTINT (b
->save_length
) > 5000
4848 /* These messages are frequent and annoying for `*mail*'. */
4849 && !EQ (b
->filename
, Qnil
)
4850 && NILP (no_message
))
4852 /* It has shrunk too much; turn off auto-saving here. */
4853 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
4854 message_with_string ("Buffer %s has shrunk a lot; auto save turned off there",
4856 minibuffer_auto_raise
= 0;
4857 /* Turn off auto-saving until there's a real save,
4858 and prevent any more warnings. */
4859 XSETINT (b
->save_length
, -1);
4860 Fsleep_for (make_number (1), Qnil
);
4863 set_buffer_internal (b
);
4864 if (!auto_saved
&& NILP (no_message
))
4865 message1 ("Auto-saving...");
4866 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
4868 b
->auto_save_modified
= BUF_MODIFF (b
);
4869 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4870 set_buffer_internal (old
);
4872 EMACS_GET_TIME (after_time
);
4874 /* If auto-save took more than 60 seconds,
4875 assume it was an NFS failure that got a timeout. */
4876 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
4877 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
4881 /* Prevent another auto save till enough input events come in. */
4882 record_auto_save ();
4884 if (auto_saved
&& NILP (no_message
))
4888 sit_for (1, 0, 0, 0, 0);
4889 message2 (omessage
, omessage_length
, oldmultibyte
);
4892 message1 ("Auto-saving...done");
4897 unbind_to (count
, Qnil
);
4901 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
4902 Sset_buffer_auto_saved
, 0, 0, 0,
4903 "Mark current buffer as auto-saved with its current text.\n\
4904 No auto-save file will be written until the buffer changes again.")
4907 current_buffer
->auto_save_modified
= MODIFF
;
4908 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4909 current_buffer
->auto_save_failure_time
= -1;
4913 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
4914 Sclear_buffer_auto_save_failure
, 0, 0, 0,
4915 "Clear any record of a recent auto-save failure in the current buffer.")
4918 current_buffer
->auto_save_failure_time
= -1;
4922 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
4924 "Return t if buffer has been auto-saved since last read in or saved.")
4927 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
4930 /* Reading and completing file names */
4931 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
4933 /* In the string VAL, change each $ to $$ and return the result. */
4936 double_dollars (val
)
4939 register unsigned char *old
, *new;
4943 osize
= STRING_BYTES (XSTRING (val
));
4945 /* Count the number of $ characters. */
4946 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
4947 if (*old
++ == '$') count
++;
4950 old
= XSTRING (val
)->data
;
4951 val
= make_uninit_multibyte_string (XSTRING (val
)->size
+ count
,
4953 new = XSTRING (val
)->data
;
4954 for (n
= osize
; n
> 0; n
--)
4967 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
4969 "Internal subroutine for read-file-name. Do not call this.")
4970 (string
, dir
, action
)
4971 Lisp_Object string
, dir
, action
;
4972 /* action is nil for complete, t for return list of completions,
4973 lambda for verify final value */
4975 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
4977 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4979 CHECK_STRING (string
, 0);
4986 /* No need to protect ACTION--we only compare it with t and nil. */
4987 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
4989 if (XSTRING (string
)->size
== 0)
4991 if (EQ (action
, Qlambda
))
4999 orig_string
= string
;
5000 string
= Fsubstitute_in_file_name (string
);
5001 changed
= NILP (Fstring_equal (string
, orig_string
));
5002 name
= Ffile_name_nondirectory (string
);
5003 val
= Ffile_name_directory (string
);
5005 realdir
= Fexpand_file_name (val
, realdir
);
5010 specdir
= Ffile_name_directory (string
);
5011 val
= Ffile_name_completion (name
, realdir
);
5016 return double_dollars (string
);
5020 if (!NILP (specdir
))
5021 val
= concat2 (specdir
, val
);
5023 return double_dollars (val
);
5026 #endif /* not VMS */
5030 if (EQ (action
, Qt
))
5031 return Ffile_name_all_completions (name
, realdir
);
5032 /* Only other case actually used is ACTION = lambda */
5034 /* Supposedly this helps commands such as `cd' that read directory names,
5035 but can someone explain how it helps them? -- RMS */
5036 if (XSTRING (name
)->size
== 0)
5039 return Ffile_exists_p (string
);
5042 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
5043 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
5044 Value is not expanded---you must call `expand-file-name' yourself.\n\
5045 Default name to DEFAULT-FILENAME if user enters a null string.\n\
5046 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
5047 except that if INITIAL is specified, that combined with DIR is used.)\n\
5048 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
5049 Non-nil and non-t means also require confirmation after completion.\n\
5050 Fifth arg INITIAL specifies text to start with.\n\
5051 DIR defaults to current buffer's directory default.")
5052 (prompt
, dir
, default_filename
, mustmatch
, initial
)
5053 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
5055 Lisp_Object val
, insdef
, insdef1
, tem
;
5056 struct gcpro gcpro1
, gcpro2
;
5057 register char *homedir
;
5058 int replace_in_history
= 0;
5059 int add_to_history
= 0;
5063 dir
= current_buffer
->directory
;
5064 if (NILP (default_filename
))
5066 if (! NILP (initial
))
5067 default_filename
= Fexpand_file_name (initial
, dir
);
5069 default_filename
= current_buffer
->filename
;
5072 /* If dir starts with user's homedir, change that to ~. */
5073 homedir
= (char *) egetenv ("HOME");
5075 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
5076 CORRECT_DIR_SEPS (homedir
);
5080 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
5081 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
5083 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
5084 STRING_BYTES (XSTRING (dir
)) - strlen (homedir
) + 1);
5085 XSTRING (dir
)->data
[0] = '~';
5088 if (insert_default_directory
&& STRINGP (dir
))
5091 if (!NILP (initial
))
5093 Lisp_Object args
[2], pos
;
5097 insdef
= Fconcat (2, args
);
5098 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
5099 insdef1
= Fcons (double_dollars (insdef
), pos
);
5102 insdef1
= double_dollars (insdef
);
5104 else if (STRINGP (initial
))
5107 insdef1
= Fcons (double_dollars (insdef
), make_number (0));
5110 insdef
= Qnil
, insdef1
= Qnil
;
5113 count
= specpdl_ptr
- specpdl
;
5114 specbind (intern ("completion-ignore-case"), Qt
);
5117 GCPRO2 (insdef
, default_filename
);
5118 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
5119 dir
, mustmatch
, insdef1
,
5120 Qfile_name_history
, default_filename
, Qnil
);
5122 tem
= Fsymbol_value (Qfile_name_history
);
5123 if (CONSP (tem
) && EQ (XCONS (tem
)->car
, val
))
5124 replace_in_history
= 1;
5126 /* If Fcompleting_read returned the inserted default string itself
5127 (rather than a new string with the same contents),
5128 it has to mean that the user typed RET with the minibuffer empty.
5129 In that case, we really want to return ""
5130 so that commands such as set-visited-file-name can distinguish. */
5131 if (EQ (val
, default_filename
))
5133 /* In this case, Fcompleting_read has not added an element
5134 to the history. Maybe we should. */
5135 if (! replace_in_history
)
5138 val
= build_string ("");
5142 unbind_to (count
, Qnil
);
5147 error ("No file name specified");
5149 tem
= Fstring_equal (val
, insdef
);
5151 if (!NILP (tem
) && !NILP (default_filename
))
5152 val
= default_filename
;
5153 else if (XSTRING (val
)->size
== 0 && NILP (insdef
))
5155 if (!NILP (default_filename
))
5156 val
= default_filename
;
5158 error ("No default file name");
5160 val
= Fsubstitute_in_file_name (val
);
5162 if (replace_in_history
)
5163 /* Replace what Fcompleting_read added to the history
5164 with what we will actually return. */
5165 XCONS (Fsymbol_value (Qfile_name_history
))->car
= val
;
5166 else if (add_to_history
)
5168 /* Add the value to the history--but not if it matches
5169 the last value already there. */
5170 tem
= Fsymbol_value (Qfile_name_history
);
5171 if (! CONSP (tem
) || NILP (Fequal (XCONS (tem
)->car
, val
)))
5172 Fset (Qfile_name_history
,
5181 Qexpand_file_name
= intern ("expand-file-name");
5182 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
5183 Qdirectory_file_name
= intern ("directory-file-name");
5184 Qfile_name_directory
= intern ("file-name-directory");
5185 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
5186 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
5187 Qfile_name_as_directory
= intern ("file-name-as-directory");
5188 Qcopy_file
= intern ("copy-file");
5189 Qmake_directory_internal
= intern ("make-directory-internal");
5190 Qdelete_directory
= intern ("delete-directory");
5191 Qdelete_file
= intern ("delete-file");
5192 Qrename_file
= intern ("rename-file");
5193 Qadd_name_to_file
= intern ("add-name-to-file");
5194 Qmake_symbolic_link
= intern ("make-symbolic-link");
5195 Qfile_exists_p
= intern ("file-exists-p");
5196 Qfile_executable_p
= intern ("file-executable-p");
5197 Qfile_readable_p
= intern ("file-readable-p");
5198 Qfile_writable_p
= intern ("file-writable-p");
5199 Qfile_symlink_p
= intern ("file-symlink-p");
5200 Qaccess_file
= intern ("access-file");
5201 Qfile_directory_p
= intern ("file-directory-p");
5202 Qfile_regular_p
= intern ("file-regular-p");
5203 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
5204 Qfile_modes
= intern ("file-modes");
5205 Qset_file_modes
= intern ("set-file-modes");
5206 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
5207 Qinsert_file_contents
= intern ("insert-file-contents");
5208 Qwrite_region
= intern ("write-region");
5209 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
5210 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
5212 staticpro (&Qexpand_file_name
);
5213 staticpro (&Qsubstitute_in_file_name
);
5214 staticpro (&Qdirectory_file_name
);
5215 staticpro (&Qfile_name_directory
);
5216 staticpro (&Qfile_name_nondirectory
);
5217 staticpro (&Qunhandled_file_name_directory
);
5218 staticpro (&Qfile_name_as_directory
);
5219 staticpro (&Qcopy_file
);
5220 staticpro (&Qmake_directory_internal
);
5221 staticpro (&Qdelete_directory
);
5222 staticpro (&Qdelete_file
);
5223 staticpro (&Qrename_file
);
5224 staticpro (&Qadd_name_to_file
);
5225 staticpro (&Qmake_symbolic_link
);
5226 staticpro (&Qfile_exists_p
);
5227 staticpro (&Qfile_executable_p
);
5228 staticpro (&Qfile_readable_p
);
5229 staticpro (&Qfile_writable_p
);
5230 staticpro (&Qaccess_file
);
5231 staticpro (&Qfile_symlink_p
);
5232 staticpro (&Qfile_directory_p
);
5233 staticpro (&Qfile_regular_p
);
5234 staticpro (&Qfile_accessible_directory_p
);
5235 staticpro (&Qfile_modes
);
5236 staticpro (&Qset_file_modes
);
5237 staticpro (&Qfile_newer_than_file_p
);
5238 staticpro (&Qinsert_file_contents
);
5239 staticpro (&Qwrite_region
);
5240 staticpro (&Qverify_visited_file_modtime
);
5241 staticpro (&Qset_visited_file_modtime
);
5243 Qfile_name_history
= intern ("file-name-history");
5244 Fset (Qfile_name_history
, Qnil
);
5245 staticpro (&Qfile_name_history
);
5247 Qfile_error
= intern ("file-error");
5248 staticpro (&Qfile_error
);
5249 Qfile_already_exists
= intern ("file-already-exists");
5250 staticpro (&Qfile_already_exists
);
5251 Qfile_date_error
= intern ("file-date-error");
5252 staticpro (&Qfile_date_error
);
5255 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
5256 staticpro (&Qfind_buffer_file_type
);
5259 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system
,
5260 "*Coding system for encoding file names.\n\
5261 If it is nil, default-file-name-coding-system (which see) is used.");
5262 Vfile_name_coding_system
= Qnil
;
5264 DEFVAR_LISP ("default-file-name-coding-system",
5265 &Vdefault_file_name_coding_system
,
5266 "Default coding system for encoding file names.\n\
5267 This variable is used only when file-name-coding-system is nil.\n\
5269 This variable is set/changed by the command set-language-environment.\n\
5270 User should not set this variable manually,\n\
5271 instead use file-name-coding-system to get a constant encoding\n\
5272 of file names regardless of the current language environment.");
5273 Vdefault_file_name_coding_system
= Qnil
;
5275 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
5276 "*Format in which to write auto-save files.\n\
5277 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
5278 If it is t, which is the default, auto-save files are written in the\n\
5279 same format as a regular save would use.");
5280 Vauto_save_file_format
= Qt
;
5282 Qformat_decode
= intern ("format-decode");
5283 staticpro (&Qformat_decode
);
5284 Qformat_annotate_function
= intern ("format-annotate-function");
5285 staticpro (&Qformat_annotate_function
);
5287 Qcar_less_than_car
= intern ("car-less-than-car");
5288 staticpro (&Qcar_less_than_car
);
5290 Fput (Qfile_error
, Qerror_conditions
,
5291 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
5292 Fput (Qfile_error
, Qerror_message
,
5293 build_string ("File error"));
5295 Fput (Qfile_already_exists
, Qerror_conditions
,
5296 Fcons (Qfile_already_exists
,
5297 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5298 Fput (Qfile_already_exists
, Qerror_message
,
5299 build_string ("File already exists"));
5301 Fput (Qfile_date_error
, Qerror_conditions
,
5302 Fcons (Qfile_date_error
,
5303 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5304 Fput (Qfile_date_error
, Qerror_message
,
5305 build_string ("Cannot set file date"));
5307 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
5308 "*Non-nil means when reading a filename start with default dir in minibuffer.");
5309 insert_default_directory
= 1;
5311 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
5312 "*Non-nil means write new files with record format `stmlf'.\n\
5313 nil means use format `var'. This variable is meaningful only on VMS.");
5314 vms_stmlf_recfm
= 0;
5316 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
5317 "Directory separator character for built-in functions that return file names.\n\
5318 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
5319 This variable affects the built-in functions only on Windows,\n\
5320 on other platforms, it is initialized so that Lisp code can find out\n\
5321 what the normal separator is.");
5322 XSETFASTINT (Vdirectory_sep_char
, '/');
5324 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5325 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
5326 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
5329 The first argument given to HANDLER is the name of the I/O primitive\n\
5330 to be handled; the remaining arguments are the arguments that were\n\
5331 passed to that primitive. For example, if you do\n\
5332 (file-exists-p FILENAME)\n\
5333 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
5334 (funcall HANDLER 'file-exists-p FILENAME)\n\
5335 The function `find-file-name-handler' checks this list for a handler\n\
5336 for its argument.");
5337 Vfile_name_handler_alist
= Qnil
;
5339 DEFVAR_LISP ("set-auto-coding-function",
5340 &Vset_auto_coding_function
,
5341 "If non-nil, a function to call to decide a coding system of file.\n\
5342 One argument is passed to this function: the string of concatination\n\
5343 or the heading 1K-byte and the tailing 3K-byte of a file to be read.\n\
5344 This function should return a coding system to decode the file contents\n\
5345 specified in the heading lines with the format:\n\
5346 -*- ... coding: CODING-SYSTEM; ... -*-\n\
5347 or local variable spec of the tailing lines with `coding:' tag.");
5348 Vset_auto_coding_function
= Qnil
;
5350 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5351 "A list of functions to be called at the end of `insert-file-contents'.\n\
5352 Each is passed one argument, the number of bytes inserted. It should return\n\
5353 the new byte count, and leave point the same. If `insert-file-contents' is\n\
5354 intercepted by a handler from `file-name-handler-alist', that handler is\n\
5355 responsible for calling the after-insert-file-functions if appropriate.");
5356 Vafter_insert_file_functions
= Qnil
;
5358 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5359 "A list of functions to be called at the start of `write-region'.\n\
5360 Each is passed two arguments, START and END as for `write-region'.\n\
5361 These are usually two numbers but not always; see the documentation\n\
5362 for `write-region'. The function should return a list of pairs\n\
5363 of the form (POSITION . STRING), consisting of strings to be effectively\n\
5364 inserted at the specified positions of the file being written (1 means to\n\
5365 insert before the first byte written). The POSITIONs must be sorted into\n\
5366 increasing order. If there are several functions in the list, the several\n\
5367 lists are merged destructively.");
5368 Vwrite_region_annotate_functions
= Qnil
;
5370 DEFVAR_LISP ("write-region-annotations-so-far",
5371 &Vwrite_region_annotations_so_far
,
5372 "When an annotation function is called, this holds the previous annotations.\n\
5373 These are the annotations made by other annotation functions\n\
5374 that were already called. See also `write-region-annotate-functions'.");
5375 Vwrite_region_annotations_so_far
= Qnil
;
5377 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5378 "A list of file name handlers that temporarily should not be used.\n\
5379 This applies only to the operation `inhibit-file-name-operation'.");
5380 Vinhibit_file_name_handlers
= Qnil
;
5382 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5383 "The operation for which `inhibit-file-name-handlers' is applicable.");
5384 Vinhibit_file_name_operation
= Qnil
;
5386 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5387 "File name in which we write a list of all auto save file names.\n\
5388 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
5389 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
5391 Vauto_save_list_file_name
= Qnil
;
5393 defsubr (&Sfind_file_name_handler
);
5394 defsubr (&Sfile_name_directory
);
5395 defsubr (&Sfile_name_nondirectory
);
5396 defsubr (&Sunhandled_file_name_directory
);
5397 defsubr (&Sfile_name_as_directory
);
5398 defsubr (&Sdirectory_file_name
);
5399 defsubr (&Smake_temp_name
);
5400 defsubr (&Sexpand_file_name
);
5401 defsubr (&Ssubstitute_in_file_name
);
5402 defsubr (&Scopy_file
);
5403 defsubr (&Smake_directory_internal
);
5404 defsubr (&Sdelete_directory
);
5405 defsubr (&Sdelete_file
);
5406 defsubr (&Srename_file
);
5407 defsubr (&Sadd_name_to_file
);
5409 defsubr (&Smake_symbolic_link
);
5410 #endif /* S_IFLNK */
5412 defsubr (&Sdefine_logical_name
);
5415 defsubr (&Ssysnetunam
);
5416 #endif /* HPUX_NET */
5417 defsubr (&Sfile_name_absolute_p
);
5418 defsubr (&Sfile_exists_p
);
5419 defsubr (&Sfile_executable_p
);
5420 defsubr (&Sfile_readable_p
);
5421 defsubr (&Sfile_writable_p
);
5422 defsubr (&Saccess_file
);
5423 defsubr (&Sfile_symlink_p
);
5424 defsubr (&Sfile_directory_p
);
5425 defsubr (&Sfile_accessible_directory_p
);
5426 defsubr (&Sfile_regular_p
);
5427 defsubr (&Sfile_modes
);
5428 defsubr (&Sset_file_modes
);
5429 defsubr (&Sset_default_file_modes
);
5430 defsubr (&Sdefault_file_modes
);
5431 defsubr (&Sfile_newer_than_file_p
);
5432 defsubr (&Sinsert_file_contents
);
5433 defsubr (&Swrite_region
);
5434 defsubr (&Scar_less_than_car
);
5435 defsubr (&Sverify_visited_file_modtime
);
5436 defsubr (&Sclear_visited_file_modtime
);
5437 defsubr (&Svisited_file_modtime
);
5438 defsubr (&Sset_visited_file_modtime
);
5439 defsubr (&Sdo_auto_save
);
5440 defsubr (&Sset_buffer_auto_saved
);
5441 defsubr (&Sclear_buffer_auto_save_failure
);
5442 defsubr (&Srecent_auto_save_p
);
5444 defsubr (&Sread_file_name_internal
);
5445 defsubr (&Sread_file_name
);
5448 defsubr (&Sunix_sync
);