1 /* File IO for GNU Emacs.
2 Copyright (C) 1985,86,87,88,93,94,95,96,1997 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
23 #if defined (USG5) || defined (BSD_SYSTEM) || defined (LINUX)
28 #include <sys/types.h>
35 #if !defined (S_ISLNK) && defined (S_IFLNK)
36 # define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
39 #if !defined (S_ISFIFO) && defined (S_IFIFO)
40 # define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
43 #if !defined (S_ISREG) && defined (S_IFREG)
44 # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
55 #include <sys/param.h>
77 extern char *strerror ();
94 #include "intervals.h"
105 #endif /* not WINDOWSNT */
108 #define CORRECT_DIR_SEPS(s) \
109 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
110 else unixtodos_filename (s); \
112 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
113 redirector allows the six letters between 'Z' and 'a' as well. */
115 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
118 #define IS_DRIVE(x) isalpha (x)
120 /* Need to lower-case the drive letter, or else expanded
121 filenames will sometimes compare inequal, because
122 `expand-file-name' doesn't always down-case the drive letter. */
123 #define DRIVE_LETTER(x) (tolower (x))
152 #define min(a, b) ((a) < (b) ? (a) : (b))
153 #define max(a, b) ((a) > (b) ? (a) : (b))
155 /* 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 /* Alist of elements (REGEXP . HANDLER) for file names
163 whose I/O is done with a special handler. */
164 Lisp_Object Vfile_name_handler_alist
;
166 /* Format for auto-save files */
167 Lisp_Object Vauto_save_file_format
;
169 /* Lisp functions for translating file formats */
170 Lisp_Object Qformat_decode
, Qformat_annotate_function
;
172 /* Function to be called to decide a coding system of a reading file. */
173 Lisp_Object Vset_auto_coding_function
;
175 /* Functions to be called to process text properties in inserted file. */
176 Lisp_Object Vafter_insert_file_functions
;
178 /* Functions to be called to create text property annotations for file. */
179 Lisp_Object Vwrite_region_annotate_functions
;
181 /* During build_annotations, each time an annotation function is called,
182 this holds the annotations made by the previous functions. */
183 Lisp_Object Vwrite_region_annotations_so_far
;
185 /* File name in which we write a list of all our auto save files. */
186 Lisp_Object Vauto_save_list_file_name
;
188 /* Nonzero means, when reading a filename in the minibuffer,
189 start out by inserting the default directory into the minibuffer. */
190 int insert_default_directory
;
192 /* On VMS, nonzero means write new files with record format stmlf.
193 Zero means use var format. */
196 /* On NT, specifies the directory separator character, used (eg.) when
197 expanding file names. This can be bound to / or \. */
198 Lisp_Object Vdirectory_sep_char
;
200 extern Lisp_Object Vuser_login_name
;
202 extern int minibuf_level
;
204 extern int minibuffer_auto_raise
;
206 /* These variables describe handlers that have "already" had a chance
207 to handle the current operation.
209 Vinhibit_file_name_handlers is a list of file name handlers.
210 Vinhibit_file_name_operation is the operation being handled.
211 If we try to handle that operation, we ignore those handlers. */
213 static Lisp_Object Vinhibit_file_name_handlers
;
214 static Lisp_Object Vinhibit_file_name_operation
;
216 Lisp_Object Qfile_error
, Qfile_already_exists
, Qfile_date_error
;
218 Lisp_Object Qfile_name_history
;
220 Lisp_Object Qcar_less_than_car
;
222 report_file_error (string
, data
)
226 Lisp_Object errstring
;
228 errstring
= build_string (strerror (errno
));
230 /* System error messages are capitalized. Downcase the initial
231 unless it is followed by a slash. */
232 if (XSTRING (errstring
)->data
[1] != '/')
233 XSTRING (errstring
)->data
[0] = DOWNCASE (XSTRING (errstring
)->data
[0]);
236 Fsignal (Qfile_error
,
237 Fcons (build_string (string
), Fcons (errstring
, data
)));
240 close_file_unwind (fd
)
243 close (XFASTINT (fd
));
246 /* Restore point, having saved it as a marker. */
248 restore_point_unwind (location
)
249 Lisp_Object location
;
251 SET_PT (marker_position (location
));
252 Fset_marker (location
, Qnil
, Qnil
);
255 Lisp_Object Qexpand_file_name
;
256 Lisp_Object Qsubstitute_in_file_name
;
257 Lisp_Object Qdirectory_file_name
;
258 Lisp_Object Qfile_name_directory
;
259 Lisp_Object Qfile_name_nondirectory
;
260 Lisp_Object Qunhandled_file_name_directory
;
261 Lisp_Object Qfile_name_as_directory
;
262 Lisp_Object Qcopy_file
;
263 Lisp_Object Qmake_directory_internal
;
264 Lisp_Object Qdelete_directory
;
265 Lisp_Object Qdelete_file
;
266 Lisp_Object Qrename_file
;
267 Lisp_Object Qadd_name_to_file
;
268 Lisp_Object Qmake_symbolic_link
;
269 Lisp_Object Qfile_exists_p
;
270 Lisp_Object Qfile_executable_p
;
271 Lisp_Object Qfile_readable_p
;
272 Lisp_Object Qfile_writable_p
;
273 Lisp_Object Qfile_symlink_p
;
274 Lisp_Object Qaccess_file
;
275 Lisp_Object Qfile_directory_p
;
276 Lisp_Object Qfile_regular_p
;
277 Lisp_Object Qfile_accessible_directory_p
;
278 Lisp_Object Qfile_modes
;
279 Lisp_Object Qset_file_modes
;
280 Lisp_Object Qfile_newer_than_file_p
;
281 Lisp_Object Qinsert_file_contents
;
282 Lisp_Object Qwrite_region
;
283 Lisp_Object Qverify_visited_file_modtime
;
284 Lisp_Object Qset_visited_file_modtime
;
286 DEFUN ("find-file-name-handler", Ffind_file_name_handler
, Sfind_file_name_handler
, 2, 2, 0,
287 "Return FILENAME's handler function for OPERATION, if it has one.\n\
288 Otherwise, return nil.\n\
289 A file name is handled if one of the regular expressions in\n\
290 `file-name-handler-alist' matches it.\n\n\
291 If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
292 any handlers that are members of `inhibit-file-name-handlers',\n\
293 but we still do run any other handlers. This lets handlers\n\
294 use the standard functions without calling themselves recursively.")
295 (filename
, operation
)
296 Lisp_Object filename
, operation
;
298 /* This function must not munge the match data. */
299 Lisp_Object chain
, inhibited_handlers
;
301 CHECK_STRING (filename
, 0);
303 if (EQ (operation
, Vinhibit_file_name_operation
))
304 inhibited_handlers
= Vinhibit_file_name_handlers
;
306 inhibited_handlers
= Qnil
;
308 for (chain
= Vfile_name_handler_alist
; CONSP (chain
);
309 chain
= XCONS (chain
)->cdr
)
312 elt
= XCONS (chain
)->car
;
316 string
= XCONS (elt
)->car
;
317 if (STRINGP (string
) && fast_string_match (string
, filename
) >= 0)
319 Lisp_Object handler
, tem
;
321 handler
= XCONS (elt
)->cdr
;
322 tem
= Fmemq (handler
, inhibited_handlers
);
333 DEFUN ("file-name-directory", Ffile_name_directory
, Sfile_name_directory
,
335 "Return the directory component in file name FILENAME.\n\
336 Return nil if FILENAME does not include a directory.\n\
337 Otherwise return a directory spec.\n\
338 Given a Unix syntax file name, returns a string ending in slash;\n\
339 on VMS, perhaps instead a string ending in `:', `]' or `>'.")
341 Lisp_Object filename
;
343 register unsigned char *beg
;
344 register unsigned char *p
;
347 CHECK_STRING (filename
, 0);
349 /* If the file name has special constructs in it,
350 call the corresponding file handler. */
351 handler
= Ffind_file_name_handler (filename
, Qfile_name_directory
);
353 return call2 (handler
, Qfile_name_directory
, filename
);
355 #ifdef FILE_SYSTEM_CASE
356 filename
= FILE_SYSTEM_CASE (filename
);
358 beg
= XSTRING (filename
)->data
;
360 beg
= strcpy (alloca (strlen (beg
) + 1), beg
);
362 p
= beg
+ XSTRING (filename
)->size
;
364 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
366 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
369 /* only recognise drive specifier at beginning */
370 && !(p
[-1] == ':' && p
== beg
+ 2)
377 /* Expansion of "c:" to drive and default directory. */
378 if (p
== beg
+ 2 && beg
[1] == ':')
380 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
381 unsigned char *res
= alloca (MAXPATHLEN
+ 1);
382 if (getdefdir (toupper (*beg
) - 'A' + 1, res
))
384 if (!IS_DIRECTORY_SEP (res
[strlen (res
) - 1]))
387 p
= beg
+ strlen (beg
);
390 CORRECT_DIR_SEPS (beg
);
392 return make_string (beg
, p
- beg
);
395 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory
, Sfile_name_nondirectory
,
397 "Return file name FILENAME sans its directory.\n\
398 For example, in a Unix-syntax file name,\n\
399 this is everything after the last slash,\n\
400 or the entire name if it contains no slash.")
402 Lisp_Object filename
;
404 register unsigned char *beg
, *p
, *end
;
407 CHECK_STRING (filename
, 0);
409 /* If the file name has special constructs in it,
410 call the corresponding file handler. */
411 handler
= Ffind_file_name_handler (filename
, Qfile_name_nondirectory
);
413 return call2 (handler
, Qfile_name_nondirectory
, filename
);
415 beg
= XSTRING (filename
)->data
;
416 end
= p
= beg
+ XSTRING (filename
)->size
;
418 while (p
!= beg
&& !IS_DIRECTORY_SEP (p
[-1])
420 && p
[-1] != ':' && p
[-1] != ']' && p
[-1] != '>'
423 /* only recognise drive specifier at beginning */
424 && !(p
[-1] == ':' && p
== beg
+ 2)
428 return make_string (p
, end
- p
);
431 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory
, Sunhandled_file_name_directory
, 1, 1, 0,
432 "Return a directly usable directory name somehow associated with FILENAME.\n\
433 A `directly usable' directory name is one that may be used without the\n\
434 intervention of any file handler.\n\
435 If FILENAME is a directly usable file itself, return\n\
436 (file-name-directory FILENAME).\n\
437 The `call-process' and `start-process' functions use this function to\n\
438 get a current directory to run processes in.")
440 Lisp_Object filename
;
444 /* If the file name has special constructs in it,
445 call the corresponding file handler. */
446 handler
= Ffind_file_name_handler (filename
, Qunhandled_file_name_directory
);
448 return call2 (handler
, Qunhandled_file_name_directory
, filename
);
450 return Ffile_name_directory (filename
);
455 file_name_as_directory (out
, in
)
458 int size
= strlen (in
) - 1;
463 /* Is it already a directory string? */
464 if (in
[size
] == ':' || in
[size
] == ']' || in
[size
] == '>')
466 /* Is it a VMS directory file name? If so, hack VMS syntax. */
467 else if (! index (in
, '/')
468 && ((size
> 3 && ! strcmp (&in
[size
- 3], ".DIR"))
469 || (size
> 3 && ! strcmp (&in
[size
- 3], ".dir"))
470 || (size
> 5 && (! strncmp (&in
[size
- 5], ".DIR", 4)
471 || ! strncmp (&in
[size
- 5], ".dir", 4))
472 && (in
[size
- 1] == '.' || in
[size
- 1] == ';')
473 && in
[size
] == '1')))
475 register char *p
, *dot
;
479 dir:x.dir --> dir:[x]
480 dir:[x]y.dir --> dir:[x.y] */
482 while (p
!= in
&& *p
!= ':' && *p
!= '>' && *p
!= ']') p
--;
485 strncpy (out
, in
, p
- in
);
504 dot
= index (p
, '.');
507 /* blindly remove any extension */
508 size
= strlen (out
) + (dot
- p
);
509 strncat (out
, p
, dot
- p
);
520 /* For Unix syntax, Append a slash if necessary */
521 if (!IS_DIRECTORY_SEP (out
[size
]))
523 out
[size
+ 1] = DIRECTORY_SEP
;
524 out
[size
+ 2] = '\0';
527 CORRECT_DIR_SEPS (out
);
533 DEFUN ("file-name-as-directory", Ffile_name_as_directory
,
534 Sfile_name_as_directory
, 1, 1, 0,
535 "Return a string representing file FILENAME interpreted as a directory.\n\
536 This operation exists because a directory is also a file, but its name as\n\
537 a directory is different from its name as a file.\n\
538 The result can be used as the value of `default-directory'\n\
539 or passed as second argument to `expand-file-name'.\n\
540 For a Unix-syntax file name, just appends a slash.\n\
541 On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.")
548 CHECK_STRING (file
, 0);
552 /* If the file name has special constructs in it,
553 call the corresponding file handler. */
554 handler
= Ffind_file_name_handler (file
, Qfile_name_as_directory
);
556 return call2 (handler
, Qfile_name_as_directory
, file
);
558 buf
= (char *) alloca (XSTRING (file
)->size
+ 10);
559 return build_string (file_name_as_directory (buf
, XSTRING (file
)->data
));
563 * Convert from directory name to filename.
565 * xyzzy:[mukesh.emacs] => xyzzy:[mukesh]emacs.dir.1
566 * xyzzy:[mukesh] => xyzzy:[000000]mukesh.dir.1
567 * On UNIX, it's simple: just make sure there isn't a terminating /
569 * Value is nonzero if the string output is different from the input.
572 directory_file_name (src
, dst
)
580 struct FAB fab
= cc$rms_fab
;
581 struct NAM nam
= cc$rms_nam
;
582 char esa
[NAM$C_MAXRSS
];
587 if (! index (src
, '/')
588 && (src
[slen
- 1] == ']'
589 || src
[slen
- 1] == ':'
590 || src
[slen
- 1] == '>'))
592 /* VMS style - convert [x.y.z] to [x.y]z, [x] to [000000]x */
594 fab
.fab$b_fns
= slen
;
595 fab
.fab$l_nam
= &nam
;
596 fab
.fab$l_fop
= FAB$M_NAM
;
599 nam
.nam$b_ess
= sizeof esa
;
600 nam
.nam$b_nop
|= NAM$M_SYNCHK
;
602 /* We call SYS$PARSE to handle such things as [--] for us. */
603 if (SYS$
PARSE (&fab
, 0, 0) == RMS$_NORMAL
)
605 slen
= nam
.nam$b_esl
;
606 if (esa
[slen
- 1] == ';' && esa
[slen
- 2] == '.')
611 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
613 /* what about when we have logical_name:???? */
614 if (src
[slen
- 1] == ':')
615 { /* Xlate logical name and see what we get */
616 ptr
= strcpy (dst
, src
); /* upper case for getenv */
619 if ('a' <= *ptr
&& *ptr
<= 'z')
623 dst
[slen
- 1] = 0; /* remove colon */
624 if (!(src
= egetenv (dst
)))
626 /* should we jump to the beginning of this procedure?
627 Good points: allows us to use logical names that xlate
629 Bad points: can be a problem if we just translated to a device
631 For now, I'll punt and always expect VMS names, and hope for
634 if (src
[slen
- 1] != ']' && src
[slen
- 1] != '>')
635 { /* no recursion here! */
641 { /* not a directory spec */
646 bracket
= src
[slen
- 1];
648 /* If bracket is ']' or '>', bracket - 2 is the corresponding
650 ptr
= index (src
, bracket
- 2);
652 { /* no opening bracket */
656 if (!(rptr
= rindex (src
, '.')))
659 strncpy (dst
, src
, slen
);
663 dst
[slen
++] = bracket
;
668 /* If we have the top-level of a rooted directory (i.e. xx:[000000]),
669 then translate the device and recurse. */
670 if (dst
[slen
- 1] == ':'
671 && dst
[slen
- 2] != ':' /* skip decnet nodes */
672 && strcmp (src
+ slen
, "[000000]") == 0)
674 dst
[slen
- 1] = '\0';
675 if ((ptr
= egetenv (dst
))
676 && (rlen
= strlen (ptr
) - 1) > 0
677 && (ptr
[rlen
] == ']' || ptr
[rlen
] == '>')
678 && ptr
[rlen
- 1] == '.')
680 char * buf
= (char *) alloca (strlen (ptr
) + 1);
684 return directory_file_name (buf
, dst
);
689 strcat (dst
, "[000000]");
693 rlen
= strlen (rptr
) - 1;
694 strncat (dst
, rptr
, rlen
);
695 dst
[slen
+ rlen
] = '\0';
696 strcat (dst
, ".DIR.1");
700 /* Process as Unix format: just remove any final slash.
701 But leave "/" unchanged; do not change it to "". */
704 /* Handle // as root for apollo's. */
705 if ((slen
> 2 && dst
[slen
- 1] == '/')
706 || (slen
> 1 && dst
[0] != '/' && dst
[slen
- 1] == '/'))
710 && IS_DIRECTORY_SEP (dst
[slen
- 1])
712 && !IS_ANY_SEP (dst
[slen
- 2])
718 CORRECT_DIR_SEPS (dst
);
723 DEFUN ("directory-file-name", Fdirectory_file_name
, Sdirectory_file_name
,
725 "Returns the file name of the directory named DIRECTORY.\n\
726 This is the name of the file that holds the data for the directory DIRECTORY.\n\
727 This operation exists because a directory is also a file, but its name as\n\
728 a directory is different from its name as a file.\n\
729 In Unix-syntax, this function just removes the final slash.\n\
730 On VMS, given a VMS-syntax directory name such as \"[X.Y]\",\n\
731 it returns a file name such as \"[X]Y.DIR.1\".")
733 Lisp_Object directory
;
738 CHECK_STRING (directory
, 0);
740 if (NILP (directory
))
743 /* If the file name has special constructs in it,
744 call the corresponding file handler. */
745 handler
= Ffind_file_name_handler (directory
, Qdirectory_file_name
);
747 return call2 (handler
, Qdirectory_file_name
, directory
);
750 /* 20 extra chars is insufficient for VMS, since we might perform a
751 logical name translation. an equivalence string can be up to 255
752 chars long, so grab that much extra space... - sss */
753 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20 + 255);
755 buf
= (char *) alloca (XSTRING (directory
)->size
+ 20);
757 directory_file_name (XSTRING (directory
)->data
, buf
);
758 return build_string (buf
);
761 DEFUN ("make-temp-name", Fmake_temp_name
, Smake_temp_name
, 1, 1, 0,
762 "Generate temporary file name (string) starting with PREFIX (a string).\n\
763 The Emacs process number forms part of the result,\n\
764 so there is no danger of generating a name being used by another process.\n\
765 In addition, this function makes an attempt to choose a name\n\
766 which has no existing file.")
772 /* Don't use too many characters of the restricted 8+3 DOS
774 val
= concat2 (prefix
, build_string ("a.XXX"));
776 val
= concat2 (prefix
, build_string ("XXXXXX"));
778 mktemp (XSTRING (val
)->data
);
780 CORRECT_DIR_SEPS (XSTRING (val
)->data
);
785 DEFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
786 "Convert filename NAME to absolute, and canonicalize it.\n\
787 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative\n\
788 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,\n\
789 the current buffer's value of default-directory is used.\n\
790 File name components that are `.' are removed, and \n\
791 so are file name components followed by `..', along with the `..' itself;\n\
792 note that these simplifications are done without checking the resulting\n\
793 file names in the file system.\n\
794 An initial `~/' expands to your home directory.\n\
795 An initial `~USER/' expands to USER's home directory.\n\
796 See also the function `substitute-in-file-name'.")
797 (name
, default_directory
)
798 Lisp_Object name
, default_directory
;
802 register unsigned char *newdir
, *p
, *o
;
804 unsigned char *target
;
807 unsigned char * colon
= 0;
808 unsigned char * close
= 0;
809 unsigned char * slash
= 0;
810 unsigned char * brack
= 0;
811 int lbrack
= 0, rbrack
= 0;
816 int collapse_newdir
= 1;
821 CHECK_STRING (name
, 0);
823 /* If the file name has special constructs in it,
824 call the corresponding file handler. */
825 handler
= Ffind_file_name_handler (name
, Qexpand_file_name
);
827 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
829 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
830 if (NILP (default_directory
))
831 default_directory
= current_buffer
->directory
;
832 CHECK_STRING (default_directory
, 1);
834 if (!NILP (default_directory
))
836 handler
= Ffind_file_name_handler (default_directory
, Qexpand_file_name
);
838 return call3 (handler
, Qexpand_file_name
, name
, default_directory
);
841 o
= XSTRING (default_directory
)->data
;
843 /* Make sure DEFAULT_DIRECTORY is properly expanded.
844 It would be better to do this down below where we actually use
845 default_directory. Unfortunately, calling Fexpand_file_name recursively
846 could invoke GC, and the strings might be relocated. This would
847 be annoying because we have pointers into strings lying around
848 that would need adjusting, and people would add new pointers to
849 the code and forget to adjust them, resulting in intermittent bugs.
850 Putting this call here avoids all that crud.
852 The EQ test avoids infinite recursion. */
853 if (! NILP (default_directory
) && !EQ (default_directory
, name
)
854 /* Save time in some common cases - as long as default_directory
855 is not relative, it can be canonicalized with name below (if it
856 is needed at all) without requiring it to be expanded now. */
858 /* Detect MSDOS file names with drive specifiers. */
859 && ! (IS_DRIVE (o
[0]) && (IS_DEVICE_SEP (o
[1]) && IS_DIRECTORY_SEP (o
[2])))
861 /* Detect Windows file names in UNC format. */
862 && ! (IS_DIRECTORY_SEP (o
[0]) && IS_DIRECTORY_SEP (o
[1]))
864 #else /* not DOS_NT */
865 /* Detect Unix absolute file names (/... alone is not absolute on
867 && ! (IS_DIRECTORY_SEP (o
[0]))
868 #endif /* not DOS_NT */
874 default_directory
= Fexpand_file_name (default_directory
, Qnil
);
879 /* Filenames on VMS are always upper case. */
880 name
= Fupcase (name
);
882 #ifdef FILE_SYSTEM_CASE
883 name
= FILE_SYSTEM_CASE (name
);
886 nm
= XSTRING (name
)->data
;
889 /* We will force directory separators to be either all \ or /, so make
890 a local copy to modify, even if there ends up being no change. */
891 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
893 /* Find and remove drive specifier if present; this makes nm absolute
894 even if the rest of the name appears to be relative. */
896 unsigned char *colon
= rindex (nm
, ':');
899 /* Only recognize colon as part of drive specifier if there is a
900 single alphabetic character preceeding the colon (and if the
901 character before the drive letter, if present, is a directory
902 separator); this is to support the remote system syntax used by
903 ange-ftp, and the "po:username" syntax for POP mailboxes. */
907 else if (IS_DRIVE (colon
[-1])
908 && (colon
== nm
+ 1 || IS_DIRECTORY_SEP (colon
[-2])))
915 while (--colon
>= nm
)
922 /* If we see "c://somedir", we want to strip the first slash after the
923 colon when stripping the drive letter. Otherwise, this expands to
925 if (drive
&& IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
927 #endif /* WINDOWSNT */
931 /* Discard any previous drive specifier if nm is now in UNC format. */
932 if (IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
938 /* If nm is absolute, look for /./ or /../ sequences; if none are
939 found, we can probably return right away. We will avoid allocating
940 a new string if name is already fully expanded. */
942 IS_DIRECTORY_SEP (nm
[0])
947 && (drive
|| IS_DIRECTORY_SEP (nm
[1]))
954 /* If it turns out that the filename we want to return is just a
955 suffix of FILENAME, we don't need to go through and edit
956 things; we just need to construct a new string using data
957 starting at the middle of FILENAME. If we set lose to a
958 non-zero value, that means we've discovered that we can't do
965 /* Since we know the name is absolute, we can assume that each
966 element starts with a "/". */
968 /* "." and ".." are hairy. */
969 if (IS_DIRECTORY_SEP (p
[0])
971 && (IS_DIRECTORY_SEP (p
[2])
973 || (p
[2] == '.' && (IS_DIRECTORY_SEP (p
[3])
980 /* if dev:[dir]/, move nm to / */
981 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
982 nm
= (brack
? brack
+ 1 : colon
+ 1);
991 /* VMS pre V4.4,convert '-'s in filenames. */
992 if (lbrack
== rbrack
)
994 if (dots
< 2) /* this is to allow negative version numbers */
999 if (lbrack
> rbrack
&&
1000 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1001 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1007 /* count open brackets, reset close bracket pointer */
1008 if (p
[0] == '[' || p
[0] == '<')
1009 lbrack
++, brack
= 0;
1010 /* count close brackets, set close bracket pointer */
1011 if (p
[0] == ']' || p
[0] == '>')
1012 rbrack
++, brack
= p
;
1013 /* detect ][ or >< */
1014 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1016 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1017 nm
= p
+ 1, lose
= 1;
1018 if (p
[0] == ':' && (colon
|| slash
))
1019 /* if dev1:[dir]dev2:, move nm to dev2: */
1025 /* if /name/dev:, move nm to dev: */
1028 /* if node::dev:, move colon following dev */
1029 else if (colon
&& colon
[-1] == ':')
1031 /* if dev1:dev2:, move nm to dev2: */
1032 else if (colon
&& colon
[-1] != ':')
1037 if (p
[0] == ':' && !colon
)
1043 if (lbrack
== rbrack
)
1046 else if (p
[0] == '.')
1054 if (index (nm
, '/'))
1055 return build_string (sys_translate_unix (nm
));
1058 /* Make sure directories are all separated with / or \ as
1059 desired, but avoid allocation of a new string when not
1061 CORRECT_DIR_SEPS (nm
);
1063 if (IS_DIRECTORY_SEP (nm
[1]))
1065 if (strcmp (nm
, XSTRING (name
)->data
) != 0)
1066 name
= build_string (nm
);
1070 /* drive must be set, so this is okay */
1071 if (strcmp (nm
- 2, XSTRING (name
)->data
) != 0)
1073 name
= make_string (nm
- 2, p
- nm
+ 2);
1074 XSTRING (name
)->data
[0] = DRIVE_LETTER (drive
);
1075 XSTRING (name
)->data
[1] = ':';
1078 #else /* not DOS_NT */
1079 if (nm
== XSTRING (name
)->data
)
1081 return build_string (nm
);
1082 #endif /* not DOS_NT */
1086 /* At this point, nm might or might not be an absolute file name. We
1087 need to expand ~ or ~user if present, otherwise prefix nm with
1088 default_directory if nm is not absolute, and finally collapse /./
1089 and /foo/../ sequences.
1091 We set newdir to be the appropriate prefix if one is needed:
1092 - the relevant user directory if nm starts with ~ or ~user
1093 - the specified drive's working dir (DOS/NT only) if nm does not
1095 - the value of default_directory.
1097 Note that these prefixes are not guaranteed to be absolute (except
1098 for the working dir of a drive). Therefore, to ensure we always
1099 return an absolute name, if the final prefix is not absolute we
1100 append it to the current working directory. */
1104 if (nm
[0] == '~') /* prefix ~ */
1106 if (IS_DIRECTORY_SEP (nm
[1])
1110 || nm
[1] == 0) /* ~ by itself */
1112 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1113 newdir
= (unsigned char *) "";
1116 collapse_newdir
= 0;
1119 nm
++; /* Don't leave the slash in nm. */
1122 else /* ~user/filename */
1124 for (p
= nm
; *p
&& (!IS_DIRECTORY_SEP (*p
)
1129 o
= (unsigned char *) alloca (p
- nm
+ 1);
1130 bcopy ((char *) nm
, o
, p
- nm
);
1133 pw
= (struct passwd
*) getpwnam (o
+ 1);
1136 newdir
= (unsigned char *) pw
-> pw_dir
;
1138 nm
= p
+ 1; /* skip the terminator */
1142 collapse_newdir
= 0;
1147 /* If we don't find a user of that name, leave the name
1148 unchanged; don't move nm forward to p. */
1153 /* On DOS and Windows, nm is absolute if a drive name was specified;
1154 use the drive's current directory as the prefix if needed. */
1155 if (!newdir
&& drive
)
1157 /* Get default directory if needed to make nm absolute. */
1158 if (!IS_DIRECTORY_SEP (nm
[0]))
1160 newdir
= alloca (MAXPATHLEN
+ 1);
1161 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1166 /* Either nm starts with /, or drive isn't mounted. */
1167 newdir
= alloca (4);
1168 newdir
[0] = DRIVE_LETTER (drive
);
1176 /* Finally, if no prefix has been specified and nm is not absolute,
1177 then it must be expanded relative to default_directory. */
1181 /* /... alone is not absolute on DOS and Windows. */
1182 && !IS_DIRECTORY_SEP (nm
[0])
1185 && !(IS_DIRECTORY_SEP (nm
[0]) && IS_DIRECTORY_SEP (nm
[1]))
1192 newdir
= XSTRING (default_directory
)->data
;
1198 /* First ensure newdir is an absolute name. */
1200 /* Detect MSDOS file names with drive specifiers. */
1201 ! (IS_DRIVE (newdir
[0])
1202 && IS_DEVICE_SEP (newdir
[1]) && IS_DIRECTORY_SEP (newdir
[2]))
1204 /* Detect Windows file names in UNC format. */
1205 && ! (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1209 /* Effectively, let newdir be (expand-file-name newdir cwd).
1210 Because of the admonition against calling expand-file-name
1211 when we have pointers into lisp strings, we accomplish this
1212 indirectly by prepending newdir to nm if necessary, and using
1213 cwd (or the wd of newdir's drive) as the new newdir. */
1215 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1220 if (!IS_DIRECTORY_SEP (nm
[0]))
1222 char * tmp
= alloca (strlen (newdir
) + strlen (nm
) + 2);
1223 file_name_as_directory (tmp
, newdir
);
1227 newdir
= alloca (MAXPATHLEN
+ 1);
1230 if (!getdefdir (toupper (drive
) - 'A' + 1, newdir
))
1237 /* Strip off drive name from prefix, if present. */
1238 if (IS_DRIVE (newdir
[0]) && newdir
[1] == ':')
1244 /* Keep only a prefix from newdir if nm starts with slash
1245 (//server/share for UNC, nothing otherwise). */
1246 if (IS_DIRECTORY_SEP (nm
[0]) && collapse_newdir
)
1249 if (IS_DIRECTORY_SEP (newdir
[0]) && IS_DIRECTORY_SEP (newdir
[1]))
1251 newdir
= strcpy (alloca (strlen (newdir
) + 1), newdir
);
1253 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1255 while (*p
&& !IS_DIRECTORY_SEP (*p
)) p
++;
1267 /* Get rid of any slash at the end of newdir, unless newdir is
1268 just // (an incomplete UNC name). */
1269 length
= strlen (newdir
);
1270 if (length
> 0 && IS_DIRECTORY_SEP (newdir
[length
- 1])
1272 && !(length
== 2 && IS_DIRECTORY_SEP (newdir
[0]))
1276 unsigned char *temp
= (unsigned char *) alloca (length
);
1277 bcopy (newdir
, temp
, length
- 1);
1278 temp
[length
- 1] = 0;
1286 /* Now concatenate the directory and name to new space in the stack frame */
1287 tlen
+= strlen (nm
) + 1;
1289 /* Add reserved space for drive name. (The Microsoft x86 compiler
1290 produces incorrect code if the following two lines are combined.) */
1291 target
= (unsigned char *) alloca (tlen
+ 2);
1293 #else /* not DOS_NT */
1294 target
= (unsigned char *) alloca (tlen
);
1295 #endif /* not DOS_NT */
1301 if (nm
[0] == 0 || IS_DIRECTORY_SEP (nm
[0]))
1302 strcpy (target
, newdir
);
1305 file_name_as_directory (target
, newdir
);
1308 strcat (target
, nm
);
1310 if (index (target
, '/'))
1311 strcpy (target
, sys_translate_unix (target
));
1314 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1316 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1324 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1330 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1331 /* brackets are offset from each other by 2 */
1334 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1335 /* convert [foo][bar] to [bar] */
1336 while (o
[-1] != '[' && o
[-1] != '<')
1338 else if (*p
== '-' && *o
!= '.')
1341 else if (p
[0] == '-' && o
[-1] == '.' &&
1342 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1343 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1347 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1348 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1350 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1352 /* else [foo.-] ==> [-] */
1358 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1359 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1365 if (!IS_DIRECTORY_SEP (*p
))
1369 else if (IS_DIRECTORY_SEP (p
[0]) && IS_DIRECTORY_SEP (p
[1])
1370 #if defined (APOLLO) || defined (WINDOWSNT)
1371 /* // at start of filename is meaningful in Apollo
1372 and WindowsNT systems */
1374 #endif /* APOLLO || WINDOWSNT */
1380 else if (IS_DIRECTORY_SEP (p
[0])
1382 && (IS_DIRECTORY_SEP (p
[2])
1385 /* If "/." is the entire filename, keep the "/". Otherwise,
1386 just delete the whole "/.". */
1387 if (o
== target
&& p
[2] == '\0')
1391 else if (IS_DIRECTORY_SEP (p
[0]) && p
[1] == '.' && p
[2] == '.'
1392 /* `/../' is the "superroot" on certain file systems. */
1394 && (IS_DIRECTORY_SEP (p
[3]) || p
[3] == 0))
1396 while (o
!= target
&& (--o
) && !IS_DIRECTORY_SEP (*o
))
1398 /* Keep initial / only if this is the whole name. */
1399 if (o
== target
&& IS_ANY_SEP (*o
) && p
[3] == 0)
1407 #endif /* not VMS */
1411 /* At last, set drive name. */
1413 /* Except for network file name. */
1414 if (!(IS_DIRECTORY_SEP (target
[0]) && IS_DIRECTORY_SEP (target
[1])))
1415 #endif /* WINDOWSNT */
1417 if (!drive
) abort ();
1419 target
[0] = DRIVE_LETTER (drive
);
1422 CORRECT_DIR_SEPS (target
);
1425 return make_string (target
, o
- target
);
1429 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1430 DEAFUN ("expand-file-name", Fexpand_file_name
, Sexpand_file_name
, 1, 2, 0,
1431 "Convert FILENAME to absolute, and canonicalize it.\n\
1432 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1433 (does not start with slash); if DEFAULT is nil or missing,\n\
1434 the current buffer's value of default-directory is used.\n\
1435 Filenames containing `.' or `..' as components are simplified;\n\
1436 initial `~/' expands to your home directory.\n\
1437 See also the function `substitute-in-file-name'.")
1439 Lisp_Object name
, defalt
;
1443 register unsigned char *newdir
, *p
, *o
;
1445 unsigned char *target
;
1449 unsigned char * colon
= 0;
1450 unsigned char * close
= 0;
1451 unsigned char * slash
= 0;
1452 unsigned char * brack
= 0;
1453 int lbrack
= 0, rbrack
= 0;
1457 CHECK_STRING (name
, 0);
1460 /* Filenames on VMS are always upper case. */
1461 name
= Fupcase (name
);
1464 nm
= XSTRING (name
)->data
;
1466 /* If nm is absolute, flush ...// and detect /./ and /../.
1467 If no /./ or /../ we can return right away. */
1479 if (p
[0] == '/' && p
[1] == '/'
1481 /* // at start of filename is meaningful on Apollo system */
1486 if (p
[0] == '/' && p
[1] == '~')
1487 nm
= p
+ 1, lose
= 1;
1488 if (p
[0] == '/' && p
[1] == '.'
1489 && (p
[2] == '/' || p
[2] == 0
1490 || (p
[2] == '.' && (p
[3] == '/' || p
[3] == 0))))
1496 /* if dev:[dir]/, move nm to / */
1497 if (!slash
&& p
> nm
&& (brack
|| colon
)) {
1498 nm
= (brack
? brack
+ 1 : colon
+ 1);
1499 lbrack
= rbrack
= 0;
1507 /* VMS pre V4.4,convert '-'s in filenames. */
1508 if (lbrack
== rbrack
)
1510 if (dots
< 2) /* this is to allow negative version numbers */
1515 if (lbrack
> rbrack
&&
1516 ((p
[-1] == '.' || p
[-1] == '[' || p
[-1] == '<') &&
1517 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>')))
1523 /* count open brackets, reset close bracket pointer */
1524 if (p
[0] == '[' || p
[0] == '<')
1525 lbrack
++, brack
= 0;
1526 /* count close brackets, set close bracket pointer */
1527 if (p
[0] == ']' || p
[0] == '>')
1528 rbrack
++, brack
= p
;
1529 /* detect ][ or >< */
1530 if ((p
[0] == ']' || p
[0] == '>') && (p
[1] == '[' || p
[1] == '<'))
1532 if ((p
[0] == ':' || p
[0] == ']' || p
[0] == '>') && p
[1] == '~')
1533 nm
= p
+ 1, lose
= 1;
1534 if (p
[0] == ':' && (colon
|| slash
))
1535 /* if dev1:[dir]dev2:, move nm to dev2: */
1541 /* If /name/dev:, move nm to dev: */
1544 /* If node::dev:, move colon following dev */
1545 else if (colon
&& colon
[-1] == ':')
1547 /* If dev1:dev2:, move nm to dev2: */
1548 else if (colon
&& colon
[-1] != ':')
1553 if (p
[0] == ':' && !colon
)
1559 if (lbrack
== rbrack
)
1562 else if (p
[0] == '.')
1570 if (index (nm
, '/'))
1571 return build_string (sys_translate_unix (nm
));
1573 if (nm
== XSTRING (name
)->data
)
1575 return build_string (nm
);
1579 /* Now determine directory to start with and put it in NEWDIR */
1583 if (nm
[0] == '~') /* prefix ~ */
1588 || nm
[1] == 0)/* ~/filename */
1590 if (!(newdir
= (unsigned char *) egetenv ("HOME")))
1591 newdir
= (unsigned char *) "";
1594 nm
++; /* Don't leave the slash in nm. */
1597 else /* ~user/filename */
1599 /* Get past ~ to user */
1600 unsigned char *user
= nm
+ 1;
1601 /* Find end of name. */
1602 unsigned char *ptr
= (unsigned char *) index (user
, '/');
1603 int len
= ptr
? ptr
- user
: strlen (user
);
1605 unsigned char *ptr1
= index (user
, ':');
1606 if (ptr1
!= 0 && ptr1
- user
< len
)
1609 /* Copy the user name into temp storage. */
1610 o
= (unsigned char *) alloca (len
+ 1);
1611 bcopy ((char *) user
, o
, len
);
1614 /* Look up the user name. */
1615 pw
= (struct passwd
*) getpwnam (o
+ 1);
1617 error ("\"%s\" isn't a registered user", o
+ 1);
1619 newdir
= (unsigned char *) pw
->pw_dir
;
1621 /* Discard the user name from NM. */
1628 #endif /* not VMS */
1632 defalt
= current_buffer
->directory
;
1633 CHECK_STRING (defalt
, 1);
1634 newdir
= XSTRING (defalt
)->data
;
1637 /* Now concatenate the directory and name to new space in the stack frame */
1639 tlen
= (newdir
? strlen (newdir
) + 1 : 0) + strlen (nm
) + 1;
1640 target
= (unsigned char *) alloca (tlen
);
1646 if (nm
[0] == 0 || nm
[0] == '/')
1647 strcpy (target
, newdir
);
1650 file_name_as_directory (target
, newdir
);
1653 strcat (target
, nm
);
1655 if (index (target
, '/'))
1656 strcpy (target
, sys_translate_unix (target
));
1659 /* Now canonicalize by removing /. and /foo/.. if they appear */
1667 if (*p
!= ']' && *p
!= '>' && *p
!= '-')
1673 else if ((p
[0] == ']' || p
[0] == '>') && p
[0] == p
[1] + 2)
1674 /* brackets are offset from each other by 2 */
1677 if (*p
!= '.' && *p
!= '-' && o
[-1] != '.')
1678 /* convert [foo][bar] to [bar] */
1679 while (o
[-1] != '[' && o
[-1] != '<')
1681 else if (*p
== '-' && *o
!= '.')
1684 else if (p
[0] == '-' && o
[-1] == '.' &&
1685 (p
[1] == '.' || p
[1] == ']' || p
[1] == '>'))
1686 /* flush .foo.- ; leave - if stopped by '[' or '<' */
1690 while (o
[-1] != '.' && o
[-1] != '[' && o
[-1] != '<');
1691 if (p
[1] == '.') /* foo.-.bar ==> bar. */
1693 else if (o
[-1] == '.') /* '.foo.-]' ==> ']' */
1695 /* else [foo.-] ==> [-] */
1701 o
[-1] != '[' && o
[-1] != '<' && o
[-1] != '.' &&
1702 p
[1] != ']' && p
[1] != '>' && p
[1] != '.')
1712 else if (!strncmp (p
, "//", 2)
1714 /* // at start of filename is meaningful in Apollo system */
1722 else if (p
[0] == '/' && p
[1] == '.' &&
1723 (p
[2] == '/' || p
[2] == 0))
1725 else if (!strncmp (p
, "/..", 3)
1726 /* `/../' is the "superroot" on certain file systems. */
1728 && (p
[3] == '/' || p
[3] == 0))
1730 while (o
!= target
&& *--o
!= '/')
1733 if (o
== target
+ 1 && o
[-1] == '/' && o
[0] == '/')
1737 if (o
== target
&& *o
== '/')
1745 #endif /* not VMS */
1748 return make_string (target
, o
- target
);
1752 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name
,
1753 Ssubstitute_in_file_name
, 1, 1, 0,
1754 "Substitute environment variables referred to in FILENAME.\n\
1755 `$FOO' where FOO is an environment variable name means to substitute\n\
1756 the value of that variable. The variable name should be terminated\n\
1757 with a character not a letter, digit or underscore; otherwise, enclose\n\
1758 the entire variable name in braces.\n\
1759 If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
1760 On VMS, `$' substitution is not done; this function does little and only\n\
1761 duplicates what `expand-file-name' does.")
1763 Lisp_Object filename
;
1767 register unsigned char *s
, *p
, *o
, *x
, *endp
;
1768 unsigned char *target
;
1770 int substituted
= 0;
1772 Lisp_Object handler
;
1774 CHECK_STRING (filename
, 0);
1776 /* If the file name has special constructs in it,
1777 call the corresponding file handler. */
1778 handler
= Ffind_file_name_handler (filename
, Qsubstitute_in_file_name
);
1779 if (!NILP (handler
))
1780 return call2 (handler
, Qsubstitute_in_file_name
, filename
);
1782 nm
= XSTRING (filename
)->data
;
1784 nm
= strcpy (alloca (strlen (nm
) + 1), nm
);
1785 CORRECT_DIR_SEPS (nm
);
1786 substituted
= (strcmp (nm
, XSTRING (filename
)->data
) != 0);
1788 endp
= nm
+ XSTRING (filename
)->size
;
1790 /* If /~ or // appears, discard everything through first slash. */
1792 for (p
= nm
; p
!= endp
; p
++)
1795 #if defined (APOLLO) || defined (WINDOWSNT)
1796 /* // at start of file name is meaningful in Apollo and
1797 WindowsNT systems */
1798 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != nm
)
1799 #else /* not (APOLLO || WINDOWSNT) */
1800 || IS_DIRECTORY_SEP (p
[0])
1801 #endif /* not (APOLLO || WINDOWSNT) */
1806 || p
[-1] == ':' || p
[-1] == ']' || p
[-1] == '>'
1808 || IS_DIRECTORY_SEP (p
[-1])))
1814 /* see comment in expand-file-name about drive specifiers */
1815 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1816 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1825 return build_string (nm
);
1828 /* See if any variables are substituted into the string
1829 and find the total length of their values in `total' */
1831 for (p
= nm
; p
!= endp
;)
1841 /* "$$" means a single "$" */
1850 while (p
!= endp
&& *p
!= '}') p
++;
1851 if (*p
!= '}') goto missingclose
;
1857 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1861 /* Copy out the variable name */
1862 target
= (unsigned char *) alloca (s
- o
+ 1);
1863 strncpy (target
, o
, s
- o
);
1866 strupr (target
); /* $home == $HOME etc. */
1869 /* Get variable value */
1870 o
= (unsigned char *) egetenv (target
);
1871 if (!o
) goto badvar
;
1872 total
+= strlen (o
);
1879 /* If substitution required, recopy the string and do it */
1880 /* Make space in stack frame for the new copy */
1881 xnm
= (unsigned char *) alloca (XSTRING (filename
)->size
+ total
+ 1);
1884 /* Copy the rest of the name through, replacing $ constructs with values */
1901 while (p
!= endp
&& *p
!= '}') p
++;
1902 if (*p
!= '}') goto missingclose
;
1908 while (p
!= endp
&& (isalnum (*p
) || *p
== '_')) p
++;
1912 /* Copy out the variable name */
1913 target
= (unsigned char *) alloca (s
- o
+ 1);
1914 strncpy (target
, o
, s
- o
);
1917 strupr (target
); /* $home == $HOME etc. */
1920 /* Get variable value */
1921 o
= (unsigned char *) egetenv (target
);
1931 /* If /~ or // appears, discard everything through first slash. */
1933 for (p
= xnm
; p
!= x
; p
++)
1935 #if defined (APOLLO) || defined (WINDOWSNT)
1936 || (IS_DIRECTORY_SEP (p
[0]) && p
- 1 != xnm
)
1937 #else /* not (APOLLO || WINDOWSNT) */
1938 || IS_DIRECTORY_SEP (p
[0])
1939 #endif /* not (APOLLO || WINDOWSNT) */
1941 && p
!= xnm
&& IS_DIRECTORY_SEP (p
[-1]))
1944 else if (IS_DRIVE (p
[0]) && p
[1] == ':'
1945 && p
> nm
&& IS_DIRECTORY_SEP (p
[-1]))
1949 return make_string (xnm
, x
- xnm
);
1952 error ("Bad format environment-variable substitution");
1954 error ("Missing \"}\" in environment-variable substitution");
1956 error ("Substituting nonexistent environment variable \"%s\"", target
);
1959 #endif /* not VMS */
1962 /* A slightly faster and more convenient way to get
1963 (directory-file-name (expand-file-name FOO)). */
1966 expand_and_dir_to_file (filename
, defdir
)
1967 Lisp_Object filename
, defdir
;
1969 register Lisp_Object absname
;
1971 absname
= Fexpand_file_name (filename
, defdir
);
1974 register int c
= XSTRING (absname
)->data
[XSTRING (absname
)->size
- 1];
1975 if (c
== ':' || c
== ']' || c
== '>')
1976 absname
= Fdirectory_file_name (absname
);
1979 /* Remove final slash, if any (unless this is the root dir).
1980 stat behaves differently depending! */
1981 if (XSTRING (absname
)->size
> 1
1982 && IS_DIRECTORY_SEP (XSTRING (absname
)->data
[XSTRING (absname
)->size
- 1])
1983 && !IS_DEVICE_SEP (XSTRING (absname
)->data
[XSTRING (absname
)->size
-2]))
1984 /* We cannot take shortcuts; they might be wrong for magic file names. */
1985 absname
= Fdirectory_file_name (absname
);
1990 /* Signal an error if the file ABSNAME already exists.
1991 If INTERACTIVE is nonzero, ask the user whether to proceed,
1992 and bypass the error if the user says to go ahead.
1993 QUERYSTRING is a name for the action that is being considered
1995 *STATPTR is used to store the stat information if the file exists.
1996 If the file does not exist, STATPTR->st_mode is set to 0. */
1999 barf_or_query_if_file_exists (absname
, querystring
, interactive
, statptr
)
2000 Lisp_Object absname
;
2001 unsigned char *querystring
;
2003 struct stat
*statptr
;
2005 register Lisp_Object tem
;
2006 struct stat statbuf
;
2007 struct gcpro gcpro1
;
2009 /* stat is a good way to tell whether the file exists,
2010 regardless of what access permissions it has. */
2011 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
2014 Fsignal (Qfile_already_exists
,
2015 Fcons (build_string ("File already exists"),
2016 Fcons (absname
, Qnil
)));
2018 tem
= do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
2019 XSTRING (absname
)->data
, querystring
));
2022 Fsignal (Qfile_already_exists
,
2023 Fcons (build_string ("File already exists"),
2024 Fcons (absname
, Qnil
)));
2031 statptr
->st_mode
= 0;
2036 DEFUN ("copy-file", Fcopy_file
, Scopy_file
, 2, 4,
2037 "fCopy file: \nFCopy %s to file: \np\nP",
2038 "Copy FILE to NEWNAME. Both args must be strings.\n\
2039 Signals a `file-already-exists' error if file NEWNAME already exists,\n\
2040 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.\n\
2041 A number as third arg means request confirmation if NEWNAME already exists.\n\
2042 This is what happens in interactive use with M-x.\n\
2043 Fourth arg KEEP-TIME non-nil means give the new file the same\n\
2044 last-modified time as the old one. (This works on only some systems.)\n\
2045 A prefix arg makes KEEP-TIME non-nil.")
2046 (file
, newname
, ok_if_already_exists
, keep_date
)
2047 Lisp_Object file
, newname
, ok_if_already_exists
, keep_date
;
2050 char buf
[16 * 1024];
2051 struct stat st
, out_st
;
2052 Lisp_Object handler
;
2053 struct gcpro gcpro1
, gcpro2
;
2054 int count
= specpdl_ptr
- specpdl
;
2055 int input_file_statable_p
;
2057 GCPRO2 (file
, newname
);
2058 CHECK_STRING (file
, 0);
2059 CHECK_STRING (newname
, 1);
2060 file
= Fexpand_file_name (file
, Qnil
);
2061 newname
= Fexpand_file_name (newname
, Qnil
);
2063 /* If the input file name has special constructs in it,
2064 call the corresponding file handler. */
2065 handler
= Ffind_file_name_handler (file
, Qcopy_file
);
2066 /* Likewise for output file name. */
2068 handler
= Ffind_file_name_handler (newname
, Qcopy_file
);
2069 if (!NILP (handler
))
2070 RETURN_UNGCPRO (call5 (handler
, Qcopy_file
, file
, newname
,
2071 ok_if_already_exists
, keep_date
));
2073 if (NILP (ok_if_already_exists
)
2074 || INTEGERP (ok_if_already_exists
))
2075 barf_or_query_if_file_exists (newname
, "copy to it",
2076 INTEGERP (ok_if_already_exists
), &out_st
);
2077 else if (stat (XSTRING (newname
)->data
, &out_st
) < 0)
2080 ifd
= open (XSTRING (file
)->data
, O_RDONLY
);
2082 report_file_error ("Opening input file", Fcons (file
, Qnil
));
2084 record_unwind_protect (close_file_unwind
, make_number (ifd
));
2086 /* We can only copy regular files and symbolic links. Other files are not
2088 input_file_statable_p
= (fstat (ifd
, &st
) >= 0);
2090 #if !defined (MSDOS) || __DJGPP__ > 1
2091 if (out_st
.st_mode
!= 0
2092 && st
.st_dev
== out_st
.st_dev
&& st
.st_ino
== out_st
.st_ino
)
2095 report_file_error ("Input and output files are the same",
2096 Fcons (file
, Fcons (newname
, Qnil
)));
2100 #if defined (S_ISREG) && defined (S_ISLNK)
2101 if (input_file_statable_p
)
2103 if (!(S_ISREG (st
.st_mode
)) && !(S_ISLNK (st
.st_mode
)))
2105 #if defined (EISDIR)
2106 /* Get a better looking error message. */
2109 report_file_error ("Non-regular file", Fcons (file
, Qnil
));
2112 #endif /* S_ISREG && S_ISLNK */
2115 /* Create the copy file with the same record format as the input file */
2116 ofd
= sys_creat (XSTRING (newname
)->data
, 0666, ifd
);
2119 /* System's default file type was set to binary by _fmode in emacs.c. */
2120 ofd
= creat (XSTRING (newname
)->data
, S_IREAD
| S_IWRITE
);
2121 #else /* not MSDOS */
2122 ofd
= creat (XSTRING (newname
)->data
, 0666);
2123 #endif /* not MSDOS */
2126 report_file_error ("Opening output file", Fcons (newname
, Qnil
));
2128 record_unwind_protect (close_file_unwind
, make_number (ofd
));
2132 while ((n
= read (ifd
, buf
, sizeof buf
)) > 0)
2133 if (write (ofd
, buf
, n
) != n
)
2134 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2137 /* Closing the output clobbers the file times on some systems. */
2138 if (close (ofd
) < 0)
2139 report_file_error ("I/O error", Fcons (newname
, Qnil
));
2141 if (input_file_statable_p
)
2143 if (!NILP (keep_date
))
2145 EMACS_TIME atime
, mtime
;
2146 EMACS_SET_SECS_USECS (atime
, st
.st_atime
, 0);
2147 EMACS_SET_SECS_USECS (mtime
, st
.st_mtime
, 0);
2148 if (set_file_times (XSTRING (newname
)->data
, atime
, mtime
))
2149 Fsignal (Qfile_date_error
,
2150 Fcons (build_string ("Cannot set file date"),
2151 Fcons (newname
, Qnil
)));
2154 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
2156 #if defined (__DJGPP__) && __DJGPP__ > 1
2157 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2158 and if it can't, it tells so. Otherwise, under MSDOS we usually
2159 get only the READ bit, which will make the copied file read-only,
2160 so it's better not to chmod at all. */
2161 if ((_djstat_flags
& _STFAIL_WRITEBIT
) == 0)
2162 chmod (XSTRING (newname
)->data
, st
.st_mode
& 07777);
2163 #endif /* DJGPP version 2 or newer */
2169 /* Discard the unwind protects. */
2170 specpdl_ptr
= specpdl
+ count
;
2176 DEFUN ("make-directory-internal", Fmake_directory_internal
,
2177 Smake_directory_internal
, 1, 1, 0,
2178 "Create a new directory named DIRECTORY.")
2180 Lisp_Object directory
;
2183 Lisp_Object handler
;
2185 CHECK_STRING (directory
, 0);
2186 directory
= Fexpand_file_name (directory
, Qnil
);
2188 handler
= Ffind_file_name_handler (directory
, Qmake_directory_internal
);
2189 if (!NILP (handler
))
2190 return call2 (handler
, Qmake_directory_internal
, directory
);
2192 dir
= XSTRING (directory
)->data
;
2195 if (mkdir (dir
) != 0)
2197 if (mkdir (dir
, 0777) != 0)
2199 report_file_error ("Creating directory", Flist (1, &directory
));
2204 DEFUN ("delete-directory", Fdelete_directory
, Sdelete_directory
, 1, 1, "FDelete directory: ",
2205 "Delete the directory named DIRECTORY.")
2207 Lisp_Object directory
;
2210 Lisp_Object handler
;
2212 CHECK_STRING (directory
, 0);
2213 directory
= Fdirectory_file_name (Fexpand_file_name (directory
, Qnil
));
2214 dir
= XSTRING (directory
)->data
;
2216 handler
= Ffind_file_name_handler (directory
, Qdelete_directory
);
2217 if (!NILP (handler
))
2218 return call2 (handler
, Qdelete_directory
, directory
);
2220 if (rmdir (dir
) != 0)
2221 report_file_error ("Removing directory", Flist (1, &directory
));
2226 DEFUN ("delete-file", Fdelete_file
, Sdelete_file
, 1, 1, "fDelete file: ",
2227 "Delete file named FILENAME.\n\
2228 If file has multiple names, it continues to exist with the other names.")
2230 Lisp_Object filename
;
2232 Lisp_Object handler
;
2233 CHECK_STRING (filename
, 0);
2234 filename
= Fexpand_file_name (filename
, Qnil
);
2236 handler
= Ffind_file_name_handler (filename
, Qdelete_file
);
2237 if (!NILP (handler
))
2238 return call2 (handler
, Qdelete_file
, filename
);
2240 if (0 > unlink (XSTRING (filename
)->data
))
2241 report_file_error ("Removing old name", Flist (1, &filename
));
2246 internal_delete_file_1 (ignore
)
2252 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
2255 internal_delete_file (filename
)
2256 Lisp_Object filename
;
2258 return NILP (internal_condition_case_1 (Fdelete_file
, filename
,
2259 Qt
, internal_delete_file_1
));
2262 DEFUN ("rename-file", Frename_file
, Srename_file
, 2, 3,
2263 "fRename file: \nFRename %s to file: \np",
2264 "Rename FILE as NEWNAME. Both args strings.\n\
2265 If file has names other than FILE, it continues to have those names.\n\
2266 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2267 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2268 A number as third arg means request confirmation if NEWNAME already exists.\n\
2269 This is what happens in interactive use with M-x.")
2270 (file
, newname
, ok_if_already_exists
)
2271 Lisp_Object file
, newname
, ok_if_already_exists
;
2274 Lisp_Object args
[2];
2276 Lisp_Object handler
;
2277 struct gcpro gcpro1
, gcpro2
;
2279 GCPRO2 (file
, newname
);
2280 CHECK_STRING (file
, 0);
2281 CHECK_STRING (newname
, 1);
2282 file
= Fexpand_file_name (file
, Qnil
);
2283 newname
= Fexpand_file_name (newname
, Qnil
);
2285 /* If the file name has special constructs in it,
2286 call the corresponding file handler. */
2287 handler
= Ffind_file_name_handler (file
, Qrename_file
);
2289 handler
= Ffind_file_name_handler (newname
, Qrename_file
);
2290 if (!NILP (handler
))
2291 RETURN_UNGCPRO (call4 (handler
, Qrename_file
,
2292 file
, newname
, ok_if_already_exists
));
2294 if (NILP (ok_if_already_exists
)
2295 || INTEGERP (ok_if_already_exists
))
2296 barf_or_query_if_file_exists (newname
, "rename to it",
2297 INTEGERP (ok_if_already_exists
), 0);
2299 if (0 > rename (XSTRING (file
)->data
, XSTRING (newname
)->data
))
2301 if (0 > link (XSTRING (file
)->data
, XSTRING (newname
)->data
)
2302 || 0 > unlink (XSTRING (file
)->data
))
2307 Fcopy_file (file
, newname
,
2308 /* We have already prompted if it was an integer,
2309 so don't have copy-file prompt again. */
2310 NILP (ok_if_already_exists
) ? Qnil
: Qt
, Qt
);
2311 Fdelete_file (file
);
2318 report_file_error ("Renaming", Flist (2, args
));
2321 report_file_error ("Renaming", Flist (2, &file
));
2328 DEFUN ("add-name-to-file", Fadd_name_to_file
, Sadd_name_to_file
, 2, 3,
2329 "fAdd name to file: \nFName to add to %s: \np",
2330 "Give FILE additional name NEWNAME. Both args strings.\n\
2331 Signals a `file-already-exists' error if a file NEWNAME already exists\n\
2332 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2333 A number as third arg means request confirmation if NEWNAME already exists.\n\
2334 This is what happens in interactive use with M-x.")
2335 (file
, newname
, ok_if_already_exists
)
2336 Lisp_Object file
, newname
, ok_if_already_exists
;
2339 Lisp_Object args
[2];
2341 Lisp_Object handler
;
2342 struct gcpro gcpro1
, gcpro2
;
2344 GCPRO2 (file
, newname
);
2345 CHECK_STRING (file
, 0);
2346 CHECK_STRING (newname
, 1);
2347 file
= Fexpand_file_name (file
, Qnil
);
2348 newname
= Fexpand_file_name (newname
, Qnil
);
2350 /* If the file name has special constructs in it,
2351 call the corresponding file handler. */
2352 handler
= Ffind_file_name_handler (file
, Qadd_name_to_file
);
2353 if (!NILP (handler
))
2354 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2355 newname
, ok_if_already_exists
));
2357 /* If the new name has special constructs in it,
2358 call the corresponding file handler. */
2359 handler
= Ffind_file_name_handler (newname
, Qadd_name_to_file
);
2360 if (!NILP (handler
))
2361 RETURN_UNGCPRO (call4 (handler
, Qadd_name_to_file
, file
,
2362 newname
, ok_if_already_exists
));
2364 if (NILP (ok_if_already_exists
)
2365 || INTEGERP (ok_if_already_exists
))
2366 barf_or_query_if_file_exists (newname
, "make it a new name",
2367 INTEGERP (ok_if_already_exists
), 0);
2369 unlink (XSTRING (newname
)->data
);
2370 if (0 > link (XSTRING (file
)->data
, XSTRING (newname
)->data
))
2375 report_file_error ("Adding new name", Flist (2, args
));
2377 report_file_error ("Adding new name", Flist (2, &file
));
2386 DEFUN ("make-symbolic-link", Fmake_symbolic_link
, Smake_symbolic_link
, 2, 3,
2387 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
2388 "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
2389 Signals a `file-already-exists' error if a file LINKNAME already exists\n\
2390 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
2391 A number as third arg means request confirmation if LINKNAME already exists.\n\
2392 This happens for interactive use with M-x.")
2393 (filename
, linkname
, ok_if_already_exists
)
2394 Lisp_Object filename
, linkname
, ok_if_already_exists
;
2397 Lisp_Object args
[2];
2399 Lisp_Object handler
;
2400 struct gcpro gcpro1
, gcpro2
;
2402 GCPRO2 (filename
, linkname
);
2403 CHECK_STRING (filename
, 0);
2404 CHECK_STRING (linkname
, 1);
2405 /* If the link target has a ~, we must expand it to get
2406 a truly valid file name. Otherwise, do not expand;
2407 we want to permit links to relative file names. */
2408 if (XSTRING (filename
)->data
[0] == '~')
2409 filename
= Fexpand_file_name (filename
, Qnil
);
2410 linkname
= Fexpand_file_name (linkname
, Qnil
);
2412 /* If the file name has special constructs in it,
2413 call the corresponding file handler. */
2414 handler
= Ffind_file_name_handler (filename
, Qmake_symbolic_link
);
2415 if (!NILP (handler
))
2416 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2417 linkname
, ok_if_already_exists
));
2419 /* If the new link name has special constructs in it,
2420 call the corresponding file handler. */
2421 handler
= Ffind_file_name_handler (linkname
, Qmake_symbolic_link
);
2422 if (!NILP (handler
))
2423 RETURN_UNGCPRO (call4 (handler
, Qmake_symbolic_link
, filename
,
2424 linkname
, ok_if_already_exists
));
2426 if (NILP (ok_if_already_exists
)
2427 || INTEGERP (ok_if_already_exists
))
2428 barf_or_query_if_file_exists (linkname
, "make it a link",
2429 INTEGERP (ok_if_already_exists
), 0);
2430 if (0 > symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2432 /* If we didn't complain already, silently delete existing file. */
2433 if (errno
== EEXIST
)
2435 unlink (XSTRING (linkname
)->data
);
2436 if (0 <= symlink (XSTRING (filename
)->data
, XSTRING (linkname
)->data
))
2446 report_file_error ("Making symbolic link", Flist (2, args
));
2448 report_file_error ("Making symbolic link", Flist (2, &filename
));
2454 #endif /* S_IFLNK */
2458 DEFUN ("define-logical-name", Fdefine_logical_name
, Sdefine_logical_name
,
2459 2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
2460 "Define the job-wide logical name NAME to have the value STRING.\n\
2461 If STRING is nil or a null string, the logical name NAME is deleted.")
2466 CHECK_STRING (name
, 0);
2468 delete_logical_name (XSTRING (name
)->data
);
2471 CHECK_STRING (string
, 1);
2473 if (XSTRING (string
)->size
== 0)
2474 delete_logical_name (XSTRING (name
)->data
);
2476 define_logical_name (XSTRING (name
)->data
, XSTRING (string
)->data
);
2485 DEFUN ("sysnetunam", Fsysnetunam
, Ssysnetunam
, 2, 2, 0,
2486 "Open a network connection to PATH using LOGIN as the login string.")
2488 Lisp_Object path
, login
;
2492 CHECK_STRING (path
, 0);
2493 CHECK_STRING (login
, 0);
2495 netresult
= netunam (XSTRING (path
)->data
, XSTRING (login
)->data
);
2497 if (netresult
== -1)
2502 #endif /* HPUX_NET */
2504 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p
, Sfile_name_absolute_p
,
2506 "Return t if file FILENAME specifies an absolute file name.\n\
2507 On Unix, this is a name starting with a `/' or a `~'.")
2509 Lisp_Object filename
;
2513 CHECK_STRING (filename
, 0);
2514 ptr
= XSTRING (filename
)->data
;
2515 if (IS_DIRECTORY_SEP (*ptr
) || *ptr
== '~'
2517 /* ??? This criterion is probably wrong for '<'. */
2518 || index (ptr
, ':') || index (ptr
, '<')
2519 || (*ptr
== '[' && (ptr
[1] != '-' || (ptr
[2] != '.' && ptr
[2] != ']'))
2523 || (IS_DRIVE (*ptr
) && ptr
[1] == ':' && IS_DIRECTORY_SEP (ptr
[2]))
2531 /* Return nonzero if file FILENAME exists and can be executed. */
2534 check_executable (filename
)
2538 int len
= strlen (filename
);
2541 if (stat (filename
, &st
) < 0)
2543 #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
2544 return ((st
.st_mode
& S_IEXEC
) != 0);
2546 return (S_ISREG (st
.st_mode
)
2548 && (stricmp ((suffix
= filename
+ len
-4), ".com") == 0
2549 || stricmp (suffix
, ".exe") == 0
2550 || stricmp (suffix
, ".bat") == 0)
2551 || (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2552 #endif /* not WINDOWSNT */
2553 #else /* not DOS_NT */
2554 #ifdef HAVE_EUIDACCESS
2555 return (euidaccess (filename
, 1) >= 0);
2557 /* Access isn't quite right because it uses the real uid
2558 and we really want to test with the effective uid.
2559 But Unix doesn't give us a right way to do it. */
2560 return (access (filename
, 1) >= 0);
2562 #endif /* not DOS_NT */
2565 /* Return nonzero if file FILENAME exists and can be written. */
2568 check_writable (filename
)
2573 if (stat (filename
, &st
) < 0)
2575 return (st
.st_mode
& S_IWRITE
|| (st
.st_mode
& S_IFMT
) == S_IFDIR
);
2576 #else /* not MSDOS */
2577 #ifdef HAVE_EUIDACCESS
2578 return (euidaccess (filename
, 2) >= 0);
2580 /* Access isn't quite right because it uses the real uid
2581 and we really want to test with the effective uid.
2582 But Unix doesn't give us a right way to do it.
2583 Opening with O_WRONLY could work for an ordinary file,
2584 but would lose for directories. */
2585 return (access (filename
, 2) >= 0);
2587 #endif /* not MSDOS */
2590 DEFUN ("file-exists-p", Ffile_exists_p
, Sfile_exists_p
, 1, 1, 0,
2591 "Return t if file FILENAME exists. (This does not mean you can read it.)\n\
2592 See also `file-readable-p' and `file-attributes'.")
2594 Lisp_Object filename
;
2596 Lisp_Object absname
;
2597 Lisp_Object handler
;
2598 struct stat statbuf
;
2600 CHECK_STRING (filename
, 0);
2601 absname
= Fexpand_file_name (filename
, Qnil
);
2603 /* If the file name has special constructs in it,
2604 call the corresponding file handler. */
2605 handler
= Ffind_file_name_handler (absname
, Qfile_exists_p
);
2606 if (!NILP (handler
))
2607 return call2 (handler
, Qfile_exists_p
, absname
);
2609 return (stat (XSTRING (absname
)->data
, &statbuf
) >= 0) ? Qt
: Qnil
;
2612 DEFUN ("file-executable-p", Ffile_executable_p
, Sfile_executable_p
, 1, 1, 0,
2613 "Return t if FILENAME can be executed by you.\n\
2614 For a directory, this means you can access files in that directory.")
2616 Lisp_Object filename
;
2619 Lisp_Object absname
;
2620 Lisp_Object handler
;
2622 CHECK_STRING (filename
, 0);
2623 absname
= Fexpand_file_name (filename
, Qnil
);
2625 /* If the file name has special constructs in it,
2626 call the corresponding file handler. */
2627 handler
= Ffind_file_name_handler (absname
, Qfile_executable_p
);
2628 if (!NILP (handler
))
2629 return call2 (handler
, Qfile_executable_p
, absname
);
2631 return (check_executable (XSTRING (absname
)->data
) ? Qt
: Qnil
);
2634 DEFUN ("file-readable-p", Ffile_readable_p
, Sfile_readable_p
, 1, 1, 0,
2635 "Return t if file FILENAME exists and you can read it.\n\
2636 See also `file-exists-p' and `file-attributes'.")
2638 Lisp_Object filename
;
2640 Lisp_Object absname
;
2641 Lisp_Object handler
;
2644 struct stat statbuf
;
2646 CHECK_STRING (filename
, 0);
2647 absname
= Fexpand_file_name (filename
, Qnil
);
2649 /* If the file name has special constructs in it,
2650 call the corresponding file handler. */
2651 handler
= Ffind_file_name_handler (absname
, Qfile_readable_p
);
2652 if (!NILP (handler
))
2653 return call2 (handler
, Qfile_readable_p
, absname
);
2656 /* Under MS-DOS and Windows, open does not work for directories. */
2657 if (access (XSTRING (absname
)->data
, 0) == 0)
2660 #else /* not DOS_NT */
2662 #if defined (S_ISFIFO) && defined (O_NONBLOCK)
2663 /* Opening a fifo without O_NONBLOCK can wait.
2664 We don't want to wait. But we don't want to mess wth O_NONBLOCK
2665 except in the case of a fifo, on a system which handles it. */
2666 desc
= stat (XSTRING (absname
)->data
, &statbuf
);
2669 if (S_ISFIFO (statbuf
.st_mode
))
2670 flags
|= O_NONBLOCK
;
2672 desc
= open (XSTRING (absname
)->data
, flags
);
2677 #endif /* not DOS_NT */
2680 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2682 DEFUN ("file-writable-p", Ffile_writable_p
, Sfile_writable_p
, 1, 1, 0,
2683 "Return t if file FILENAME can be written or created by you.")
2685 Lisp_Object filename
;
2687 Lisp_Object absname
, dir
;
2688 Lisp_Object handler
;
2689 struct stat statbuf
;
2691 CHECK_STRING (filename
, 0);
2692 absname
= Fexpand_file_name (filename
, Qnil
);
2694 /* If the file name has special constructs in it,
2695 call the corresponding file handler. */
2696 handler
= Ffind_file_name_handler (absname
, Qfile_writable_p
);
2697 if (!NILP (handler
))
2698 return call2 (handler
, Qfile_writable_p
, absname
);
2700 if (stat (XSTRING (absname
)->data
, &statbuf
) >= 0)
2701 return (check_writable (XSTRING (absname
)->data
)
2703 dir
= Ffile_name_directory (absname
);
2706 dir
= Fdirectory_file_name (dir
);
2710 dir
= Fdirectory_file_name (dir
);
2712 return (check_writable (!NILP (dir
) ? (char *) XSTRING (dir
)->data
: "")
2716 DEFUN ("access-file", Faccess_file
, Saccess_file
, 2, 2, 0,
2717 "Access file FILENAME, and get an error if that does not work.\n\
2718 The second argument STRING is used in the error message.\n\
2719 If there is no error, we return nil.")
2721 Lisp_Object filename
, string
;
2723 Lisp_Object handler
;
2726 CHECK_STRING (filename
, 0);
2728 /* If the file name has special constructs in it,
2729 call the corresponding file handler. */
2730 handler
= Ffind_file_name_handler (filename
, Qaccess_file
);
2731 if (!NILP (handler
))
2732 return call3 (handler
, Qaccess_file
, filename
, string
);
2734 fd
= open (XSTRING (filename
)->data
, O_RDONLY
);
2736 report_file_error (XSTRING (string
)->data
, Fcons (filename
, Qnil
));
2742 DEFUN ("file-symlink-p", Ffile_symlink_p
, Sfile_symlink_p
, 1, 1, 0,
2743 "Return non-nil if file FILENAME is the name of a symbolic link.\n\
2744 The value is the name of the file to which it is linked.\n\
2745 Otherwise returns nil.")
2747 Lisp_Object filename
;
2754 Lisp_Object handler
;
2756 CHECK_STRING (filename
, 0);
2757 filename
= Fexpand_file_name (filename
, Qnil
);
2759 /* If the file name has special constructs in it,
2760 call the corresponding file handler. */
2761 handler
= Ffind_file_name_handler (filename
, Qfile_symlink_p
);
2762 if (!NILP (handler
))
2763 return call2 (handler
, Qfile_symlink_p
, filename
);
2768 buf
= (char *) xmalloc (bufsize
);
2769 bzero (buf
, bufsize
);
2770 valsize
= readlink (XSTRING (filename
)->data
, buf
, bufsize
);
2771 if (valsize
< bufsize
) break;
2772 /* Buffer was not long enough */
2781 val
= make_string (buf
, valsize
);
2784 #else /* not S_IFLNK */
2786 #endif /* not S_IFLNK */
2789 DEFUN ("file-directory-p", Ffile_directory_p
, Sfile_directory_p
, 1, 1, 0,
2790 "Return t if FILENAME names an existing directory.")
2792 Lisp_Object filename
;
2794 register Lisp_Object absname
;
2796 Lisp_Object handler
;
2798 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2800 /* If the file name has special constructs in it,
2801 call the corresponding file handler. */
2802 handler
= Ffind_file_name_handler (absname
, Qfile_directory_p
);
2803 if (!NILP (handler
))
2804 return call2 (handler
, Qfile_directory_p
, absname
);
2806 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2808 return (st
.st_mode
& S_IFMT
) == S_IFDIR
? Qt
: Qnil
;
2811 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p
, Sfile_accessible_directory_p
, 1, 1, 0,
2812 "Return t if file FILENAME is the name of a directory as a file,\n\
2813 and files in that directory can be opened by you. In order to use a\n\
2814 directory as a buffer's current directory, this predicate must return true.\n\
2815 A directory name spec may be given instead; then the value is t\n\
2816 if the directory so specified exists and really is a readable and\n\
2817 searchable directory.")
2819 Lisp_Object filename
;
2821 Lisp_Object handler
;
2823 struct gcpro gcpro1
;
2825 /* If the file name has special constructs in it,
2826 call the corresponding file handler. */
2827 handler
= Ffind_file_name_handler (filename
, Qfile_accessible_directory_p
);
2828 if (!NILP (handler
))
2829 return call2 (handler
, Qfile_accessible_directory_p
, filename
);
2831 /* It's an unlikely combination, but yes we really do need to gcpro:
2832 Suppose that file-accessible-directory-p has no handler, but
2833 file-directory-p does have a handler; this handler causes a GC which
2834 relocates the string in `filename'; and finally file-directory-p
2835 returns non-nil. Then we would end up passing a garbaged string
2836 to file-executable-p. */
2838 tem
= (NILP (Ffile_directory_p (filename
))
2839 || NILP (Ffile_executable_p (filename
)));
2841 return tem
? Qnil
: Qt
;
2844 DEFUN ("file-regular-p", Ffile_regular_p
, Sfile_regular_p
, 1, 1, 0,
2845 "Return t if file FILENAME is the name of a regular file.\n\
2846 This is the sort of file that holds an ordinary stream of data bytes.")
2848 Lisp_Object filename
;
2850 register Lisp_Object absname
;
2852 Lisp_Object handler
;
2854 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2856 /* If the file name has special constructs in it,
2857 call the corresponding file handler. */
2858 handler
= Ffind_file_name_handler (absname
, Qfile_regular_p
);
2859 if (!NILP (handler
))
2860 return call2 (handler
, Qfile_regular_p
, absname
);
2862 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2864 return (st
.st_mode
& S_IFMT
) == S_IFREG
? Qt
: Qnil
;
2867 DEFUN ("file-modes", Ffile_modes
, Sfile_modes
, 1, 1, 0,
2868 "Return mode bits of file named FILENAME, as an integer.")
2870 Lisp_Object filename
;
2872 Lisp_Object absname
;
2874 Lisp_Object handler
;
2876 absname
= expand_and_dir_to_file (filename
, current_buffer
->directory
);
2878 /* If the file name has special constructs in it,
2879 call the corresponding file handler. */
2880 handler
= Ffind_file_name_handler (absname
, Qfile_modes
);
2881 if (!NILP (handler
))
2882 return call2 (handler
, Qfile_modes
, absname
);
2884 if (stat (XSTRING (absname
)->data
, &st
) < 0)
2886 #if defined (MSDOS) && __DJGPP__ < 2
2887 if (check_executable (XSTRING (absname
)->data
))
2888 st
.st_mode
|= S_IEXEC
;
2889 #endif /* MSDOS && __DJGPP__ < 2 */
2891 return make_number (st
.st_mode
& 07777);
2894 DEFUN ("set-file-modes", Fset_file_modes
, Sset_file_modes
, 2, 2, 0,
2895 "Set mode bits of file named FILENAME to MODE (an integer).\n\
2896 Only the 12 low bits of MODE are used.")
2898 Lisp_Object filename
, mode
;
2900 Lisp_Object absname
;
2901 Lisp_Object handler
;
2903 absname
= Fexpand_file_name (filename
, current_buffer
->directory
);
2904 CHECK_NUMBER (mode
, 1);
2906 /* If the file name has special constructs in it,
2907 call the corresponding file handler. */
2908 handler
= Ffind_file_name_handler (absname
, Qset_file_modes
);
2909 if (!NILP (handler
))
2910 return call3 (handler
, Qset_file_modes
, absname
, mode
);
2912 if (chmod (XSTRING (absname
)->data
, XINT (mode
)) < 0)
2913 report_file_error ("Doing chmod", Fcons (absname
, Qnil
));
2918 DEFUN ("set-default-file-modes", Fset_default_file_modes
, Sset_default_file_modes
, 1, 1, 0,
2919 "Set the file permission bits for newly created files.\n\
2920 The argument MODE should be an integer; only the low 9 bits are used.\n\
2921 This setting is inherited by subprocesses.")
2925 CHECK_NUMBER (mode
, 0);
2927 umask ((~ XINT (mode
)) & 0777);
2932 DEFUN ("default-file-modes", Fdefault_file_modes
, Sdefault_file_modes
, 0, 0, 0,
2933 "Return the default file protection for created files.\n\
2934 The value is an integer.")
2940 realmask
= umask (0);
2943 XSETINT (value
, (~ realmask
) & 0777);
2949 DEFUN ("unix-sync", Funix_sync
, Sunix_sync
, 0, 0, "",
2950 "Tell Unix to finish all pending disk updates.")
2959 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p
, Sfile_newer_than_file_p
, 2, 2, 0,
2960 "Return t if file FILE1 is newer than file FILE2.\n\
2961 If FILE1 does not exist, the answer is nil;\n\
2962 otherwise, if FILE2 does not exist, the answer is t.")
2964 Lisp_Object file1
, file2
;
2966 Lisp_Object absname1
, absname2
;
2969 Lisp_Object handler
;
2970 struct gcpro gcpro1
, gcpro2
;
2972 CHECK_STRING (file1
, 0);
2973 CHECK_STRING (file2
, 0);
2976 GCPRO2 (absname1
, file2
);
2977 absname1
= expand_and_dir_to_file (file1
, current_buffer
->directory
);
2978 absname2
= expand_and_dir_to_file (file2
, current_buffer
->directory
);
2981 /* If the file name has special constructs in it,
2982 call the corresponding file handler. */
2983 handler
= Ffind_file_name_handler (absname1
, Qfile_newer_than_file_p
);
2985 handler
= Ffind_file_name_handler (absname2
, Qfile_newer_than_file_p
);
2986 if (!NILP (handler
))
2987 return call3 (handler
, Qfile_newer_than_file_p
, absname1
, absname2
);
2989 if (stat (XSTRING (absname1
)->data
, &st
) < 0)
2992 mtime1
= st
.st_mtime
;
2994 if (stat (XSTRING (absname2
)->data
, &st
) < 0)
2997 return (mtime1
> st
.st_mtime
) ? Qt
: Qnil
;
3001 Lisp_Object Qfind_buffer_file_type
;
3004 #ifndef READ_BUF_SIZE
3005 #define READ_BUF_SIZE (64 << 10)
3008 DEFUN ("insert-file-contents", Finsert_file_contents
, Sinsert_file_contents
,
3010 "Insert contents of file FILENAME after point.\n\
3011 Returns list of absolute file name and length of data inserted.\n\
3012 If second argument VISIT is non-nil, the buffer's visited filename\n\
3013 and last save file modtime are set, and it is marked unmodified.\n\
3014 If visiting and the file does not exist, visiting is completed\n\
3015 before the error is signaled.\n\
3016 The optional third and fourth arguments BEG and END\n\
3017 specify what portion of the file to insert.\n\
3018 If VISIT is non-nil, BEG and END must be nil.\n\
3020 If optional fifth argument REPLACE is non-nil,\n\
3021 it means replace the current buffer contents (in the accessible portion)\n\
3022 with the file contents. This is better than simply deleting and inserting\n\
3023 the whole thing because (1) it preserves some marker positions\n\
3024 and (2) it puts less data in the undo list.\n\
3025 When REPLACE is non-nil, the value is the number of characters actually read,\n\
3026 which is often less than the number of characters to be read.\n\
3027 This does code conversion according to the value of\n\
3028 `coding-system-for-read' or `file-coding-system-alist',\n\
3029 and sets the variable `last-coding-system-used' to the coding system\n\
3031 (filename
, visit
, beg
, end
, replace
)
3032 Lisp_Object filename
, visit
, beg
, end
, replace
;
3036 register int inserted
= 0;
3037 register int how_much
;
3038 register int unprocessed
;
3039 int count
= specpdl_ptr
- specpdl
;
3040 struct gcpro gcpro1
, gcpro2
, gcpro3
;
3041 Lisp_Object handler
, val
, insval
;
3044 int not_regular
= 0;
3045 char read_buf
[READ_BUF_SIZE
];
3046 struct coding_system coding
;
3047 unsigned char buffer
[1 << 14];
3048 int replace_handled
= 0;
3050 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3051 error ("Cannot do file visiting in an indirect buffer");
3053 if (!NILP (current_buffer
->read_only
))
3054 Fbarf_if_buffer_read_only ();
3059 GCPRO3 (filename
, val
, p
);
3061 CHECK_STRING (filename
, 0);
3062 filename
= Fexpand_file_name (filename
, Qnil
);
3064 /* If the file name has special constructs in it,
3065 call the corresponding file handler. */
3066 handler
= Ffind_file_name_handler (filename
, Qinsert_file_contents
);
3067 if (!NILP (handler
))
3069 val
= call6 (handler
, Qinsert_file_contents
, filename
,
3070 visit
, beg
, end
, replace
);
3077 if (stat (XSTRING (filename
)->data
, &st
) < 0)
3079 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0
3080 || fstat (fd
, &st
) < 0)
3081 #endif /* not APOLLO */
3083 if (fd
>= 0) close (fd
);
3086 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3093 /* This code will need to be changed in order to work on named
3094 pipes, and it's probably just not worth it. So we should at
3095 least signal an error. */
3096 if (!S_ISREG (st
.st_mode
))
3103 if (! NILP (replace
) || ! NILP (beg
) || ! NILP (end
))
3104 Fsignal (Qfile_error
,
3105 Fcons (build_string ("not a regular file"),
3106 Fcons (filename
, Qnil
)));
3111 if ((fd
= open (XSTRING (filename
)->data
, O_RDONLY
)) < 0)
3114 /* Replacement should preserve point as it preserves markers. */
3115 if (!NILP (replace
))
3116 record_unwind_protect (restore_point_unwind
, Fpoint_marker ());
3118 record_unwind_protect (close_file_unwind
, make_number (fd
));
3120 /* Supposedly happens on VMS. */
3121 if (! not_regular
&& st
.st_size
< 0)
3122 error ("File size is negative");
3124 if (!NILP (beg
) || !NILP (end
))
3126 error ("Attempt to visit less than an entire file");
3129 CHECK_NUMBER (beg
, 0);
3131 XSETFASTINT (beg
, 0);
3134 CHECK_NUMBER (end
, 0);
3139 XSETINT (end
, st
.st_size
);
3140 if (XINT (end
) != st
.st_size
)
3141 error ("Maximum buffer size exceeded");
3145 /* Decide the coding-system of the file. */
3147 Lisp_Object val
= Qnil
;
3149 if (!NILP (Vcoding_system_for_read
))
3150 val
= Vcoding_system_for_read
;
3151 else if (NILP (current_buffer
->enable_multibyte_characters
))
3155 if (! NILP (Vset_auto_coding_function
))
3157 /* Find a coding system specified in the heading two lines
3158 or in the tailing several lines of the file. We assume
3159 that the 1K-byte and 3K-byte for heading and tailing
3160 respectively are sufficient fot this purpose. */
3161 int how_many
, nread
;
3163 if (st
.st_size
<= (1024 * 4))
3164 nread
= read (fd
, read_buf
, 1024 * 4);
3167 nread
= read (fd
, read_buf
, 1024);
3170 if (lseek (fd
, st
.st_size
- (1024 * 3), 0) < 0)
3171 report_file_error ("Setting file position",
3172 Fcons (filename
, Qnil
));
3173 nread
+= read (fd
, read_buf
+ nread
, 1024 * 3);
3178 error ("IO error reading %s: %s",
3179 XSTRING (filename
)->data
, strerror (errno
));
3182 val
= call1 (Vset_auto_coding_function
,
3183 make_string (read_buf
, nread
));
3184 /* Rewind the file for the actual read done later. */
3185 if (lseek (fd
, 0, 0) < 0)
3186 report_file_error ("Setting file position",
3187 Fcons (filename
, Qnil
));
3192 Lisp_Object args
[6], coding_systems
;
3194 args
[0] = Qinsert_file_contents
, args
[1] = filename
,
3195 args
[2] = visit
, args
[3] = beg
, args
[4] = end
, args
[5] = replace
;
3196 coding_systems
= Ffind_operation_coding_system (6, args
);
3197 if (CONSP (coding_systems
)) val
= XCONS (coding_systems
)->car
;
3200 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3203 /* If requested, replace the accessible part of the buffer
3204 with the file contents. Avoid replacing text at the
3205 beginning or end of the buffer that matches the file contents;
3206 that preserves markers pointing to the unchanged parts.
3208 Here we implement this feature in an optimized way
3209 for the case where code conversion is NOT needed.
3210 The following if-statement handles the case of conversion
3211 in a less optimal way.
3213 If the code conversion is "automatic" then we try using this
3214 method and hope for the best.
3215 But if we discover the need for conversion, we give up on this method
3216 and let the following if-statement handle the replace job. */
3218 && CODING_MAY_REQUIRE_NO_CONVERSION (&coding
))
3220 int same_at_start
= BEGV
;
3221 int same_at_end
= ZV
;
3223 /* There is still a possibility we will find the need to do code
3224 conversion. If that happens, we set this variable to 1 to
3225 give up on handling REPLACE in the optimized way. */
3226 int giveup_match_end
= 0;
3228 if (XINT (beg
) != 0)
3230 if (lseek (fd
, XINT (beg
), 0) < 0)
3231 report_file_error ("Setting file position",
3232 Fcons (filename
, Qnil
));
3237 /* Count how many chars at the start of the file
3238 match the text at the beginning of the buffer. */
3243 nread
= read (fd
, buffer
, sizeof buffer
);
3245 error ("IO error reading %s: %s",
3246 XSTRING (filename
)->data
, strerror (errno
));
3247 else if (nread
== 0)
3250 if (coding
.type
== coding_type_undecided
)
3251 detect_coding (&coding
, buffer
, nread
);
3252 if (coding
.type
!= coding_type_undecided
3253 && coding
.type
!= coding_type_no_conversion
3254 && coding
.type
!= coding_type_emacs_mule
)
3255 /* We found that the file should be decoded somehow.
3256 Let's give up here. */
3258 giveup_match_end
= 1;
3262 if (coding
.eol_type
== CODING_EOL_UNDECIDED
)
3263 detect_eol (&coding
, buffer
, nread
);
3264 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3265 && coding
.eol_type
!= CODING_EOL_LF
)
3266 /* We found that the format of eol should be decoded.
3267 Let's give up here. */
3269 giveup_match_end
= 1;
3274 while (bufpos
< nread
&& same_at_start
< ZV
3275 && FETCH_BYTE (same_at_start
) == buffer
[bufpos
])
3276 same_at_start
++, bufpos
++;
3277 /* If we found a discrepancy, stop the scan.
3278 Otherwise loop around and scan the next bufferful. */
3279 if (bufpos
!= nread
)
3283 /* If the file matches the buffer completely,
3284 there's no need to replace anything. */
3285 if (same_at_start
- BEGV
== XINT (end
))
3289 /* Truncate the buffer to the size of the file. */
3290 del_range_1 (same_at_start
, same_at_end
, 0);
3295 /* Count how many chars at the end of the file
3296 match the text at the end of the buffer. But, if we have
3297 already found that decoding is necessary, don't waste time. */
3298 while (!giveup_match_end
)
3300 int total_read
, nread
, bufpos
, curpos
, trial
;
3302 /* At what file position are we now scanning? */
3303 curpos
= XINT (end
) - (ZV
- same_at_end
);
3304 /* If the entire file matches the buffer tail, stop the scan. */
3307 /* How much can we scan in the next step? */
3308 trial
= min (curpos
, sizeof buffer
);
3309 if (lseek (fd
, curpos
- trial
, 0) < 0)
3310 report_file_error ("Setting file position",
3311 Fcons (filename
, Qnil
));
3314 while (total_read
< trial
)
3316 nread
= read (fd
, buffer
+ total_read
, trial
- total_read
);
3318 error ("IO error reading %s: %s",
3319 XSTRING (filename
)->data
, strerror (errno
));
3320 total_read
+= nread
;
3322 /* Scan this bufferful from the end, comparing with
3323 the Emacs buffer. */
3324 bufpos
= total_read
;
3325 /* Compare with same_at_start to avoid counting some buffer text
3326 as matching both at the file's beginning and at the end. */
3327 while (bufpos
> 0 && same_at_end
> same_at_start
3328 && FETCH_BYTE (same_at_end
- 1) == buffer
[bufpos
- 1])
3329 same_at_end
--, bufpos
--;
3331 /* If we found a discrepancy, stop the scan.
3332 Otherwise loop around and scan the preceding bufferful. */
3335 /* If this discrepancy is because of code conversion,
3336 we cannot use this method; giveup and try the other. */
3337 if (same_at_end
> same_at_start
3338 && FETCH_BYTE (same_at_end
- 1) >= 0200
3339 && ! NILP (current_buffer
->enable_multibyte_characters
)
3340 && ! CODING_REQUIRE_NO_CONVERSION (&coding
))
3341 giveup_match_end
= 1;
3347 if (! giveup_match_end
)
3349 /* We win! We can handle REPLACE the optimized way. */
3351 /* Extends the end of non-matching text area to multibyte
3352 character boundary. */
3353 if (! NILP (current_buffer
->enable_multibyte_characters
))
3354 while (same_at_end
< ZV
&& ! CHAR_HEAD_P (POS_ADDR (same_at_end
)))
3357 /* Don't try to reuse the same piece of text twice. */
3358 overlap
= same_at_start
- BEGV
- (same_at_end
+ st
.st_size
- ZV
);
3360 same_at_end
+= overlap
;
3362 /* Arrange to read only the nonmatching middle part of the file. */
3363 XSETFASTINT (beg
, XINT (beg
) + (same_at_start
- BEGV
));
3364 XSETFASTINT (end
, XINT (end
) - (ZV
- same_at_end
));
3366 del_range_1 (same_at_start
, same_at_end
, 0);
3367 /* Insert from the file at the proper position. */
3368 SET_PT (same_at_start
);
3370 /* If display currently starts at beginning of line,
3371 keep it that way. */
3372 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3373 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3375 replace_handled
= 1;
3379 /* If requested, replace the accessible part of the buffer
3380 with the file contents. Avoid replacing text at the
3381 beginning or end of the buffer that matches the file contents;
3382 that preserves markers pointing to the unchanged parts.
3384 Here we implement this feature for the case where code conversion
3385 is needed, in a simple way that needs a lot of memory.
3386 The preceding if-statement handles the case of no conversion
3387 in a more optimized way. */
3388 if (!NILP (replace
) && ! replace_handled
)
3390 int same_at_start
= BEGV
;
3391 int same_at_end
= ZV
;
3394 /* Make sure that the gap is large enough. */
3395 int bufsize
= 2 * st
.st_size
;
3396 unsigned char *conversion_buffer
= (unsigned char *) xmalloc (bufsize
);
3398 /* First read the whole file, performing code conversion into
3399 CONVERSION_BUFFER. */
3401 if (lseek (fd
, XINT (beg
), 0) < 0)
3403 free (conversion_buffer
);
3404 report_file_error ("Setting file position",
3405 Fcons (filename
, Qnil
));
3408 total
= st
.st_size
; /* Total bytes in the file. */
3409 how_much
= 0; /* Bytes read from file so far. */
3410 inserted
= 0; /* Bytes put into CONVERSION_BUFFER so far. */
3411 unprocessed
= 0; /* Bytes not processed in previous loop. */
3413 while (how_much
< total
)
3415 /* try is reserved in some compilers (Microsoft C) */
3416 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3417 char *destination
= read_buf
+ unprocessed
;
3420 /* Allow quitting out of the actual I/O. */
3423 this = read (fd
, destination
, trytry
);
3426 if (this < 0 || this + unprocessed
== 0)
3434 if (! CODING_REQUIRE_NO_CONVERSION (&coding
))
3436 int require
, produced
, consumed
;
3438 this += unprocessed
;
3440 /* If we are using more space than estimated,
3441 make CONVERSION_BUFFER bigger. */
3442 require
= decoding_buffer_size (&coding
, this);
3443 if (inserted
+ require
+ 2 * (total
- how_much
) > bufsize
)
3445 bufsize
= inserted
+ require
+ 2 * (total
- how_much
);
3446 conversion_buffer
= (unsigned char *) xrealloc (conversion_buffer
, bufsize
);
3449 /* Convert this batch with results in CONVERSION_BUFFER. */
3450 if (how_much
>= total
) /* This is the last block. */
3451 coding
.last_block
= 1;
3452 produced
= decode_coding (&coding
, read_buf
,
3453 conversion_buffer
+ inserted
,
3454 this, bufsize
- inserted
,
3457 /* Save for next iteration whatever we didn't convert. */
3458 unprocessed
= this - consumed
;
3459 bcopy (read_buf
+ consumed
, read_buf
, unprocessed
);
3466 /* At this point, INSERTED is how many characters
3467 are present in CONVERSION_BUFFER.
3468 HOW_MUCH should equal TOTAL,
3469 or should be <= 0 if we couldn't read the file. */
3473 free (conversion_buffer
);
3476 error ("IO error reading %s: %s",
3477 XSTRING (filename
)->data
, strerror (errno
));
3478 else if (how_much
== -2)
3479 error ("maximum buffer size exceeded");
3482 /* Compare the beginning of the converted file
3483 with the buffer text. */
3486 while (bufpos
< inserted
&& same_at_start
< same_at_end
3487 && FETCH_BYTE (same_at_start
) == conversion_buffer
[bufpos
])
3488 same_at_start
++, bufpos
++;
3490 /* If the file matches the buffer completely,
3491 there's no need to replace anything. */
3493 if (bufpos
== inserted
)
3495 free (conversion_buffer
);
3498 /* Truncate the buffer to the size of the file. */
3499 del_range_1 (same_at_start
, same_at_end
, 0);
3503 /* Scan this bufferful from the end, comparing with
3504 the Emacs buffer. */
3507 /* Compare with same_at_start to avoid counting some buffer text
3508 as matching both at the file's beginning and at the end. */
3509 while (bufpos
> 0 && same_at_end
> same_at_start
3510 && FETCH_BYTE (same_at_end
- 1) == conversion_buffer
[bufpos
- 1])
3511 same_at_end
--, bufpos
--;
3513 /* Don't try to reuse the same piece of text twice. */
3514 overlap
= same_at_start
- BEGV
- (same_at_end
+ inserted
- ZV
);
3516 same_at_end
+= overlap
;
3518 /* If display currently starts at beginning of line,
3519 keep it that way. */
3520 if (XBUFFER (XWINDOW (selected_window
)->buffer
) == current_buffer
)
3521 XWINDOW (selected_window
)->start_at_line_beg
= Fbolp ();
3523 /* Replace the chars that we need to replace,
3524 and update INSERTED to equal the number of bytes
3525 we are taking from the file. */
3526 inserted
-= (Z
- same_at_end
) + (same_at_start
- BEG
);
3527 move_gap (same_at_start
);
3528 del_range_1 (same_at_start
, same_at_end
, 0);
3529 SET_PT (same_at_start
);
3530 insert_1 (conversion_buffer
+ same_at_start
- BEG
, inserted
, 0, 0);
3532 free (conversion_buffer
);
3541 register Lisp_Object temp
;
3543 total
= XINT (end
) - XINT (beg
);
3545 /* Make sure point-max won't overflow after this insertion. */
3546 XSETINT (temp
, total
);
3547 if (total
!= XINT (temp
))
3548 error ("Maximum buffer size exceeded");
3551 /* For a special file, all we can do is guess. */
3552 total
= READ_BUF_SIZE
;
3554 if (NILP (visit
) && total
> 0)
3555 prepare_to_modify_buffer (PT
, PT
, NULL
);
3558 if (GAP_SIZE
< total
)
3559 make_gap (total
- GAP_SIZE
);
3561 if (XINT (beg
) != 0 || !NILP (replace
))
3563 if (lseek (fd
, XINT (beg
), 0) < 0)
3564 report_file_error ("Setting file position", Fcons (filename
, Qnil
));
3567 /* In the following loop, HOW_MUCH contains the total bytes read so
3568 far. Before exiting the loop, it is set to -1 if I/O error
3569 occurs, set to -2 if the maximum buffer size is exceeded. */
3571 /* Total bytes inserted. */
3573 /* Bytes not processed in the previous loop because short gap size. */
3575 while (how_much
< total
)
3577 /* try is reserved in some compilers (Microsoft C) */
3578 int trytry
= min (total
- how_much
, READ_BUF_SIZE
- unprocessed
);
3579 char *destination
= (CODING_REQUIRE_NO_CONVERSION (&coding
)
3580 ? (char *) (POS_ADDR (PT
+ inserted
- 1) + 1)
3581 : read_buf
+ unprocessed
);
3584 /* Allow quitting out of the actual I/O. */
3587 this = read (fd
, destination
, trytry
);
3590 if (this < 0 || this + unprocessed
== 0)
3596 /* For a regular file, where TOTAL is the real size,
3597 count HOW_MUCH to compare with it.
3598 For a special file, where TOTAL is just a buffer size,
3599 so don't bother counting in HOW_MUCH.
3600 (INSERTED is where we count the number of characters inserted.) */
3604 if (! CODING_REQUIRE_NO_CONVERSION (&coding
))
3606 int require
, produced
, consumed
;
3608 this += unprocessed
;
3609 /* Make sure that the gap is large enough. */
3610 require
= decoding_buffer_size (&coding
, this);
3611 if (GAP_SIZE
< require
)
3612 make_gap (require
- GAP_SIZE
);
3616 if (how_much
>= total
) /* This is the last block. */
3617 coding
.last_block
= 1;
3621 /* If we encounter EOF, say it is the last block. (The
3622 data this will apply to is the UNPROCESSED characters
3623 carried over from the last batch.) */
3625 coding
.last_block
= 1;
3628 produced
= decode_coding (&coding
, read_buf
,
3629 POS_ADDR (PT
+ inserted
- 1) + 1,
3630 this, GAP_SIZE
, &consumed
);
3635 XSET (temp
, Lisp_Int
, Z
+ produced
);
3636 if (Z
+ produced
!= XINT (temp
))
3642 unprocessed
= this - consumed
;
3643 bcopy (read_buf
+ consumed
, read_buf
, unprocessed
);
3652 /* Put an anchor to ensure multi-byte form ends at gap. */
3659 /* Use the conversion type to determine buffer-file-type
3660 (find-buffer-file-type is now used to help determine the
3662 if (coding
.eol_type
!= CODING_EOL_UNDECIDED
3663 && coding
.eol_type
!= CODING_EOL_LF
)
3664 current_buffer
->buffer_file_type
= Qnil
;
3666 current_buffer
->buffer_file_type
= Qt
;
3669 /* We don't have to consider file type of MSDOS because all files
3670 are read as binary and end-of-line format has already been
3671 decoded appropriately. */
3674 /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
3675 /* Determine file type from name and remove LFs from CR-LFs if the file
3676 is deemed to be a text file. */
3678 current_buffer
->buffer_file_type
3679 = call1 (Qfind_buffer_file_type
, filename
);
3680 if (NILP (current_buffer
->buffer_file_type
))
3683 = inserted
- crlf_to_lf (inserted
, POS_ADDR (PT
- 1) + 1);
3686 GPT
-= reduced_size
;
3687 GAP_SIZE
+= reduced_size
;
3688 inserted
-= reduced_size
;
3696 record_insert (PT
, inserted
);
3698 /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
3699 offset_intervals (current_buffer
, PT
, inserted
);
3705 /* Discard the unwind protect for closing the file. */
3709 error ("IO error reading %s: %s",
3710 XSTRING (filename
)->data
, strerror (errno
));
3711 else if (how_much
== -2)
3712 error ("maximum buffer size exceeded");
3719 if (!EQ (current_buffer
->undo_list
, Qt
))
3720 current_buffer
->undo_list
= Qnil
;
3722 stat (XSTRING (filename
)->data
, &st
);
3727 current_buffer
->modtime
= st
.st_mtime
;
3728 current_buffer
->filename
= filename
;
3731 SAVE_MODIFF
= MODIFF
;
3732 current_buffer
->auto_save_modified
= MODIFF
;
3733 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3734 #ifdef CLASH_DETECTION
3737 if (!NILP (current_buffer
->file_truename
))
3738 unlock_file (current_buffer
->file_truename
);
3739 unlock_file (filename
);
3741 #endif /* CLASH_DETECTION */
3743 Fsignal (Qfile_error
,
3744 Fcons (build_string ("not a regular file"),
3745 Fcons (filename
, Qnil
)));
3747 /* If visiting nonexistent file, return nil. */
3748 if (current_buffer
->modtime
== -1)
3749 report_file_error ("Opening input file", Fcons (filename
, Qnil
));
3752 /* Decode file format */
3755 insval
= call3 (Qformat_decode
,
3756 Qnil
, make_number (inserted
), visit
);
3757 CHECK_NUMBER (insval
, 0);
3758 inserted
= XFASTINT (insval
);
3761 /* Call after-change hooks for the inserted text, aside from the case
3762 of normal visiting (not with REPLACE), which is done in a new buffer
3763 "before" the buffer is changed. */
3764 if (inserted
> 0 && total
> 0
3765 && (NILP (visit
) || !NILP (replace
)))
3766 signal_after_change (PT
, 0, inserted
);
3770 p
= Vafter_insert_file_functions
;
3771 if (!NILP (coding
.post_read_conversion
))
3772 p
= Fcons (coding
.post_read_conversion
, p
);
3776 insval
= call1 (Fcar (p
), make_number (inserted
));
3779 CHECK_NUMBER (insval
, 0);
3780 inserted
= XFASTINT (insval
);
3788 val
= Fcons (filename
,
3789 Fcons (make_number (inserted
),
3792 RETURN_UNGCPRO (unbind_to (count
, val
));
3795 static Lisp_Object
build_annotations ();
3796 extern Lisp_Object
Ffile_locked_p ();
3798 /* If build_annotations switched buffers, switch back to BUF.
3799 Kill the temporary buffer that was selected in the meantime.
3801 Since this kill only the last temporary buffer, some buffers remain
3802 not killed if build_annotations switched buffers more than once.
3806 build_annotations_unwind (buf
)
3811 if (XBUFFER (buf
) == current_buffer
)
3813 tembuf
= Fcurrent_buffer ();
3815 Fkill_buffer (tembuf
);
3819 DEFUN ("write-region", Fwrite_region
, Swrite_region
, 3, 6,
3820 "r\nFWrite region to file: ",
3821 "Write current region into specified file.\n\
3822 When called from a program, takes three arguments:\n\
3823 START, END and FILENAME. START and END are buffer positions.\n\
3824 Optional fourth argument APPEND if non-nil means\n\
3825 append to existing file contents (if any).\n\
3826 Optional fifth argument VISIT if t means\n\
3827 set the last-save-file-modtime of buffer to this file's modtime\n\
3828 and mark buffer not modified.\n\
3829 If VISIT is a string, it is a second file name;\n\
3830 the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\
3831 VISIT is also the file name to lock and unlock for clash detection.\n\
3832 If VISIT is neither t nor nil nor a string,\n\
3833 that means do not print the \"Wrote file\" message.\n\
3834 The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
3835 use for locking and unlocking, overriding FILENAME and VISIT.\n\
3836 Kludgy feature: if START is a string, then that string is written\n\
3837 to the file, instead of any buffer contents, and END is ignored.")
3838 (start
, end
, filename
, append
, visit
, lockname
)
3839 Lisp_Object start
, end
, filename
, append
, visit
, lockname
;
3847 int count
= specpdl_ptr
- specpdl
;
3850 unsigned char *fname
= 0; /* If non-0, original filename (must rename) */
3852 Lisp_Object handler
;
3853 Lisp_Object visit_file
;
3854 Lisp_Object annotations
;
3855 int visiting
, quietly
;
3856 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
3857 struct buffer
*given_buffer
;
3859 int buffer_file_type
= O_BINARY
;
3861 struct coding_system coding
;
3863 if (current_buffer
->base_buffer
&& ! NILP (visit
))
3864 error ("Cannot do file visiting in an indirect buffer");
3866 if (!NILP (start
) && !STRINGP (start
))
3867 validate_region (&start
, &end
);
3869 GCPRO4 (start
, filename
, visit
, lockname
);
3871 /* Decide the coding-system to be encoded to. */
3877 else if (!NILP (Vcoding_system_for_write
))
3878 val
= Vcoding_system_for_write
;
3879 else if (NILP (current_buffer
->enable_multibyte_characters
))
3881 /* If the variable `buffer-file-coding-system' is set locally,
3882 it means that the file was read with some kind of code
3883 conversion or the varialbe is explicitely set by users. We
3884 had better write it out with the same coding system even if
3885 `enable-multibyte-characters' is nil.
3887 If is is not set locally, we anyway have to convert EOL
3888 format if the default value of `buffer-file-coding-system'
3889 tells that it is not Unix-like (LF only) format. */
3890 val
= current_buffer
->buffer_file_coding_system
;
3891 if (NILP (Flocal_variable_p (Qbuffer_file_coding_system
, Qnil
)))
3893 struct coding_system coding_temp
;
3895 setup_coding_system (Fcheck_coding_system (val
), &coding_temp
);
3896 if (coding_temp
.eol_type
== CODING_EOL_CRLF
3897 || coding_temp
.eol_type
== CODING_EOL_CR
)
3899 setup_coding_system (Qemacs_mule
, &coding
);
3900 coding
.eol_type
= coding_temp
.eol_type
;
3901 goto done_setup_coding
;
3908 Lisp_Object args
[7], coding_systems
;
3910 args
[0] = Qwrite_region
, args
[1] = start
, args
[2] = end
,
3911 args
[3] = filename
, args
[4] = append
, args
[5] = visit
,
3913 coding_systems
= Ffind_operation_coding_system (7, args
);
3914 val
= (CONSP (coding_systems
) && !NILP (XCONS (coding_systems
)->cdr
)
3915 ? XCONS (coding_systems
)->cdr
3916 : current_buffer
->buffer_file_coding_system
);
3918 setup_coding_system (Fcheck_coding_system (val
), &coding
);
3921 if (!STRINGP (start
) && !NILP (current_buffer
->selective_display
))
3922 coding
.selective
= 1;
3925 filename
= Fexpand_file_name (filename
, Qnil
);
3926 if (STRINGP (visit
))
3927 visit_file
= Fexpand_file_name (visit
, Qnil
);
3929 visit_file
= filename
;
3932 visiting
= (EQ (visit
, Qt
) || STRINGP (visit
));
3933 quietly
= !NILP (visit
);
3937 if (NILP (lockname
))
3938 lockname
= visit_file
;
3940 GCPRO5 (start
, filename
, annotations
, visit_file
, lockname
);
3942 /* If the file name has special constructs in it,
3943 call the corresponding file handler. */
3944 handler
= Ffind_file_name_handler (filename
, Qwrite_region
);
3945 /* If FILENAME has no handler, see if VISIT has one. */
3946 if (NILP (handler
) && STRINGP (visit
))
3947 handler
= Ffind_file_name_handler (visit
, Qwrite_region
);
3949 if (!NILP (handler
))
3952 val
= call6 (handler
, Qwrite_region
, start
, end
,
3953 filename
, append
, visit
);
3957 SAVE_MODIFF
= MODIFF
;
3958 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
3959 current_buffer
->filename
= visit_file
;
3965 /* Special kludge to simplify auto-saving. */
3968 XSETFASTINT (start
, BEG
);
3969 XSETFASTINT (end
, Z
);
3972 record_unwind_protect (build_annotations_unwind
, Fcurrent_buffer ());
3973 count1
= specpdl_ptr
- specpdl
;
3975 given_buffer
= current_buffer
;
3976 annotations
= build_annotations (start
, end
, coding
.pre_write_conversion
);
3977 if (current_buffer
!= given_buffer
)
3979 XSETFASTINT (start
, BEGV
);
3980 XSETFASTINT (end
, ZV
);
3983 #ifdef CLASH_DETECTION
3986 #if 0 /* This causes trouble for GNUS. */
3987 /* If we've locked this file for some other buffer,
3988 query before proceeding. */
3989 if (!visiting
&& EQ (Ffile_locked_p (lockname
), Qt
))
3990 call2 (intern ("ask-user-about-lock"), filename
, Vuser_login_name
);
3993 lock_file (lockname
);
3995 #endif /* CLASH_DETECTION */
3997 fn
= XSTRING (filename
)->data
;
4001 desc
= open (fn
, O_WRONLY
| buffer_file_type
);
4002 #else /* not DOS_NT */
4003 desc
= open (fn
, O_WRONLY
);
4004 #endif /* not DOS_NT */
4006 if (desc
< 0 && (NILP (append
) || errno
== ENOENT
) )
4008 if (auto_saving
) /* Overwrite any previous version of autosave file */
4010 vms_truncate (fn
); /* if fn exists, truncate to zero length */
4011 desc
= open (fn
, O_RDWR
);
4013 desc
= creat_copy_attrs (STRINGP (current_buffer
->filename
)
4014 ? XSTRING (current_buffer
->filename
)->data
: 0,
4017 else /* Write to temporary name and rename if no errors */
4019 Lisp_Object temp_name
;
4020 temp_name
= Ffile_name_directory (filename
);
4022 if (!NILP (temp_name
))
4024 temp_name
= Fmake_temp_name (concat2 (temp_name
,
4025 build_string ("$$SAVE$$")));
4026 fname
= XSTRING (filename
)->data
;
4027 fn
= XSTRING (temp_name
)->data
;
4028 desc
= creat_copy_attrs (fname
, fn
);
4031 /* If we can't open the temporary file, try creating a new
4032 version of the original file. VMS "creat" creates a
4033 new version rather than truncating an existing file. */
4036 desc
= creat (fn
, 0666);
4037 #if 0 /* This can clobber an existing file and fail to replace it,
4038 if the user runs out of space. */
4041 /* We can't make a new version;
4042 try to truncate and rewrite existing version if any. */
4044 desc
= open (fn
, O_RDWR
);
4050 desc
= creat (fn
, 0666);
4055 O_WRONLY
| O_TRUNC
| O_CREAT
| buffer_file_type
,
4056 S_IREAD
| S_IWRITE
);
4057 #else /* not DOS_NT */
4058 desc
= creat (fn
, auto_saving
? auto_save_mode_bits
: 0666);
4059 #endif /* not DOS_NT */
4060 #endif /* not VMS */
4066 #ifdef CLASH_DETECTION
4068 if (!auto_saving
) unlock_file (lockname
);
4070 #endif /* CLASH_DETECTION */
4071 report_file_error ("Opening output file", Fcons (filename
, Qnil
));
4074 record_unwind_protect (close_file_unwind
, make_number (desc
));
4077 if (lseek (desc
, 0, 2) < 0)
4079 #ifdef CLASH_DETECTION
4080 if (!auto_saving
) unlock_file (lockname
);
4081 #endif /* CLASH_DETECTION */
4082 report_file_error ("Lseek error", Fcons (filename
, Qnil
));
4087 * Kludge Warning: The VMS C RTL likes to insert carriage returns
4088 * if we do writes that don't end with a carriage return. Furthermore
4089 * it cannot handle writes of more then 16K. The modified
4090 * version of "sys_write" in SYSDEP.C (see comment there) copes with
4091 * this EXCEPT for the last record (iff it doesn't end with a carriage
4092 * return). This implies that if your buffer doesn't end with a carriage
4093 * return, you get one free... tough. However it also means that if
4094 * we make two calls to sys_write (a la the following code) you can
4095 * get one at the gap as well. The easiest way to fix this (honest)
4096 * is to move the gap to the next newline (or the end of the buffer).
4101 if (GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4102 move_gap (find_next_newline (GPT
, 1));
4104 /* Whether VMS or not, we must move the gap to the next of newline
4105 when we must put designation sequences at beginning of line. */
4106 if (INTEGERP (start
)
4107 && coding
.type
== coding_type_iso2022
4108 && coding
.flags
& CODING_FLAG_ISO_DESIGNATE_AT_BOL
4109 && GPT
> BEG
&& GPT_ADDR
[-1] != '\n')
4110 move_gap (find_next_newline (GPT
, 1));
4116 if (STRINGP (start
))
4118 failure
= 0 > a_write (desc
, XSTRING (start
)->data
,
4119 XSTRING (start
)->size
, 0, &annotations
, &coding
);
4122 else if (XINT (start
) != XINT (end
))
4125 if (XINT (start
) < GPT
)
4127 register int end1
= XINT (end
);
4129 failure
= 0 > a_write (desc
, POS_ADDR (tem
),
4130 min (GPT
, end1
) - tem
, tem
, &annotations
,
4132 nwritten
+= min (GPT
, end1
) - tem
;
4136 if (XINT (end
) > GPT
&& !failure
)
4139 tem
= max (tem
, GPT
);
4140 failure
= 0 > a_write (desc
, POS_ADDR (tem
), XINT (end
) - tem
,
4141 tem
, &annotations
, &coding
);
4142 nwritten
+= XINT (end
) - tem
;
4148 /* If file was empty, still need to write the annotations */
4149 coding
.last_block
= 1;
4150 failure
= 0 > a_write (desc
, "", 0, XINT (start
), &annotations
, &coding
);
4154 if (coding
.require_flushing
&& !coding
.last_block
)
4156 /* We have to flush out a data. */
4157 coding
.last_block
= 1;
4158 failure
= 0 > e_write (desc
, "", 0, &coding
);
4165 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4166 Disk full in NFS may be reported here. */
4167 /* mib says that closing the file will try to write as fast as NFS can do
4168 it, and that means the fsync here is not crucial for autosave files. */
4169 if (!auto_saving
&& fsync (desc
) < 0)
4171 /* If fsync fails with EINTR, don't treat that as serious. */
4173 failure
= 1, save_errno
= errno
;
4177 /* Spurious "file has changed on disk" warnings have been
4178 observed on Suns as well.
4179 It seems that `close' can change the modtime, under nfs.
4181 (This has supposedly been fixed in Sunos 4,
4182 but who knows about all the other machines with NFS?) */
4185 /* On VMS and APOLLO, must do the stat after the close
4186 since closing changes the modtime. */
4189 /* Recall that #if defined does not work on VMS. */
4196 /* NFS can report a write failure now. */
4197 if (close (desc
) < 0)
4198 failure
= 1, save_errno
= errno
;
4201 /* If we wrote to a temporary name and had no errors, rename to real name. */
4205 failure
= (rename (fn
, fname
) != 0), save_errno
= errno
;
4213 /* Discard the unwind protect for close_file_unwind. */
4214 specpdl_ptr
= specpdl
+ count1
;
4215 /* Restore the original current buffer. */
4216 visit_file
= unbind_to (count
, visit_file
);
4218 #ifdef CLASH_DETECTION
4220 unlock_file (lockname
);
4221 #endif /* CLASH_DETECTION */
4223 /* Do this before reporting IO error
4224 to avoid a "file has changed on disk" warning on
4225 next attempt to save. */
4227 current_buffer
->modtime
= st
.st_mtime
;
4230 error ("IO error writing %s: %s", fn
, strerror (save_errno
));
4234 SAVE_MODIFF
= MODIFF
;
4235 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4236 current_buffer
->filename
= visit_file
;
4237 update_mode_lines
++;
4243 message ("Wrote %s", XSTRING (visit_file
)->data
);
4248 Lisp_Object
merge ();
4250 DEFUN ("car-less-than-car", Fcar_less_than_car
, Scar_less_than_car
, 2, 2, 0,
4251 "Return t if (car A) is numerically less than (car B).")
4255 return Flss (Fcar (a
), Fcar (b
));
4258 /* Build the complete list of annotations appropriate for writing out
4259 the text between START and END, by calling all the functions in
4260 write-region-annotate-functions and merging the lists they return.
4261 If one of these functions switches to a different buffer, we assume
4262 that buffer contains altered text. Therefore, the caller must
4263 make sure to restore the current buffer in all cases,
4264 as save-excursion would do. */
4267 build_annotations (start
, end
, pre_write_conversion
)
4268 Lisp_Object start
, end
, pre_write_conversion
;
4270 Lisp_Object annotations
;
4272 struct gcpro gcpro1
, gcpro2
;
4273 Lisp_Object original_buffer
;
4275 XSETBUFFER (original_buffer
, current_buffer
);
4278 p
= Vwrite_region_annotate_functions
;
4279 GCPRO2 (annotations
, p
);
4282 struct buffer
*given_buffer
= current_buffer
;
4283 Vwrite_region_annotations_so_far
= annotations
;
4284 res
= call2 (Fcar (p
), start
, end
);
4285 /* If the function makes a different buffer current,
4286 assume that means this buffer contains altered text to be output.
4287 Reset START and END from the buffer bounds
4288 and discard all previous annotations because they should have
4289 been dealt with by this function. */
4290 if (current_buffer
!= given_buffer
)
4292 XSETFASTINT (start
, BEGV
);
4293 XSETFASTINT (end
, ZV
);
4296 Flength (res
); /* Check basic validity of return value */
4297 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4301 /* Now do the same for annotation functions implied by the file-format */
4302 if (auto_saving
&& (!EQ (Vauto_save_file_format
, Qt
)))
4303 p
= Vauto_save_file_format
;
4305 p
= current_buffer
->file_format
;
4308 struct buffer
*given_buffer
= current_buffer
;
4309 Vwrite_region_annotations_so_far
= annotations
;
4310 res
= call4 (Qformat_annotate_function
, Fcar (p
), start
, end
,
4312 if (current_buffer
!= given_buffer
)
4314 XSETFASTINT (start
, BEGV
);
4315 XSETFASTINT (end
, ZV
);
4319 annotations
= merge (annotations
, res
, Qcar_less_than_car
);
4323 /* At last, do the same for the function PRE_WRITE_CONVERSION
4324 implied by the current coding-system. */
4325 if (!NILP (pre_write_conversion
))
4327 struct buffer
*given_buffer
= current_buffer
;
4328 Vwrite_region_annotations_so_far
= annotations
;
4329 res
= call2 (pre_write_conversion
, start
, end
);
4331 annotations
= (current_buffer
!= given_buffer
4333 : merge (annotations
, res
, Qcar_less_than_car
));
4340 /* Write to descriptor DESC the LEN characters starting at ADDR,
4341 assuming they start at position POS in the buffer.
4342 Intersperse with them the annotations from *ANNOT
4343 (those which fall within the range of positions POS to POS + LEN),
4344 each at its appropriate position.
4346 Modify *ANNOT by discarding elements as we output them.
4347 The return value is negative in case of system call failure. */
4350 a_write (desc
, addr
, len
, pos
, annot
, coding
)
4352 register char *addr
;
4356 struct coding_system
*coding
;
4360 int lastpos
= pos
+ len
;
4362 while (NILP (*annot
) || CONSP (*annot
))
4364 tem
= Fcar_safe (Fcar (*annot
));
4365 if (INTEGERP (tem
) && XINT (tem
) >= pos
&& XFASTINT (tem
) <= lastpos
)
4366 nextpos
= XFASTINT (tem
);
4368 return e_write (desc
, addr
, lastpos
- pos
, coding
);
4371 if (0 > e_write (desc
, addr
, nextpos
- pos
, coding
))
4373 addr
+= nextpos
- pos
;
4376 tem
= Fcdr (Fcar (*annot
));
4379 if (0 > e_write (desc
, XSTRING (tem
)->data
, XSTRING (tem
)->size
,
4383 *annot
= Fcdr (*annot
);
4387 #ifndef WRITE_BUF_SIZE
4388 #define WRITE_BUF_SIZE (16 * 1024)
4392 e_write (desc
, addr
, len
, coding
)
4394 register char *addr
;
4396 struct coding_system
*coding
;
4398 char buf
[WRITE_BUF_SIZE
];
4399 int produced
, consumed
;
4401 /* We used to have a code for handling selective display here. But,
4402 now it is handled within encode_coding. */
4405 produced
= encode_coding (coding
, addr
, buf
, len
, WRITE_BUF_SIZE
,
4407 len
-= consumed
, addr
+= consumed
;
4410 produced
-= write (desc
, buf
, produced
);
4411 if (produced
) return -1;
4419 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime
,
4420 Sverify_visited_file_modtime
, 1, 1, 0,
4421 "Return t if last mod time of BUF's visited file matches what BUF records.\n\
4422 This means that the file has not been changed since it was visited or saved.")
4428 Lisp_Object handler
;
4430 CHECK_BUFFER (buf
, 0);
4433 if (!STRINGP (b
->filename
)) return Qt
;
4434 if (b
->modtime
== 0) return Qt
;
4436 /* If the file name has special constructs in it,
4437 call the corresponding file handler. */
4438 handler
= Ffind_file_name_handler (b
->filename
,
4439 Qverify_visited_file_modtime
);
4440 if (!NILP (handler
))
4441 return call2 (handler
, Qverify_visited_file_modtime
, buf
);
4443 if (stat (XSTRING (b
->filename
)->data
, &st
) < 0)
4445 /* If the file doesn't exist now and didn't exist before,
4446 we say that it isn't modified, provided the error is a tame one. */
4447 if (errno
== ENOENT
|| errno
== EACCES
|| errno
== ENOTDIR
)
4452 if (st
.st_mtime
== b
->modtime
4453 /* If both are positive, accept them if they are off by one second. */
4454 || (st
.st_mtime
> 0 && b
->modtime
> 0
4455 && (st
.st_mtime
== b
->modtime
+ 1
4456 || st
.st_mtime
== b
->modtime
- 1)))
4461 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime
,
4462 Sclear_visited_file_modtime
, 0, 0, 0,
4463 "Clear out records of last mod time of visited file.\n\
4464 Next attempt to save will certainly not complain of a discrepancy.")
4467 current_buffer
->modtime
= 0;
4471 DEFUN ("visited-file-modtime", Fvisited_file_modtime
,
4472 Svisited_file_modtime
, 0, 0, 0,
4473 "Return the current buffer's recorded visited file modification time.\n\
4474 The value is a list of the form (HIGH . LOW), like the time values\n\
4475 that `file-attributes' returns.")
4478 return long_to_cons ((unsigned long) current_buffer
->modtime
);
4481 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime
,
4482 Sset_visited_file_modtime
, 0, 1, 0,
4483 "Update buffer's recorded modification time from the visited file's time.\n\
4484 Useful if the buffer was not read from the file normally\n\
4485 or if the file itself has been changed for some known benign reason.\n\
4486 An argument specifies the modification time value to use\n\
4487 \(instead of that of the visited file), in the form of a list\n\
4488 \(HIGH . LOW) or (HIGH LOW).")
4490 Lisp_Object time_list
;
4492 if (!NILP (time_list
))
4493 current_buffer
->modtime
= cons_to_long (time_list
);
4496 register Lisp_Object filename
;
4498 Lisp_Object handler
;
4500 filename
= Fexpand_file_name (current_buffer
->filename
, Qnil
);
4502 /* If the file name has special constructs in it,
4503 call the corresponding file handler. */
4504 handler
= Ffind_file_name_handler (filename
, Qset_visited_file_modtime
);
4505 if (!NILP (handler
))
4506 /* The handler can find the file name the same way we did. */
4507 return call2 (handler
, Qset_visited_file_modtime
, Qnil
);
4508 else if (stat (XSTRING (filename
)->data
, &st
) >= 0)
4509 current_buffer
->modtime
= st
.st_mtime
;
4519 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
4520 Fsleep_for (make_number (1), Qnil
);
4521 message ("Autosaving...error!for %s", XSTRING (current_buffer
->name
)->data
);
4522 Fsleep_for (make_number (1), Qnil
);
4523 message ("Autosaving...error for %s", XSTRING (current_buffer
->name
)->data
);
4524 Fsleep_for (make_number (1), Qnil
);
4534 /* Get visited file's mode to become the auto save file's mode. */
4535 if (stat (XSTRING (current_buffer
->filename
)->data
, &st
) >= 0)
4536 /* But make sure we can overwrite it later! */
4537 auto_save_mode_bits
= st
.st_mode
| 0600;
4539 auto_save_mode_bits
= 0666;
4542 Fwrite_region (Qnil
, Qnil
,
4543 current_buffer
->auto_save_file_name
,
4544 Qnil
, Qlambda
, Qnil
);
4548 do_auto_save_unwind (stream
) /* used as unwind-protect function */
4553 fclose ((FILE *) (XFASTINT (XCONS (stream
)->car
) << 16
4554 | XFASTINT (XCONS (stream
)->cdr
)));
4559 do_auto_save_unwind_1 (value
) /* used as unwind-protect function */
4562 minibuffer_auto_raise
= XINT (value
);
4566 DEFUN ("do-auto-save", Fdo_auto_save
, Sdo_auto_save
, 0, 2, "",
4567 "Auto-save all buffers that need it.\n\
4568 This is all buffers that have auto-saving enabled\n\
4569 and are changed since last auto-saved.\n\
4570 Auto-saving writes the buffer into a file\n\
4571 so that your editing is not lost if the system crashes.\n\
4572 This file is not the file you visited; that changes only when you save.\n\
4573 Normally we run the normal hook `auto-save-hook' before saving.\n\n\
4574 A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
4575 A non-nil CURRENT-ONLY argument means save only current buffer.")
4576 (no_message
, current_only
)
4577 Lisp_Object no_message
, current_only
;
4579 struct buffer
*old
= current_buffer
, *b
;
4580 Lisp_Object tail
, buf
;
4582 char *omessage
= echo_area_glyphs
;
4583 int omessage_length
= echo_area_glyphs_length
;
4584 int do_handled_files
;
4587 Lisp_Object lispstream
;
4588 int count
= specpdl_ptr
- specpdl
;
4590 int orig_minibuffer_auto_raise
= minibuffer_auto_raise
;
4592 /* Ordinarily don't quit within this function,
4593 but don't make it impossible to quit (in case we get hung in I/O). */
4597 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
4598 point to non-strings reached from Vbuffer_alist. */
4603 if (!NILP (Vrun_hooks
))
4604 call1 (Vrun_hooks
, intern ("auto-save-hook"));
4606 if (STRINGP (Vauto_save_list_file_name
))
4608 Lisp_Object listfile
;
4609 listfile
= Fexpand_file_name (Vauto_save_list_file_name
, Qnil
);
4610 stream
= fopen (XSTRING (listfile
)->data
, "w");
4613 /* Arrange to close that file whether or not we get an error.
4614 Also reset auto_saving to 0. */
4615 lispstream
= Fcons (Qnil
, Qnil
);
4616 XSETFASTINT (XCONS (lispstream
)->car
, (EMACS_UINT
)stream
>> 16);
4617 XSETFASTINT (XCONS (lispstream
)->cdr
, (EMACS_UINT
)stream
& 0xffff);
4628 record_unwind_protect (do_auto_save_unwind
, lispstream
);
4629 record_unwind_protect (do_auto_save_unwind_1
,
4630 make_number (minibuffer_auto_raise
));
4631 minibuffer_auto_raise
= 0;
4634 /* First, save all files which don't have handlers. If Emacs is
4635 crashing, the handlers may tweak what is causing Emacs to crash
4636 in the first place, and it would be a shame if Emacs failed to
4637 autosave perfectly ordinary files because it couldn't handle some
4639 for (do_handled_files
= 0; do_handled_files
< 2; do_handled_files
++)
4640 for (tail
= Vbuffer_alist
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
4642 buf
= XCONS (XCONS (tail
)->car
)->cdr
;
4645 /* Record all the buffers that have auto save mode
4646 in the special file that lists them. For each of these buffers,
4647 Record visited name (if any) and auto save name. */
4648 if (STRINGP (b
->auto_save_file_name
)
4649 && stream
!= NULL
&& do_handled_files
== 0)
4651 if (!NILP (b
->filename
))
4653 fwrite (XSTRING (b
->filename
)->data
, 1,
4654 XSTRING (b
->filename
)->size
, stream
);
4656 putc ('\n', stream
);
4657 fwrite (XSTRING (b
->auto_save_file_name
)->data
, 1,
4658 XSTRING (b
->auto_save_file_name
)->size
, stream
);
4659 putc ('\n', stream
);
4662 if (!NILP (current_only
)
4663 && b
!= current_buffer
)
4666 /* Don't auto-save indirect buffers.
4667 The base buffer takes care of it. */
4671 /* Check for auto save enabled
4672 and file changed since last auto save
4673 and file changed since last real save. */
4674 if (STRINGP (b
->auto_save_file_name
)
4675 && BUF_SAVE_MODIFF (b
) < BUF_MODIFF (b
)
4676 && b
->auto_save_modified
< BUF_MODIFF (b
)
4677 /* -1 means we've turned off autosaving for a while--see below. */
4678 && XINT (b
->save_length
) >= 0
4679 && (do_handled_files
4680 || NILP (Ffind_file_name_handler (b
->auto_save_file_name
,
4683 EMACS_TIME before_time
, after_time
;
4685 EMACS_GET_TIME (before_time
);
4687 /* If we had a failure, don't try again for 20 minutes. */
4688 if (b
->auto_save_failure_time
>= 0
4689 && EMACS_SECS (before_time
) - b
->auto_save_failure_time
< 1200)
4692 if ((XFASTINT (b
->save_length
) * 10
4693 > (BUF_Z (b
) - BUF_BEG (b
)) * 13)
4694 /* A short file is likely to change a large fraction;
4695 spare the user annoying messages. */
4696 && XFASTINT (b
->save_length
) > 5000
4697 /* These messages are frequent and annoying for `*mail*'. */
4698 && !EQ (b
->filename
, Qnil
)
4699 && NILP (no_message
))
4701 /* It has shrunk too much; turn off auto-saving here. */
4702 minibuffer_auto_raise
= orig_minibuffer_auto_raise
;
4703 message ("Buffer %s has shrunk a lot; auto save turned off there",
4704 XSTRING (b
->name
)->data
);
4705 minibuffer_auto_raise
= 0;
4706 /* Turn off auto-saving until there's a real save,
4707 and prevent any more warnings. */
4708 XSETINT (b
->save_length
, -1);
4709 Fsleep_for (make_number (1), Qnil
);
4712 set_buffer_internal (b
);
4713 if (!auto_saved
&& NILP (no_message
))
4714 message1 ("Auto-saving...");
4715 internal_condition_case (auto_save_1
, Qt
, auto_save_error
);
4717 b
->auto_save_modified
= BUF_MODIFF (b
);
4718 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4719 set_buffer_internal (old
);
4721 EMACS_GET_TIME (after_time
);
4723 /* If auto-save took more than 60 seconds,
4724 assume it was an NFS failure that got a timeout. */
4725 if (EMACS_SECS (after_time
) - EMACS_SECS (before_time
) > 60)
4726 b
->auto_save_failure_time
= EMACS_SECS (after_time
);
4730 /* Prevent another auto save till enough input events come in. */
4731 record_auto_save ();
4733 if (auto_saved
&& NILP (no_message
))
4737 sit_for (1, 0, 0, 0, 0);
4738 message2 (omessage
, omessage_length
);
4741 message1 ("Auto-saving...done");
4746 unbind_to (count
, Qnil
);
4750 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved
,
4751 Sset_buffer_auto_saved
, 0, 0, 0,
4752 "Mark current buffer as auto-saved with its current text.\n\
4753 No auto-save file will be written until the buffer changes again.")
4756 current_buffer
->auto_save_modified
= MODIFF
;
4757 XSETFASTINT (current_buffer
->save_length
, Z
- BEG
);
4758 current_buffer
->auto_save_failure_time
= -1;
4762 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure
,
4763 Sclear_buffer_auto_save_failure
, 0, 0, 0,
4764 "Clear any record of a recent auto-save failure in the current buffer.")
4767 current_buffer
->auto_save_failure_time
= -1;
4771 DEFUN ("recent-auto-save-p", Frecent_auto_save_p
, Srecent_auto_save_p
,
4773 "Return t if buffer has been auto-saved since last read in or saved.")
4776 return (SAVE_MODIFF
< current_buffer
->auto_save_modified
) ? Qt
: Qnil
;
4779 /* Reading and completing file names */
4780 extern Lisp_Object
Ffile_name_completion (), Ffile_name_all_completions ();
4782 /* In the string VAL, change each $ to $$ and return the result. */
4785 double_dollars (val
)
4788 register unsigned char *old
, *new;
4792 osize
= XSTRING (val
)->size
;
4793 /* Quote "$" as "$$" to get it past substitute-in-file-name */
4794 for (n
= osize
, count
= 0, old
= XSTRING (val
)->data
; n
> 0; n
--)
4795 if (*old
++ == '$') count
++;
4798 old
= XSTRING (val
)->data
;
4799 val
= Fmake_string (make_number (osize
+ count
), make_number (0));
4800 new = XSTRING (val
)->data
;
4801 for (n
= osize
; n
> 0; n
--)
4814 DEFUN ("read-file-name-internal", Fread_file_name_internal
, Sread_file_name_internal
,
4816 "Internal subroutine for read-file-name. Do not call this.")
4817 (string
, dir
, action
)
4818 Lisp_Object string
, dir
, action
;
4819 /* action is nil for complete, t for return list of completions,
4820 lambda for verify final value */
4822 Lisp_Object name
, specdir
, realdir
, val
, orig_string
;
4824 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
4826 CHECK_STRING (string
, 0);
4833 /* No need to protect ACTION--we only compare it with t and nil. */
4834 GCPRO5 (string
, realdir
, name
, specdir
, orig_string
);
4836 if (XSTRING (string
)->size
== 0)
4838 if (EQ (action
, Qlambda
))
4846 orig_string
= string
;
4847 string
= Fsubstitute_in_file_name (string
);
4848 changed
= NILP (Fstring_equal (string
, orig_string
));
4849 name
= Ffile_name_nondirectory (string
);
4850 val
= Ffile_name_directory (string
);
4852 realdir
= Fexpand_file_name (val
, realdir
);
4857 specdir
= Ffile_name_directory (string
);
4858 val
= Ffile_name_completion (name
, realdir
);
4863 return double_dollars (string
);
4867 if (!NILP (specdir
))
4868 val
= concat2 (specdir
, val
);
4870 return double_dollars (val
);
4873 #endif /* not VMS */
4877 if (EQ (action
, Qt
))
4878 return Ffile_name_all_completions (name
, realdir
);
4879 /* Only other case actually used is ACTION = lambda */
4881 /* Supposedly this helps commands such as `cd' that read directory names,
4882 but can someone explain how it helps them? -- RMS */
4883 if (XSTRING (name
)->size
== 0)
4886 return Ffile_exists_p (string
);
4889 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4890 "Read file name, prompting with PROMPT and completing in directory DIR.\n\
4891 Value is not expanded---you must call `expand-file-name' yourself.\n\
4892 Default name to DEFAULT-FILENAME if user enters a null string.\n\
4893 (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
4894 except that if INITIAL is specified, that combined with DIR is used.)\n\
4895 Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
4896 Non-nil and non-t means also require confirmation after completion.\n\
4897 Fifth arg INITIAL specifies text to start with.\n\
4898 DIR defaults to current buffer's directory default.")
4899 (prompt
, dir
, default_filename
, mustmatch
, initial
)
4900 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, initial
;
4902 Lisp_Object val
, insdef
, insdef1
, tem
;
4903 struct gcpro gcpro1
, gcpro2
;
4904 register char *homedir
;
4908 dir
= current_buffer
->directory
;
4909 if (NILP (default_filename
))
4911 if (! NILP (initial
))
4912 default_filename
= Fexpand_file_name (initial
, dir
);
4914 default_filename
= current_buffer
->filename
;
4917 /* If dir starts with user's homedir, change that to ~. */
4918 homedir
= (char *) egetenv ("HOME");
4920 homedir
= strcpy (alloca (strlen (homedir
) + 1), homedir
);
4921 CORRECT_DIR_SEPS (homedir
);
4925 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
4926 && IS_DIRECTORY_SEP (XSTRING (dir
)->data
[strlen (homedir
)]))
4928 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
4929 XSTRING (dir
)->size
- strlen (homedir
) + 1);
4930 XSTRING (dir
)->data
[0] = '~';
4933 if (insert_default_directory
&& STRINGP (dir
))
4936 if (!NILP (initial
))
4938 Lisp_Object args
[2], pos
;
4942 insdef
= Fconcat (2, args
);
4943 pos
= make_number (XSTRING (double_dollars (dir
))->size
);
4944 insdef1
= Fcons (double_dollars (insdef
), pos
);
4947 insdef1
= double_dollars (insdef
);
4949 else if (STRINGP (initial
))
4952 insdef1
= Fcons (double_dollars (insdef
), make_number (0));
4955 insdef
= Qnil
, insdef1
= Qnil
;
4958 count
= specpdl_ptr
- specpdl
;
4959 specbind (intern ("completion-ignore-case"), Qt
);
4962 GCPRO2 (insdef
, default_filename
);
4963 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
4964 dir
, mustmatch
, insdef1
,
4965 Qfile_name_history
, default_filename
, Qnil
);
4966 /* If Fcompleting_read returned the default string itself
4967 (rather than a new string with the same contents),
4968 it has to mean that the user typed RET with the minibuffer empty.
4969 In that case, we really want to return ""
4970 so that commands such as set-visited-file-name can distinguish. */
4971 if (EQ (val
, default_filename
))
4972 val
= build_string ("");
4975 unbind_to (count
, Qnil
);
4980 error ("No file name specified");
4981 tem
= Fstring_equal (val
, insdef
);
4982 if (!NILP (tem
) && !NILP (default_filename
))
4983 return default_filename
;
4984 if (XSTRING (val
)->size
== 0 && NILP (insdef
))
4986 if (!NILP (default_filename
))
4987 return default_filename
;
4989 error ("No default file name");
4991 return Fsubstitute_in_file_name (val
);
4994 #if 0 /* Old version */
4995 DEFUN ("read-file-name", Fread_file_name
, Sread_file_name
, 1, 5, 0,
4996 /* Don't confuse make-docfile by having two doc strings for this function.
4997 make-docfile does not pay attention to #if, for good reason! */
4999 (prompt
, dir
, defalt
, mustmatch
, initial
)
5000 Lisp_Object prompt
, dir
, defalt
, mustmatch
, initial
;
5002 Lisp_Object val
, insdef
, tem
;
5003 struct gcpro gcpro1
, gcpro2
;
5004 register char *homedir
;
5008 dir
= current_buffer
->directory
;
5010 defalt
= current_buffer
->filename
;
5012 /* If dir starts with user's homedir, change that to ~. */
5013 homedir
= (char *) egetenv ("HOME");
5016 && !strncmp (homedir
, XSTRING (dir
)->data
, strlen (homedir
))
5017 && XSTRING (dir
)->data
[strlen (homedir
)] == '/')
5019 dir
= make_string (XSTRING (dir
)->data
+ strlen (homedir
) - 1,
5020 XSTRING (dir
)->size
- strlen (homedir
) + 1);
5021 XSTRING (dir
)->data
[0] = '~';
5024 if (!NILP (initial
))
5026 else if (insert_default_directory
)
5029 insdef
= build_string ("");
5032 count
= specpdl_ptr
- specpdl
;
5033 specbind (intern ("completion-ignore-case"), Qt
);
5036 GCPRO2 (insdef
, defalt
);
5037 val
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
5039 insert_default_directory
? insdef
: Qnil
,
5040 Qfile_name_history
, Qnil
, Qnil
);
5043 unbind_to (count
, Qnil
);
5048 error ("No file name specified");
5049 tem
= Fstring_equal (val
, insdef
);
5050 if (!NILP (tem
) && !NILP (defalt
))
5052 return Fsubstitute_in_file_name (val
);
5054 #endif /* Old version */
5058 Qexpand_file_name
= intern ("expand-file-name");
5059 Qsubstitute_in_file_name
= intern ("substitute-in-file-name");
5060 Qdirectory_file_name
= intern ("directory-file-name");
5061 Qfile_name_directory
= intern ("file-name-directory");
5062 Qfile_name_nondirectory
= intern ("file-name-nondirectory");
5063 Qunhandled_file_name_directory
= intern ("unhandled-file-name-directory");
5064 Qfile_name_as_directory
= intern ("file-name-as-directory");
5065 Qcopy_file
= intern ("copy-file");
5066 Qmake_directory_internal
= intern ("make-directory-internal");
5067 Qdelete_directory
= intern ("delete-directory");
5068 Qdelete_file
= intern ("delete-file");
5069 Qrename_file
= intern ("rename-file");
5070 Qadd_name_to_file
= intern ("add-name-to-file");
5071 Qmake_symbolic_link
= intern ("make-symbolic-link");
5072 Qfile_exists_p
= intern ("file-exists-p");
5073 Qfile_executable_p
= intern ("file-executable-p");
5074 Qfile_readable_p
= intern ("file-readable-p");
5075 Qfile_writable_p
= intern ("file-writable-p");
5076 Qfile_symlink_p
= intern ("file-symlink-p");
5077 Qaccess_file
= intern ("access-file");
5078 Qfile_directory_p
= intern ("file-directory-p");
5079 Qfile_regular_p
= intern ("file-regular-p");
5080 Qfile_accessible_directory_p
= intern ("file-accessible-directory-p");
5081 Qfile_modes
= intern ("file-modes");
5082 Qset_file_modes
= intern ("set-file-modes");
5083 Qfile_newer_than_file_p
= intern ("file-newer-than-file-p");
5084 Qinsert_file_contents
= intern ("insert-file-contents");
5085 Qwrite_region
= intern ("write-region");
5086 Qverify_visited_file_modtime
= intern ("verify-visited-file-modtime");
5087 Qset_visited_file_modtime
= intern ("set-visited-file-modtime");
5089 staticpro (&Qexpand_file_name
);
5090 staticpro (&Qsubstitute_in_file_name
);
5091 staticpro (&Qdirectory_file_name
);
5092 staticpro (&Qfile_name_directory
);
5093 staticpro (&Qfile_name_nondirectory
);
5094 staticpro (&Qunhandled_file_name_directory
);
5095 staticpro (&Qfile_name_as_directory
);
5096 staticpro (&Qcopy_file
);
5097 staticpro (&Qmake_directory_internal
);
5098 staticpro (&Qdelete_directory
);
5099 staticpro (&Qdelete_file
);
5100 staticpro (&Qrename_file
);
5101 staticpro (&Qadd_name_to_file
);
5102 staticpro (&Qmake_symbolic_link
);
5103 staticpro (&Qfile_exists_p
);
5104 staticpro (&Qfile_executable_p
);
5105 staticpro (&Qfile_readable_p
);
5106 staticpro (&Qfile_writable_p
);
5107 staticpro (&Qaccess_file
);
5108 staticpro (&Qfile_symlink_p
);
5109 staticpro (&Qfile_directory_p
);
5110 staticpro (&Qfile_regular_p
);
5111 staticpro (&Qfile_accessible_directory_p
);
5112 staticpro (&Qfile_modes
);
5113 staticpro (&Qset_file_modes
);
5114 staticpro (&Qfile_newer_than_file_p
);
5115 staticpro (&Qinsert_file_contents
);
5116 staticpro (&Qwrite_region
);
5117 staticpro (&Qverify_visited_file_modtime
);
5118 staticpro (&Qset_visited_file_modtime
);
5120 Qfile_name_history
= intern ("file-name-history");
5121 Fset (Qfile_name_history
, Qnil
);
5122 staticpro (&Qfile_name_history
);
5124 Qfile_error
= intern ("file-error");
5125 staticpro (&Qfile_error
);
5126 Qfile_already_exists
= intern ("file-already-exists");
5127 staticpro (&Qfile_already_exists
);
5128 Qfile_date_error
= intern ("file-date-error");
5129 staticpro (&Qfile_date_error
);
5132 Qfind_buffer_file_type
= intern ("find-buffer-file-type");
5133 staticpro (&Qfind_buffer_file_type
);
5136 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format
,
5137 "*Format in which to write auto-save files.\n\
5138 Should be a list of symbols naming formats that are defined in `format-alist'.\n\
5139 If it is t, which is the default, auto-save files are written in the\n\
5140 same format as a regular save would use.");
5141 Vauto_save_file_format
= Qt
;
5143 Qformat_decode
= intern ("format-decode");
5144 staticpro (&Qformat_decode
);
5145 Qformat_annotate_function
= intern ("format-annotate-function");
5146 staticpro (&Qformat_annotate_function
);
5148 Qcar_less_than_car
= intern ("car-less-than-car");
5149 staticpro (&Qcar_less_than_car
);
5151 Fput (Qfile_error
, Qerror_conditions
,
5152 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
)));
5153 Fput (Qfile_error
, Qerror_message
,
5154 build_string ("File error"));
5156 Fput (Qfile_already_exists
, Qerror_conditions
,
5157 Fcons (Qfile_already_exists
,
5158 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5159 Fput (Qfile_already_exists
, Qerror_message
,
5160 build_string ("File already exists"));
5162 Fput (Qfile_date_error
, Qerror_conditions
,
5163 Fcons (Qfile_date_error
,
5164 Fcons (Qfile_error
, Fcons (Qerror
, Qnil
))));
5165 Fput (Qfile_date_error
, Qerror_message
,
5166 build_string ("Cannot set file date"));
5168 DEFVAR_BOOL ("insert-default-directory", &insert_default_directory
,
5169 "*Non-nil means when reading a filename start with default dir in minibuffer.");
5170 insert_default_directory
= 1;
5172 DEFVAR_BOOL ("vms-stmlf-recfm", &vms_stmlf_recfm
,
5173 "*Non-nil means write new files with record format `stmlf'.\n\
5174 nil means use format `var'. This variable is meaningful only on VMS.");
5175 vms_stmlf_recfm
= 0;
5177 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char
,
5178 "Directory separator character for built-in functions that return file names.\n\
5179 The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
5180 This variable affects the built-in functions only on Windows,\n\
5181 on other platforms, it is initialized so that Lisp code can find out\n\
5182 what the normal separator is.");
5183 XSETFASTINT (Vdirectory_sep_char
, '/');
5185 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist
,
5186 "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
5187 If a file name matches REGEXP, then all I/O on that file is done by calling\n\
5190 The first argument given to HANDLER is the name of the I/O primitive\n\
5191 to be handled; the remaining arguments are the arguments that were\n\
5192 passed to that primitive. For example, if you do\n\
5193 (file-exists-p FILENAME)\n\
5194 and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
5195 (funcall HANDLER 'file-exists-p FILENAME)\n\
5196 The function `find-file-name-handler' checks this list for a handler\n\
5197 for its argument.");
5198 Vfile_name_handler_alist
= Qnil
;
5200 DEFVAR_LISP ("set-auto-coding-function",
5201 &Vset_auto_coding_function
,
5202 "If non-nil, a function to call to decide a coding system of file.\n\
5203 One argument is passed to this function: the string of concatination\n\
5204 or the heading 1K-byte and the tailing 3K-byte of a file to be read.\n\
5205 This function should return a coding system to decode the file contents\n\
5206 specified in the heading lines with the format:\n\
5207 -*- ... coding: CODING-SYSTEM; ... -*-\n\
5208 or local variable spec of the tailing lines with `coding:' tag.");
5209 Vset_auto_coding_function
= Qnil
;
5211 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions
,
5212 "A list of functions to be called at the end of `insert-file-contents'.\n\
5213 Each is passed one argument, the number of bytes inserted. It should return\n\
5214 the new byte count, and leave point the same. If `insert-file-contents' is\n\
5215 intercepted by a handler from `file-name-handler-alist', that handler is\n\
5216 responsible for calling the after-insert-file-functions if appropriate.");
5217 Vafter_insert_file_functions
= Qnil
;
5219 DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions
,
5220 "A list of functions to be called at the start of `write-region'.\n\
5221 Each is passed two arguments, START and END as for `write-region'.\n\
5222 These are usually two numbers but not always; see the documentation\n\
5223 for `write-region'. The function should return a list of pairs\n\
5224 of the form (POSITION . STRING), consisting of strings to be effectively\n\
5225 inserted at the specified positions of the file being written (1 means to\n\
5226 insert before the first byte written). The POSITIONs must be sorted into\n\
5227 increasing order. If there are several functions in the list, the several\n\
5228 lists are merged destructively.");
5229 Vwrite_region_annotate_functions
= Qnil
;
5231 DEFVAR_LISP ("write-region-annotations-so-far",
5232 &Vwrite_region_annotations_so_far
,
5233 "When an annotation function is called, this holds the previous annotations.\n\
5234 These are the annotations made by other annotation functions\n\
5235 that were already called. See also `write-region-annotate-functions'.");
5236 Vwrite_region_annotations_so_far
= Qnil
;
5238 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers
,
5239 "A list of file name handlers that temporarily should not be used.\n\
5240 This applies only to the operation `inhibit-file-name-operation'.");
5241 Vinhibit_file_name_handlers
= Qnil
;
5243 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation
,
5244 "The operation for which `inhibit-file-name-handlers' is applicable.");
5245 Vinhibit_file_name_operation
= Qnil
;
5247 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name
,
5248 "File name in which we write a list of all auto save file names.\n\
5249 This variable is initialized automatically from `auto-save-list-file-prefix'\n\
5250 shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
5252 Vauto_save_list_file_name
= Qnil
;
5254 defsubr (&Sfind_file_name_handler
);
5255 defsubr (&Sfile_name_directory
);
5256 defsubr (&Sfile_name_nondirectory
);
5257 defsubr (&Sunhandled_file_name_directory
);
5258 defsubr (&Sfile_name_as_directory
);
5259 defsubr (&Sdirectory_file_name
);
5260 defsubr (&Smake_temp_name
);
5261 defsubr (&Sexpand_file_name
);
5262 defsubr (&Ssubstitute_in_file_name
);
5263 defsubr (&Scopy_file
);
5264 defsubr (&Smake_directory_internal
);
5265 defsubr (&Sdelete_directory
);
5266 defsubr (&Sdelete_file
);
5267 defsubr (&Srename_file
);
5268 defsubr (&Sadd_name_to_file
);
5270 defsubr (&Smake_symbolic_link
);
5271 #endif /* S_IFLNK */
5273 defsubr (&Sdefine_logical_name
);
5276 defsubr (&Ssysnetunam
);
5277 #endif /* HPUX_NET */
5278 defsubr (&Sfile_name_absolute_p
);
5279 defsubr (&Sfile_exists_p
);
5280 defsubr (&Sfile_executable_p
);
5281 defsubr (&Sfile_readable_p
);
5282 defsubr (&Sfile_writable_p
);
5283 defsubr (&Saccess_file
);
5284 defsubr (&Sfile_symlink_p
);
5285 defsubr (&Sfile_directory_p
);
5286 defsubr (&Sfile_accessible_directory_p
);
5287 defsubr (&Sfile_regular_p
);
5288 defsubr (&Sfile_modes
);
5289 defsubr (&Sset_file_modes
);
5290 defsubr (&Sset_default_file_modes
);
5291 defsubr (&Sdefault_file_modes
);
5292 defsubr (&Sfile_newer_than_file_p
);
5293 defsubr (&Sinsert_file_contents
);
5294 defsubr (&Swrite_region
);
5295 defsubr (&Scar_less_than_car
);
5296 defsubr (&Sverify_visited_file_modtime
);
5297 defsubr (&Sclear_visited_file_modtime
);
5298 defsubr (&Svisited_file_modtime
);
5299 defsubr (&Sset_visited_file_modtime
);
5300 defsubr (&Sdo_auto_save
);
5301 defsubr (&Sset_buffer_auto_saved
);
5302 defsubr (&Sclear_buffer_auto_save_failure
);
5303 defsubr (&Srecent_auto_save_p
);
5305 defsubr (&Sread_file_name_internal
);
5306 defsubr (&Sread_file_name
);
5309 defsubr (&Sunix_sync
);